Lab Instructions
Overview
This lab is loosely based on results from:
Bingham, R., & Felbinger, C. (2002). Evaluation in practice: A methodological approach. CQ Press.
CH-05: Improving Cognitive Ability in Chronically Deprived Children
The treatment is nutrition support and specialized tutoring for low-SES students in a poor neighborhood in Peru. The outcome is a standardized measure of academic ability.
Instead of four distinct treatment groups and five time periods this lab will use one treatment group, one control group, and one comparison group (the high socio-economic status students).
The treatment group starts treatment in the first time period and continues to receive it in periods 2 and 3 in the study. Neither the control group nor the comparison group receive the treatment at any point.
Load Data
library( dplyr )
library( scales )
library( stargazer )
library( pander )
# STARGAZER OUTPUT
#
# Use:
#
# s.type="text"
#
# while running chunks interactively
# to see table output.
# This sets it to "html"
# when knitting the file.
s.type="html"URL <- "https://github.com/DS4PS/cpp-524-sum-2021/blob/main/labs/data/counterfactuals.csv?raw=true"
d <- read.csv( URL )
# set factor levels
d$group <- factor( d$group,
levels=c("high.ses","treatment","control"))Table 1: Sample sizes for each group in the panel
table( d$group,d$time ) %>% pander()| time0 | time1 | time2 | time3 | |
|---|---|---|---|---|
| high.ses | 28 | 28 | 28 | 28 |
| treatment | 47 | 47 | 47 | 47 |
| control | 90 | 90 | 90 | 90 |
Table 2: Group means in each time period
tapply( d$ability, list(d$group,d$time), mean ) %>%
round(2) %>%
pander()| time0 | time1 | time2 | time3 | |
|---|---|---|---|---|
| high.ses | -0.02 | 1.44 | 3.15 | 4.61 |
| treatment | -1.76 | -0.72 | 2.19 | 3.34 |
| control | -1.76 | -0.65 | 0.64 | 2 |
Reflexive Pre-Post Estimator (T2-T1)
Isolate all of the students in the treatment group from time periods 1 and 2 only.
The T1 measure represents cognitive ability of students in the group at the start of the treatment period. T2 represents cognitive ability after one season of participation in the program.
The post-treatment dummy created here will be 1 for each observation in time2 and 0 for each observation in time1.
| student | group | time | post.dummy |
|---|---|---|---|
| student_1 | treatment | time1 | 0 |
| … | treatment | time1 | 0 |
| student_k | treatment | time1 | 0 |
| student_1 | treatment | time2 | 1 |
| … | treatment | time2 | 1 |
| student_k | treatment | time2 | 1 |
The regression model is then:
\[ y = b_0 + b_1 * post.dummy + e \]
dm <- filter( d,
group %in% c("treatment") &
time %in% c("time1","time2") )
dm$post.dummy <- ifelse( dm$time=="time2", 1, 0 )
m <- lm( ability ~ post.dummy, data=dm )
stargazer( m, type=s.type,
omit.stat=c("f","ser","adj.rsq"),
intercept.top=TRUE, intercept.bottom=FALSE,
digits=2 )| Dependent variable: | |
| ability | |
| Constant | -0.72*** |
| (0.15) | |
| post.dummy | 2.91*** |
| (0.21) | |
| Observations | 94 |
| R2 | 0.67 |
| Note: | p<0.1; p<0.05; p<0.01 |
Question 1a
What is the average score for kids in the treatment group in period 1 of the study? What is the average score for the same kids in period 2?
Note, you can check your answers against the group means in Table 2 above.
Question 1b
Explain what it means when b0 is statistically significant in the reflexive model. Explain what it means when b1 is statistically significant.
Question 1c
What is the effect size according to this model?
Recall that the identifying assumption of a reflexive model (T2-T1) is that there is no secular trend, i.e. we would expect no gains in the study period for a group that does not receive the treatment.
Is the reflexive model appropriate here? Is the zero trend assumption met?
Test for zero trend assumption: C1=C2 or C2-C1=0
Similar to above, isolate the data only for time periods 1 and 2 for the kids in the control group.
Create a post-treatment dummy that is 1 for the second time period and 0 for the first time period.
dm <- filter( d,
group %in% c("control") &
time %in% c("time1","time2") )
dm$post.dummy <- ifelse( dm$time=="time2", 1, 0 )
m <- lm( ability ~ post.dummy, data=dm )
stargazer( m, type=s.type,
omit.stat=c("f","ser","adj.rsq"),
intercept.top=TRUE, intercept.bottom=FALSE,
digits=2 )| Dependent variable: | |
| ability | |
| Constant | -0.65*** |
| (0.12) | |
| post.dummy | 1.28*** |
| (0.17) | |
| Observations | 180 |
| R2 | 0.24 |
| Note: | p<0.1; p<0.05; p<0.01 |
Question 2a
What is the average score for kids in the control group in period 1 of the study? What is the average score for the same kids in period 2?
Question 2b
Which coefficient represents the test for whether we observe a secular trend in student achievement gains independent of the treatment? What is the decision rule?
Question 2c
What does this model tell us about the appropriateness of the reflexive model?
Post-Test Only Estimator (T2-C2)
Isolate data from the post-treatment period only (time2) for the treatment and control groups. Create a treat.dummy that designates whether the student was in the treatment group or control group:
| student | group | time | treat.dummy |
|---|---|---|---|
| student_1 | control | time2 | 0 |
| … | control | time2 | 0 |
| student_k | control | time2 | 0 |
| student_1 | treatment | time2 | 1 |
| … | treatment | time2 | 1 |
| student_k | treatment | time2 | 1 |
The regression looks very similar, but notice we are comparing two groups at the same point in time instead of one group across two periods of time now:
\[ y = b_0 + b_1 * treat.dummy + e \]
dm <- filter( d,
group %in% c("treatment","control") &
time=="time2" )
dm$treat.dummy <- ifelse( dm$group=="treatment", 1, 0 )
m <- lm( ability ~ treat.dummy, data=dm )
stargazer( m, type=s.type,
omit.stat=c("f","ser","adj.rsq"),
intercept.top=TRUE, intercept.bottom=FALSE,
digits=2 )| Dependent variable: | |
| ability | |
| Constant | 0.64*** |
| (0.12) | |
| treat.dummy | 1.55*** |
| (0.20) | |
| Observations | 137 |
| R2 | 0.31 |
| Note: | p<0.1; p<0.05; p<0.01 |
Question 3a
What is the average score for kids in the control group in the study? What is the average score for the kids in the treatment group?
Note, you can check your answers against the group means in Table 2 above.
Question 3b
What is the effect size identified by the model?
Question 3c
What is the identifying assumption of this model? Or stated differently, what must be true in order for the post-test only estimator to be appropriate?
Question 3d
According to the model below is the assumption met? How can you tell?
dm <- filter( d,
group %in% c("treatment","control") &
time=="time1" )
dm$treat.dummy <- ifelse( dm$group=="treatment", 1, 0 )
m <- lm( ability ~ treat.dummy, data=dm )
stargazer( m, type=s.type,
omit.stat=c("f","ser","adj.rsq"),
intercept.top=TRUE, intercept.bottom=FALSE,
digits=2 )| Dependent variable: | |
| ability | |
| Constant | -0.65*** |
| (0.12) | |
| treat.dummy | -0.07 |
| (0.20) | |
| Observations | 137 |
| R2 | 0.001 |
| Note: | p<0.1; p<0.05; p<0.01 |
Diff-in-Diff Estimator [ gains - trend ]
Total Gains: T2-T1
Trend: C2-C1
DID Estimator: [ gains - trend ] = [ (T2-T1) - (C2-C1) ]
Select data from the treatment and control groups in the pre-treatment and post-treatment period.
Create a dummy for the treatment group and a dummy for the post-treatment period (time2).
| student | group | time | treat.dummy | post.dummy | post.treat.dummy |
|---|---|---|---|---|---|
| student_1 | control | time1 | 0 | 0 | 0 |
| … | control | time1 | 0 | 0 | 0 |
| student_k | control | time1 | 0 | 0 | 0 |
| student_1 | treatment | time1 | 1 | 0 | 0 |
| … | treatment | time1 | 1 | 0 | 0 |
| student_k | treatment | time1 | 1 | 0 | 0 |
| student_1 | control | time2 | 0 | 1 | 0 |
| … | control | time2 | 0 | 1 | 0 |
| student_k | control | time2 | 0 | 1 | 0 |
| student_1 | treatment | time2 | 1 | 1 | 1 |
| … | treatment | time2 | 1 | 1 | 1 |
| student_k | treatment | time2 | 1 | 1 | 1 |
The regression model:
\[ y = b_0 + b_1 * treat.dummy + b_2 * post.dummy + b_3 * treat.post.dummy + e \]
dm <- filter( d, group %in% c("treatment","control") &
time %in% c("time1","time2") )
dm$treat.dummy <- ifelse( dm$group=="treatment", 1, 0 )
dm$post.dummy <- ifelse( dm$time=="time2", 1, 0 )
dm$treat.post.dummy <- dm$treat.dummy * dm$post.dummy
m <- lm( ability ~ treat.dummy + post.dummy + treat.post.dummy,
data=dm)
stargazer( m, type=s.type,
omit.stat=c("f","ser","adj.rsq"),
intercept.top=TRUE, intercept.bottom=FALSE,
digits=2 )| Dependent variable: | |
| ability | |
| Constant | -0.65*** |
| (0.12) | |
| treat.dummy | -0.07 |
| (0.20) | |
| post.dummy | 1.28*** |
| (0.16) | |
| treat.post.dummy | 1.63*** |
| (0.28) | |
| Observations | 274 |
| R2 | 0.48 |
| Note: | p<0.1; p<0.05; p<0.01 |
b0 <- m$coefficients[1] %>% as.numeric() %>% round(2)
b1 <- m$coefficients[2] %>% as.numeric() %>% round(2)
b2 <- m$coefficients[3] %>% as.numeric() %>% round(2)
b3 <- m$coefficients[4] %>% as.numeric() %>% round(2)
b0 # C1## [1] -0.65b0 + b1 # T1## [1] -0.72b0 + b2 # C2## [1] 0.63b0 + b1 + b2 + b3 # T2## [1] 2.19b0 + b1 + b2 # CF## [1] 0.56CF <- b0 + b1 + b2
T2 <- b0 + b1 + b2 + b3
T2-CF## [1] 1.63Question 4a
Are the treatment and control groups equivalent prior to the intervention? How do you know?
Question 4b
Do we observe secular trends (gains independent of the treatment)? How do you know?
Question 4c
What is the effect size in this model (gains from the treatment)?
Question 4d
What does statistical significance of b3 represent? In other words, which contrast is being tested?
Question 5a
Do the reflexive and diff-in-diff models generate the same results (approximately)? Why?
Question 5b
Do the post-test only and diff-in-diff models generate the same results (approximately)? Why?
Alternative Diff-in-Diff Estimator
Total Gains: T2-T1
Trend: C2-C1
DID Estimator: [ gains - trend ] = [ (T2-T1) - (C2-C1) ]
Note that we need a comparison group for the difference-in-difference model, but it is does not represent the counterfactual in the study. It is only used to estimate the level of secular trend in the data, and we construct a synthetic counterfactual as:
\[ T1 + trend \]
We can use any group that did not receive the treatment to measure trend, as long as we expect it to be a decent representation of what the trend would be in the treatment group. We can run the same model using the High SES group to measure trend.
Does it change our results in any meaningful way?
dm <- filter( d, group %in% c("treatment","high.ses") &
time %in% c("time1","time2") )
dm$treat.dummy <- ifelse( dm$group=="treatment", 1, 0 )
dm$pre.dummy <- ifelse( dm$time=="time1", 1, 0 )
dm$post.dummy <- ifelse( dm$time=="time2", 1, 0 )
dm$treat.post.dummy <- dm$treat.dummy * dm$post.dummy
m <- lm( ability ~ treat.dummy + post.dummy + treat.post.dummy,
data=dm)
stargazer( m, type=s.type,
omit.stat=c("f","ser","adj.rsq"),
intercept.top=TRUE, intercept.bottom=FALSE,
digits=2 )| Dependent variable: | |
| ability | |
| Constant | 1.44*** |
| (0.19) | |
| treat.dummy | -2.16*** |
| (0.24) | |
| post.dummy | 1.71*** |
| (0.27) | |
| treat.post.dummy | 1.20*** |
| (0.34) | |
| Observations | 150 |
| R2 | 0.68 |
| Note: | p<0.1; p<0.05; p<0.01 |
Question 6a
Are the pre-treatment differences (C1=T1?) different in this model versus the previous diff-in-diff? Why or why not?
Question 6b
Does the diff-in-diff model require that study groups are equivalent prior to treatment to generate valid results?
Question 6c
Is the secular trend identified by this model different from the previous diff-in-diff (approximately)? Why or why not?
Question 6d
The treatment effects from this model are approximately the same as the previous diff-in-diff model, even though they use very different comparison groups. Why does this model still work using the high SES group?
Question 6e
What is the identification assumption of the diff-in-diff model?
Parallel Lines Test
Does the high SES group model secular trend appropriately?
Test: are the study group trend lines parallel prior to the intervention?
dm <- filter( d, group %in% c("treatment","high.ses") &
time %in% c("time0","time1") )
dm$treat.dummy <- ifelse( dm$group=="treatment", 1, 0 )
dm$pre.dummy <- ifelse( dm$time=="time0", 1, 0 )
dm$post.dummy <- ifelse( dm$time=="time1", 1, 0 )
dm$treat.post <- dm$treat.dummy * dm$post.dummy
m <- lm( ability ~ treat.dummy + post.dummy + treat.post,
data=dm)
stargazer( m, type=s.type,
omit.stat=c("f","ser","adj.rsq"),
intercept.top=TRUE, intercept.bottom=FALSE,
digits=2 )| Dependent variable: | |
| ability | |
| Constant | -0.02 |
| (0.21) | |
| treat.dummy | -1.73*** |
| (0.27) | |
| post.dummy | 1.46*** |
| (0.30) | |
| treat.post | -0.43 |
| (0.38) | |
| Observations | 150 |
| R2 | 0.51 |
| Note: | p<0.1; p<0.05; p<0.01 |
Does the control group model secular trend appropriately?
Test: are the study group trend lines parallel prior to the intervention?
dm <- filter( d, group %in% c("treatment","control") &
time %in% c("time0","time1") )
dm$treat.dummy <- ifelse( dm$group=="treatment", 1, 0 )
dm$post.dummy <- ifelse( dm$time=="time1", 1, 0 )
dm$treat.post <- dm$treat.dummy * dm$post.dummy
m <- lm( ability ~ treat.dummy + post.dummy + treat.post,
data=dm)
stargazer( m, type=s.type,
omit.stat=c("f","ser","adj.rsq"),
intercept.top=TRUE, intercept.bottom=FALSE,
digits=2 )| Dependent variable: | |
| ability | |
| Constant | -1.76*** |
| (0.12) | |
| treat.dummy | 0.001 |
| (0.21) | |
| post.dummy | 1.11*** |
| (0.17) | |
| treat.post | -0.08 |
| (0.29) | |
| Observations | 274 |
| R2 | 0.18 |
| Note: | p<0.1; p<0.05; p<0.01 |
Question 7
Which coefficient captures the parallel lines test
Do we want it to be significant or not?
Submission Instructions
You can complete the lab in MS Word or as an RMD file.
If you are completing the lab in R Studio remember to:
- knit your RMD file to generate your rendered HTML file.
- name your files according to the convention: Lab-##-LastName.Rmd.
- show your solution, include your code.
- format your regression tables using stargazer
- bold your answers.
- do NOT print excessive output (like a full data set).
- follow appropriate style guidelines (spaces between arguments, etc.).
Login to Canvas at http://canvas.asu.edu and navigate to the assignments tab in the course repository. Upload your DOC or HTML+RMD files to the appropriate lab submission link.