Lab specs can be found here
Question: Recreate table 1 shown below,
inserting values appropriately for the three empty colums: (i) The
column labeled \(\delta_i\): please
enter each patient’s treatment effect (ii) The column labeled \(D\): the optimal treatment for this patient
(iii) The column labeled \(Y\): the
observed outcomes. Calculate the average treatment effect (ATE) and the
average treatment effect for the treated (ATT) when comparing the
outcome of the ventilators treatment with that of the
bedrest treatment and comment as to which type of
intervention is more effective on average. Finally, explain under which
conditions might SUTVA be violated
for treatments of covid-19 in the scenario described above.
df <- tribble(
~patient, ~`Y(0)`, ~`Y(1)`, ~Age, ~delta, ~D, ~Y,
1, 10, 1, 29, -9, 0, 10,
2, 5, 1, 35, -4, 0, 5,
3, 4, 1, 19, -3, 0, 4,
4, 6, 5, 45, -1, 0, 6,
5, 1, 5, 65, 4, 1, 5,
6, 7, 6, 50, -1, 0, 7,
7, 8, 7, 77, -1, 0, 8,
8, 10, 7, 18, -3, 0, 10,
9, 2, 8, 85, 6, 1, 8,
10, 6, 9, 96, 3, 1, 9,
11, 7, 10, 77, 3, 1, 10)
df %>%
gt()| patient | Y(0) | Y(1) | Age | delta | D | Y |
|---|---|---|---|---|---|---|
| 1 | 10 | 1 | 29 | -9 | 0 | 10 |
| 2 | 5 | 1 | 35 | -4 | 0 | 5 |
| 3 | 4 | 1 | 19 | -3 | 0 | 4 |
| 4 | 6 | 5 | 45 | -1 | 0 | 6 |
| 5 | 1 | 5 | 65 | 4 | 1 | 5 |
| 6 | 7 | 6 | 50 | -1 | 0 | 7 |
| 7 | 8 | 7 | 77 | -1 | 0 | 8 |
| 8 | 10 | 7 | 18 | -3 | 0 | 10 |
| 9 | 2 | 8 | 85 | 6 | 1 | 8 |
| 10 | 6 | 9 | 96 | 3 | 1 | 9 |
| 11 | 7 | 10 | 77 | 3 | 1 | 10 |
# Calculating the ATE
ATE <- df %>%
summarize(ate = mean(`Y(1)` - `Y(0)`)) %>%
pull(ate)
# Calculating the ATT
ATT <- df %>%
filter(D == 1) %>%
summarize(att = mean(`Y(1)` - `Y(0)`)) %>%
pull(att)Answer:
To find the ATE, we calculate the mean of the difference in potential outcomes. The result is -0.5454545. We can see that the ATE is negative, meaning that if we treated all the patients, on average, we would have decreased their life span by .5 years (6 months) on average, compared to not treating them.
To find the ATT, we first use a filter to include only the treated patients (D ==1). We find that the ATT is 4, and then calculate the mean of the difference in their potential outcomes. The result is 4. We can see that is the treatment has extended the lives of the treated by 4 years.
To explain under which conditions might SUTVA be violated for treatments of covid-19 in the scenario described above : the Stable Unit Treatment Value Assumption (SUTVA) can be violated in this situation if there is inconsistency in the application of the treatment for example difference is the type of ventilators used or the duration of the ventilator use. Another part of the SUTVA is the no interference condition this could be violated if there the treatment of one group can affect the treament of other group.
Question: Calculate the simple difference in
outcomes (SDO), showing the details of your calculation. Is
the SDO a good estimation for the ATE? Finally, check
whether the SDO is equal to the sum of the ATT
and the selection bias, \(E[Y(0)|T=1] -
E[Y(0)|T=0]\).
# Calculate the observed outcomes
obs.outcomes <- df %>%
summarize(mn.Y = mean(Y), .by = D) %>%
pull(mn.Y)
# Calculate the SDO
sdo <- diff(obs.outcomes)
mn.Y0 <- df %>%
summarize(mn.Y0 = mean(`Y(0)`), .by = D) %>%
pull(mn.Y0)
selection_bias <- diff(mn.Y0)Answer: To find the Simple Difference in mean Outcome (SDO), we calculate the mean of the observed outcome, stratified by the level of treatment. The observed outcome for the treated is 8.0 years and for the control is 7.14 years. The SDO is the difference between these two, and it is therefore 0.85 years, which is positive, whereas that the ATE we calculated before is -0.5 which is negative. This means that if we had treated the entire sample, we would reduce, on average, the lifespan of our patients. However, since we applied the treatment selectively, treating only the patients that would benefit from the procedure, we have increased the average lifespan of the patients in our sample.
To find the selection bias, we first calculate the mean of the potential outcome, Y(0) for both the treated and the untreated. The potential outcome for the treated is E[Y(0)|D=1]= 4 and for the untreated is E[Y(0)|D=0]= 7.1428571. The difference between the two is -3.1428571. We can see that the sdo (0.8571429) = att (4) + selection bias (-3.1428571).
Question: Compare the treatment effect for both groups: for those treated with a ventilator and for those treated with bedrest. What explains the difference in the average effect? Now compare all four measures of effects. What are the advantages and disadvantages of each? Is the ATE equal to the mean of the ATU and the ATT? Why or why not?
# Calculating the ATT
ATT <- df %>%
filter(D == 1) %>%
summarize(att = mean(`Y(1)` - `Y(0)`)) %>%
pull(att)
# Calculating the ATU
ATU <- df %>%
filter(D == 0) %>%
summarize(atu = mean(`Y(1)` - `Y(0)`)) %>%
pull(atu)Answer: The average effect for the treated is 4 years and for the untreated is -3.14 years. The first effect is positive and the second effect is negative, this is because the mostly the patients with severe conditions who are treated with ventilation really needed the treatment and experienced better outcomes. The negative ATU implies that that is the untreated would have been treated they would not have any benefits from the treatment. The differences in the averages implies potential selection biases in the patients who received the treatment and those who did not. For example the patients who got the ventilator perhaps were older or unvaccinated or both. SDO is simple measure might be misleading if there is selection bias, as it does not account for differences in baseline characteristics between treated and untreated groups. The ATE is a close representation of the real effects if all the other assumtions are met.
The following exercises demonstrate that regression is a useful tool to estimate average outcomes and treatment effects in the different groups. Notice that in contrast to the role that regressions play in traditional statistics, here standard errors and significance are not of primary concern. Instead, we are interested in using regression to calculate average effects proper.
Question: Calculate the outcome, conditional on
getting the bedrest treatment \(\mathbb{E}[Y|D=0]\). Now estimate the
following regression, comparing the coefficients \(\alpha\) and \(\delta\) to the statistics you’ve
previously calculated. What did you find? How would you explain these
finding?
# Calculate the outcome E[Y|D=0]
mn.Y_D0 <- df %>%
filter(D == 0) %>%
summarize(mn.Y = mean(Y)) %>%
pull(mn.Y)
mdl <- lm(Y ~ D, data = df)
summary(mdl)##
## Call:
## lm(formula = Y ~ D, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.143 -1.643 0.000 1.500 2.857
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.1429 0.8624 8.282 1.68e-05 ***
## D 0.8571 1.4302 0.599 0.564
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.282 on 9 degrees of freedom
## Multiple R-squared: 0.03838, Adjusted R-squared: -0.06847
## F-statistic: 0.3592 on 1 and 9 DF, p-value: 0.5637Answer:
We can see that the mean outcome for all those in the control group is 7.1428571. This is exactly like the intercept of our linear model. The slope is exactly equal to the SDO. This is because the linear regression model with the treatment indicator as the predictor variable, the slope coefficient of the model captures this difference in mean outcomes. This is because the slope coefficient quantifies the change in the predicted outcome between the control and treatment groups, which is exactly what the SDO measures.
Question: Now estimate the same regression, but this time, controlling for age, again comparing, the coefficient \(\delta\) to the statistics you’ve previously calculated. What did you find? How do you explain these results?
##
## Call:
## lm(formula = Y ~ D + Age, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.7390 -1.6630 -0.0858 1.3839 3.2811
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.35543 1.90736 3.332 0.0104 *
## D 0.01419 2.33997 0.006 0.9953
## Age 0.02019 0.04309 0.469 0.6519
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.388 on 8 degrees of freedom
## Multiple R-squared: 0.06407, Adjusted R-squared: -0.1699
## F-statistic: 0.2738 on 2 and 8 DF, p-value: 0.7673Answer: The data shows that there is a correlation between age and the outcome, and therefore there is a correlation between the age and the treatment. The age behaves as a confounder, and by controlling for age, we are removing the confounding and measuring only the effect of the treatment on the outcome conditional on age E[Y|T,Age] , whereas in the previous equation we looked at age E[Y|T] . Taking the age into account, we see that we overestimated the effect of the treatment in the previous question (the conditional effect of the treatment given age is much smaller)
Question: Estimate the following three regression models. The first model is the same as the one above. The second equation is the auxiliary regression of \(D\) onto \(X_{age}\). The third equation regresses \(Y\) onto \(\tilde{D}\) which is the residual from the second equation. Compare the coefficient on \(D\) from the first equation to the coefficient on \(\tilde{D}\) in the third equation. What does this tell you about how to interpret multivariate regressions?
install.packages("broom")
library(broom)
# First model
mdl1 <- lm(Y ~ D + Age, data = df)
summary(mdl1)##
## Call:
## lm(formula = Y ~ D + Age, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.7390 -1.6630 -0.0858 1.3839 3.2811
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.35543 1.90736 3.332 0.0104 *
## D 0.01419 2.33997 0.006 0.9953
## Age 0.02019 0.04309 0.469 0.6519
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.388 on 8 degrees of freedom
## Multiple R-squared: 0.06407, Adjusted R-squared: -0.1699
## F-statistic: 0.2738 on 2 and 8 DF, p-value: 0.7673# second model
mdl2 <- lm(D ~ Age, data = df)
df$D_tilde <- augment(mdl2) %>% pull(.resid)
# third model
mdl3 <- lm(Y ~ D_tilde, data = df)
summary(mdl3)##
## Call:
## lm(formula = Y ~ D_tilde, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.4565 -1.9522 0.5426 2.0429 2.5456
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.45455 0.70156 10.626 2.15e-06 ***
## D_tilde 0.01419 2.28040 0.006 0.995
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.327 on 9 degrees of freedom
## Multiple R-squared: 4.302e-06, Adjusted R-squared: -0.1111
## F-statistic: 3.872e-05 on 1 and 9 DF, p-value: 0.9952Answer:
We find that the effect of the residual treatment (D_tilde) is equal to the effect of the treatment in the first model. That is because the D~ is basically the represents the residuals of the first model after conditioning it on the age variable. So in the third model when we introduce the D~ it has the same effect as using D and Age together in the model 1.