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.
# Write your code here
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) %>%
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 |
Answer: [Replace this with your answer]
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]\).
# Write your code here
library(dplyr)
# Data frame based on the given table
data <- tibble(
patient = 1:11,
Y0 = c(10, 5, 4, 6, 1, 7, 8, 10, 2, 6, 7),
Y1 = c(1, 1, 1, 5, 5, 6, 7, 7, 8, 9, 10),
Age = c(29, 35, 19, 45, 65, 50, 77, 18, 85, 96, 77),
D = c(0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1),
Y = c(10, 5, 4, 6, 5, 7, 8, 10, 8, 9, 10)
)
# Calculate the Simple Difference in Outcomes (SDO)
sdo <- data %>%
group_by(D) %>%
summarise(Average_Y = mean(Y), .groups = 'drop') %>%
summarise(SDO = diff(Average_Y)) %>%
pull(SDO)
# Calculate the Average Treatment Effect on the Treated (ATT)
att <- data %>%
filter(D == 1) %>%
summarise(ATT = mean(Y1 - Y0)) %>%
pull(ATT)
# Calculate E[Y0|T=1] and E[Y0|T=0]
e_y0_t1 <- mean(data$Y0[data$D == 1])
e_y0_t0 <- mean(data$Y0[data$D == 0])
# Selection Bias
selection_bias <- e_y0_t1 - e_y0_t0
# Check the relationship
relationship_check <- sdo == (att + selection_bias)
# Output results
cat("SDO: ", sdo, "\n")## SDO: 0.8571429
## ATT: 4
## Selection Bias: -3.142857
## Is SDO equal to ATT + Selection Bias? TRUE
Answer: [Replace this with your answer]
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?
# Write your code here
library(dplyr)
# Data
data <- tibble(
patient = 1:11,
Y0 = c(10, 5, 4, 6, 1, 7, 8, 10, 2, 6, 7),
Y1 = c(1, 1, 1, 5, 5, 6, 7, 7, 8, 9, 10),
D = c(0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1) # 1 if treated with a ventilator, 0 if treated with bedrest
)
# Calculations
# Average Treatment Effect (ATE)
ate <- mean(data$Y1 - data$Y0)
# Average Treatment Effect on the Treated (ATT)
att <- mean(data$Y1[data$D == 1] - data$Y0[data$D == 1])
# Average Treatment Effect on the Untreated (ATU)
atu <- mean(data$Y1[data$D == 0] - data$Y0[data$D == 0])
# Simple Difference in Outcomes (SDO)
sdo <- mean(data$Y1[data$D == 1]) - mean(data$Y0[data$D == 0])
# Output the results
cat("Average Treatment Effect (ATE): ", ate, "\n")## Average Treatment Effect (ATE): -0.5454545
## Average Treatment Effect on the Treated (ATT): 4
## Average Treatment Effect on the Untreated (ATU): -3.142857
## Simple Difference in Outcomes (SDO): 0.8571429
# Check if ATE is the mean of ATT and ATU
cat("Is ATE equal to the mean of ATT and ATU?: ", abs(ate - ((att + atu) / 2)) < .Machine$double.eps, "\n")## Is ATE equal to the mean of ATT and ATU?: FALSE
# Explanation for differences
cat("The differences in treatment effects may be explained by the varying baseline characteristics between the treated and untreated groups, such as severity of illness, age, or other health factors that influence the efficacy of the treatment.\n")## The differences in treatment effects may be explained by the varying baseline characteristics between the treated and untreated groups, such as severity of illness, age, or other health factors that influence the efficacy of the treatment.
# Advantages and Disadvantages
cat("ATE provides a global measure of treatment efficacy assuming random assignment or perfect adjustment for confounders. However, it might be biased in observational studies without randomization.\n")## ATE provides a global measure of treatment efficacy assuming random assignment or perfect adjustment for confounders. However, it might be biased in observational studies without randomization.
cat("ATT measures effect only for those who received the treatment, reflecting actual treatment scenarios but may not generalize to all potential patients.\n")## ATT measures effect only for those who received the treatment, reflecting actual treatment scenarios but may not generalize to all potential patients.
cat("ATU measures effect for those not receiving the treatment, offering insights into what happens if the treatment is withheld, which might be irrelevant if the treatment is universally effective.\n")## ATU measures effect for those not receiving the treatment, offering insights into what happens if the treatment is withheld, which might be irrelevant if the treatment is universally effective.
cat("SDO is straightforward to compute and interpret but can be misleading if there are confounders affecting treatment assignment.\n")## SDO is straightforward to compute and interpret but can be misleading if there are confounders affecting treatment assignment.
Answer: [Replace this with your answer]
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?
# Write your code here
library(dplyr)
library(tidyr)
library(broom)
# Data
data <- tibble(
patient = 1:11,
Y0 = c(10, 5, 4, 6, 1, 7, 8, 10, 2, 6, 7),
Y1 = c(1, 1, 1, 5, 5, 6, 7, 7, 8, 9, 10),
D = c(0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1) # 1 if treated with a ventilator, 0 if treated with bedrest
)
# Add outcome Y based on treatment D
data <- data %>%
mutate(Y = if_else(D == 1, Y1, Y0))
# Calculate the expected outcome for patients given the bedrest treatment (E[Y|D=0])
expected_y_d0 <- mean(data$Y[data$D == 0])
cat("Expected outcome for bedrest treatment E[Y|D=0]: ", expected_y_d0, "\n")## Expected outcome for bedrest treatment E[Y|D=0]: 7.142857
# Regression: Y ~ D
model <- lm(Y ~ D, data = data)
summary_model <- summary(model)
tidy_model <- tidy(model)
# Print the regression summary
print(summary_model)##
## Call:
## lm(formula = Y ~ D, data = data)
##
## 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.5637
# Compare coefficients
cat("Intercept (alpha) from regression represents E[Y|D=0]: ", tidy_model$estimate[1], "\n")## Intercept (alpha) from regression represents E[Y|D=0]: 7.142857
## Treatment effect (delta) from regression: 0.8571429
# Interpretation and comparison
cat("The intercept from the regression should match the calculated E[Y|D=0] if the model is correctly specified.\n")## The intercept from the regression should match the calculated E[Y|D=0] if the model is correctly specified.
cat("The coefficient of D (delta) represents the average treatment effect (ATE) assuming linear effects and no confounding.\n")## The coefficient of D (delta) represents the average treatment effect (ATE) assuming linear effects and no confounding.
# Explanation of findings
cat("If there are discrepancies between E[Y|D=0] from direct calculation and the intercept, consider potential confounders or model mis-specification.\n")## If there are discrepancies between E[Y|D=0] from direct calculation and the intercept, consider potential confounders or model mis-specification.
cat("The treatment effect (delta) in the regression should be scrutinized for assumptions of linearity and equal variance across treatment groups.\n")## The treatment effect (delta) in the regression should be scrutinized for assumptions of linearity and equal variance across treatment groups.
Answer: [Replace this with your answer]
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?
# Write your code here
library(dplyr)
# Data
data <- tibble(
patient = 1:11,
Y0 = c(10, 5, 4, 6, 1, 7, 8, 10, 2, 6, 7),
Y1 = c(1, 1, 1, 5, 5, 6, 7, 7, 8, 9, 10),
D = c(0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1), # 1 if treated with a ventilator, 0 if treated with bedrest
Age = c(29, 35, 19, 45, 65, 50, 77, 18, 85, 96, 77)
)
# Add outcome Y based on treatment D
data <- data %>%
mutate(Y = if_else(D == 1, Y1, Y0))
# Regression with Age control: Y ~ D + Age
model_age_controlled <- lm(Y ~ D + Age, data = data)
summary_model_age_controlled <- summary(model_age_controlled)
tidy_model_age_controlled <- broom::tidy(model_age_controlled)
# Print the regression summary with age control
print(summary_model_age_controlled)##
## Call:
## lm(formula = Y ~ D + Age, data = data)
##
## 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
# Compare coefficients
cat("Treatment effect (delta) from regression with age control: ", tidy_model_age_controlled$estimate[2], "\n")## Treatment effect (delta) from regression with age control: 0.01418918
# Interpretation and comparison
cat("The coefficient of D (delta), when controlling for age, indicates the treatment effect adjusted for age differences across patients.\n")## The coefficient of D (delta), when controlling for age, indicates the treatment effect adjusted for age differences across patients.
cat("Comparing this delta with the previous model without age control helps identify if age is a confounding factor.\n")## Comparing this delta with the previous model without age control helps identify if age is a confounding factor.
# Explanation of findings
cat("If delta changes significantly with age control, it suggests that age influences the treatment effectiveness or that it interacts with how treatments were assigned.\n")## If delta changes significantly with age control, it suggests that age influences the treatment effectiveness or that it interacts with how treatments were assigned.
cat("Understanding these dynamics is crucial for tailoring treatment recommendations based on patient demographics.\n")## Understanding these dynamics is crucial for tailoring treatment recommendations based on patient demographics.
Answer: [Replace this with your answer]
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?
# Write your code here
library(dplyr)
library(broom)
# Data setup
data <- tibble(
patient = 1:11,
Y0 = c(10, 5, 4, 6, 1, 7, 8, 10, 2, 6, 7),
Y1 = c(1, 1, 1, 5, 5, 6, 7, 7, 8, 9, 10),
D = c(0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1), # 1 if treated with a ventilator, 0 if treated with bedrest
Age = c(29, 35, 19, 45, 65, 50, 77, 18, 85, 96, 77)
)
# Add outcome Y based on treatment D
data <- data %>%
mutate(Y = if_else(D == 1, Y1, Y0))
# Model 1: Y ~ D + Age
model_1 <- lm(Y ~ D + Age, data = data)
summary_model_1 <- summary(model_1)
# Model 2: D ~ Age (Auxiliary regression)
model_2 <- lm(D ~ Age, data = data)
residuals_D <- residuals(model_2)
# Model 3: Y ~ residuals of D (from Model 2)
data <- mutate(data, D_tilde = residuals_D)
model_3 <- lm(Y ~ D_tilde, data = data)
summary_model_3 <- summary(model_3)
# Output the results
cat("Coefficients from Model 1 (Y ~ D + Age):\n")## Coefficients from Model 1 (Y ~ D + Age):
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.35542736 1.90736147 3.332051869 0.01035276
## D 0.01418918 2.33996589 0.006063841 0.99531027
## Age 0.02019051 0.04308644 0.468604705 0.65185573
## Coefficients from Model 3 (Y ~ D_tilde):
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.45454545 0.7015644 10.62560449 2.154523e-06
## D_tilde 0.01418918 2.2803976 0.00622224 9.951711e-01
##
## Interpreting Multivariate Regressions:
cat("The coefficient of D in the first model includes the effect of D adjusting for Age, while the coefficient of D_tilde in the third model isolates the component of D uncorrelated with Age.\n")## The coefficient of D in the first model includes the effect of D adjusting for Age, while the coefficient of D_tilde in the third model isolates the component of D uncorrelated with Age.
cat("This comparison shows the importance of accounting for confounders when estimating treatment effects. The difference between these coefficients can highlight the impact of omitted variable bias when Age is not controlled for.\n")## This comparison shows the importance of accounting for confounders when estimating treatment effects. The difference between these coefficients can highlight the impact of omitted variable bias when Age is not controlled for.
Answer: [Replace this with your answer]