Discussion 3. Treatment effect heterogeneity in an Experiment

STSCI/INFO/ILRST 3900: Causal Inference

September 9, 2026

You can download the slides. for this week’s discussion.

Get out and Vote Experiment

Why do people vote?
One long-standing theory: People vote due to social norms (civic duty)
Empirical evidence for this theory was extremely thin
Research Question: to what extent do social norms cause voter turnout?
Article: “Social Pressure and Voter Turnout: Evidence from a Large-scale Field Experiment.”in American Political Science Review
Authors: Alan S. Gerber, Donald P. Green, and Christopher W. Larimer

Experimental Design

Approximately 80k Michigan households were randomly assigned 1 of 4 mailings encouraging them to vote
1. Simply reminded them that voting is a civic duty
2. Told that researchers would be studying their turnout based on public records
3. Received record of voting turnout within their household
4. Received record of voting turnout within their household and their neighbors’ households.
Third and fourth treatment arms were told that their turnout would be revealed as well

Analyze Experiment

Necessary packages

library(dplyr)
library(haven)
library(kableExtra)

## Warning: package 'kableExtra' was built under R version
## 4.6.1

Import data

gotv <- read_dta("https://causal3900.github.io/assets/data/social_pressure.dta")
glimpse(gotv)

## Rows: 344,084
## Columns: 16
## $ sex           <dbl+lbl> 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 0,…
## $ yob           <dbl> 1941, 1947, 1951, 1950, 1982, 1981, …
## $ g2000         <dbl+lbl> 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1,…
## $ g2002         <dbl+lbl> 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1,…
## $ g2004         <dbl+lbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ p2000         <dbl+lbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ p2002         <dbl+lbl> 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0,…
## $ p2004         <dbl+lbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,…
## $ treatment     <dbl+lbl> 2, 2, 1, 1, 1, 0, 0, 0, 0, 0, 0,…
## $ cluster       <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …
## $ voted         <dbl+lbl> 0, 0, 1, 1, 1, 0, 1, 1, 0, 0, 1,…
## $ hh_id         <dbl> 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 5, 6, …
## $ hh_size       <dbl> 2, 2, 3, 3, 3, 3, 3, 3, 2, 2, 1, 2, …
## $ numberofnames <dbl> 21, 21, 21, 21, 21, 21, 21, 21, 21, …
## $ p2004_mean    <dbl> 0.09523810, 0.09523810, 0.04761905, …
## $ g2004_mean    <dbl> 0.8571429, 0.8571429, 0.8571429, 0.8…

Clean data

First, we construct an age variable describing how old (in number of years) each person was in the year 2006. The yob variable says which year each person was born in. > For this, we use the mutate function. Then, we convert the treatment variable from it’s numeric representation to the corresponding labels which are

0: “Control”
1: “Hawthorne” (this is the ‘researchers viewing records via public data’ treatment arm)
2: “Civic Duty” (this is the ‘voting is your civic duty’ treatment arm)
3: “Neighbors” (this is the ‘voting turnout revealed to neighbors’ treatment arm)
4: “Self” (this is the ‘voting turnout revealed to household’ treatment arm)

For this, we use the case_when function.

gotv <- gotv |>
  mutate(age = 2006 - yob)

gotv <- gotv |>
  mutate(treatment = case_when(
    treatment == 0 ~ "Control",
    treatment == 1 ~ "Hawthorne",
    treatment == 2 ~ "Civic Duty",
    treatment == 3 ~ "Neighbors",
    treatment == 4 ~ "Self"))

Average Causal Effect

Finally, for each treatment group, we calculate the percentage of individuals who got out and voted, as well as the total number of individuals in that group! The solutions below use the function n which counts the number of observations in the current group for you.

gotv_results <- gotv |>
  group_by(treatment) |>
  summarise(Per_Voting = mean(voted), num_of_individuals = n())

gotv_results |>
  kbl() |>
  kable_styling(font_size = 12,full_width = FALSE)

treatment	Per_Voting	num_of_individuals
Civic Duty	0.3145377	38218
Control	0.2966383	191243
Hawthorne	0.3223746	38204
Neighbors	0.3779482	38201
Self	0.3451515	38218

Conditional Average Causal Effect

Now, we look into the treatment effect across sub-population, so we can determine if there is treatment effect heterogeneity

First, we assign into age groups and household size groups

gotv <- gotv |>
  mutate(ageGroup = cut(age, breaks = c(18, 30, 45, 60, 120))) |>
  mutate(hhGroup = cut(hh_size, breaks = c(0,1, 2, 10)))

Examine voting by age group

gotv_results_age <- gotv |>
  group_by(ageGroup, treatment) |>
  summarise(
    Per_Voting = mean(voted),
    Count = n(),
    .groups = "drop"
  ) |>
  group_by(treatment) |>
  mutate( Per_in_AgeGroup = Count / sum(Count))

gotv_results_age|>
  kbl() |>
  kable_styling(font_size = 12, full_width = FALSE) |>
  scroll_box(width = "100%", height = "500px",fixed_thead = T)

ageGroup	treatment	Per_Voting	Count	Per_in_AgeGroup
(18,30]	Civic Duty	0.1661575	4255	0.1113350
(18,30]	Control	0.1562712	20650	0.1079778
(18,30]	Hawthorne	0.1583068	4087	0.1069783
(18,30]	Neighbors	0.1933636	4189	0.1096568
(18,30]	Self	0.1751631	4139	0.1082998
(30,45]	Civic Duty	0.2933172	9921	0.2595897
(30,45]	Control	0.2679248	49917	0.2610135
(30,45]	Hawthorne	0.2965843	10159	0.2659146
(30,45]	Neighbors	0.3561739	10026	0.2624539
(30,45]	Self	0.3168376	10043	0.2627819
(45,60]	Civic Duty	0.3197190	16086	0.4209011
(45,60]	Control	0.3095730	80330	0.4200415
(45,60]	Hawthorne	0.3383147	15926	0.4168673
(45,60]	Neighbors	0.3906578	15735	0.4119002
(45,60]	Self	0.3569639	15968	0.4178136
(60,120]	Civic Duty	0.4098793	7956	0.2081742
(60,120]	Control	0.3782531	40346	0.2109672
(60,120]	Hawthorne	0.4068725	8032	0.2102398
(60,120]	Neighbors	0.4738820	8251	0.2159891
(60,120]	Self	0.4442241	8068	0.2111047

Examine voting by hh size group

gotv_results_hh <- gotv |>
  group_by(hhGroup, treatment) |>
  summarise(
    Per_Voting = mean(voted),
    Count = n(),
    .groups = "drop"
  ) |>
  group_by(treatment) |>
  mutate( Per_in_hhGroup = Count / sum(Count) ) 

gotv_results_hh |>
  kbl() |>
  kable_styling(font_size = 12, full_width = FALSE) |>
  scroll_box(width = "100%", height = "500px",fixed_thead = T)

hhGroup	treatment	Per_Voting	Count	Per_in_hhGroup
(0,1]	Civic Duty	0.3538348	5398	0.1412423
(0,1]	Control	0.3306144	26481	0.1384678
(0,1]	Hawthorne	0.3698163	5281	0.1382316
(0,1]	Neighbors	0.4226324	5364	0.1404152
(0,1]	Self	0.3998117	5310	0.1389398
(1,2]	Civic Duty	0.3267335	23536	0.6158355
(1,2]	Control	0.3029272	119022	0.6223600
(1,2]	Hawthorne	0.3257771	23998	0.6281541
(1,2]	Neighbors	0.3907659	23738	0.6213973
(1,2]	Self	0.3516728	23792	0.6225339
(2,10]	Civic Duty	0.2607712	9284	0.2429222
(2,10]	Control	0.2606034	45740	0.2391722
(2,10]	Hawthorne	0.2851541	8925	0.2336143
(2,10]	Neighbors	0.3181668	9099	0.2381875
(2,10]	Self	0.2962922	9116	0.2385263

Questions:

Does there seem to be heterogeneity in treatment effects across age and/or house hold size?
Could you improve voting rates by assigning different treatments to different individuals?
What would you expect the treatment effect for civic duty if we considered a population that was evenly split across the 4 age groups?

To answer these questions it might be useful to slightly rearrange table:

gotv_results_age <- gotv |>
  group_by(ageGroup, treatment) |>
  summarise(
    Per_Voting = mean(voted),
    Count = n(),
    .groups = "drop"
  ) |>
  group_by(treatment) |>
  mutate(
    Per_in_AgeGroup = Count / sum(Count)
  ) |>
  group_by(ageGroup) |>
  mutate(
    Control_Voting = Per_Voting[treatment == "Control"],
    Difference_from_Control = Per_Voting - Control_Voting
  ) |>
  ungroup()


gotv_results_age |>
  arrange(treatment,ageGroup) |>
  kbl() |>
  kable_styling(font_size = 12, full_width = FALSE) |>
  scroll_box(width = "100%", height = "500px",fixed_thead = T)

ageGroup	treatment	Per_Voting	Count	Per_in_AgeGroup	Control_Voting	Difference_from_Control
(18,30]	Civic Duty	0.1661575	4255	0.1113350	0.1562712	0.0098863
(30,45]	Civic Duty	0.2933172	9921	0.2595897	0.2679248	0.0253925
(45,60]	Civic Duty	0.3197190	16086	0.4209011	0.3095730	0.0101460
(60,120]	Civic Duty	0.4098793	7956	0.2081742	0.3782531	0.0316262
(18,30]	Control	0.1562712	20650	0.1079778	0.1562712	0.0000000
(30,45]	Control	0.2679248	49917	0.2610135	0.2679248	0.0000000
(45,60]	Control	0.3095730	80330	0.4200415	0.3095730	0.0000000
(60,120]	Control	0.3782531	40346	0.2109672	0.3782531	0.0000000
(18,30]	Hawthorne	0.1583068	4087	0.1069783	0.1562712	0.0020356
(30,45]	Hawthorne	0.2965843	10159	0.2659146	0.2679248	0.0286596
(45,60]	Hawthorne	0.3383147	15926	0.4168673	0.3095730	0.0287417
(60,120]	Hawthorne	0.4068725	8032	0.2102398	0.3782531	0.0286194
(18,30]	Neighbors	0.1933636	4189	0.1096568	0.1562712	0.0370924
(30,45]	Neighbors	0.3561739	10026	0.2624539	0.2679248	0.0882492
(45,60]	Neighbors	0.3906578	15735	0.4119002	0.3095730	0.0810848
(60,120]	Neighbors	0.4738820	8251	0.2159891	0.3782531	0.0956288
(18,30]	Self	0.1751631	4139	0.1082998	0.1562712	0.0188919
(30,45]	Self	0.3168376	10043	0.2627819	0.2679248	0.0489128
(45,60]	Self	0.3569639	15968	0.4178136	0.3095730	0.0473909
(60,120]	Self	0.4442241	8068	0.2111047	0.3782531	0.0659710

Answers:

Does there seem to be heterogeneity in treatment effects across age and/or house hold size?

We say there is treatment effect heterogeneity if the treatment effect varies across sub-population. To check if there’s treatment effect heterogeneity across age groups, we look at \(E[Y^{a=j}|L=l]-E[Y^{a=0}|L=l]\) for each age group \(l\), and treatment \(j\). For example, the “Civic Duty” treatment effect for individuals ages 18-30 is \[\begin{align*} E\big[Y^{a=\text{Civic Duty}}|L=(18-30]\big]-&E\big[Y^{a=\text{Control}}|L=(18-30]\big]]\\ &= 0.166-0.156\\&=0.01 \end{align*}\]

These values can be found in the following table, gotv_results_ageGroup

gotv_results_ageGroup <- gotv |>
  group_by(ageGroup, treatment) |>
  summarise(
    Per_Voting = mean(voted),
    Count = n())

A nice way to present this table would be using the variable Difference_from_Control, created above. This table makes it easier to look at the causal effect across age groups and examining whether the effect is fixed or not

ageGroup Civic Duty Control Hawthorne Neighbors Self

1 (18,30] 0.0098863 0 0.0020356 0.0370924 0.0188919

6 (30,45] 0.0253925 0 0.0286596 0.0882492 0.0489128

11 (45,60] 0.0101460 0 0.0287417 0.0810848 0.0473909

16 (60,120] 0.0316262 0 0.0286194 0.0956288 0.0659710

	ageGroup	Civic Duty	Hawthorne	Neighbors	Self
1	(18,30]	0.0098863	0.0020356	0.0370924	0.0188919
6	(30,45]	0.0253925	0.0286596	0.0882492	0.0489128
11	(45,60]	0.0101460	0.0287417	0.0810848	0.0473909
16	(60,120]	0.0316262	0.0286194	0.0956288	0.0659710

What would you expect the treatment effect for civic duty if we considered a population that was evenly split across the 4 age groups?

First, let’s consider the average treatment effect for Civic Duty, which is given by: \[E[Y|a=\text{Civic Duty}]-E[Y|a=\text{Control}]\] Standardization allows us to estimate the ACE by combining estimates from each sub-population \[\sum_l P(L=l)E[Y|a=\text{Civic Duty},L=l]-\sum_l P(L=l)E[Y|a=\text{Control},L=l]\] \[\sum_l P(L=l) \Big(E[Y|a=\text{Civic Duty},L=l]-E[Y|a=\text{Control},L=l]\Big)\] For the age group the ACE looks like: \[\begin{align*} ACE =& 0.111 \times (0.166-0.156) \\ &+0.260 \times (0.293-0.268)\\&+0.421\times (0.320-0.310)\\&+ 0.208\times (0.410-0.378) \end{align*}\]

gotv_results_age |>
   filter(treatment=="Civic Duty") |>
   summarise(ACE = sum(Per_in_AgeGroup*Difference_from_Control))

## # A tibble: 1 × 1
##      ACE
##    <dbl>
## 1 0.0185

To estimate the treatment effect for civic duty if the population was evenly split across the 4 age group, we replace the share of each age group with \(0.25\).

gotv_results_age |>
   filter(treatment=="Civic Duty") |>
   summarise(ACE_even = sum(.25*Difference_from_Control))

## # A tibble: 1 × 1
##   ACE_even
##      <dbl>
## 1   0.0193

Discussion 2. Analyzing an Experiment in R

Due dates