The perfect doctor

Lab specs can be found here

Exercise 1

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]

Exercise 2

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
cat("ATT: ", att, "\n")
## ATT:  4
cat("Selection Bias: ", selection_bias, "\n")
## Selection Bias:  -3.142857
cat("Is SDO equal to ATT + Selection Bias? ", relationship_check, "\n")
## Is SDO equal to ATT + Selection Bias?  TRUE

Answer: [Replace this with your answer]

Exercise 3

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
cat("Average Treatment Effect on the Treated (ATT): ", att, "\n")
## Average Treatment Effect on the Treated (ATT):  4
cat("Average Treatment Effect on the Untreated (ATU): ", atu, "\n")
## Average Treatment Effect on the Untreated (ATU):  -3.142857
cat("Simple Difference in Outcomes (SDO): ", sdo, "\n")
## 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]

Using regression to estimate effects

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.

Exercise 4

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
cat("Treatment effect (delta) from regression: ", tidy_model$estimate[2], "\n")
## 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]

Exercise 5

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]

Exercise 6

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):
print(coef(summary_model_1))
##               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
cat("Coefficients from Model 3 (Y ~ D_tilde):\n")
## Coefficients from Model 3 (Y ~ D_tilde):
print(coef(summary_model_3))
##               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
# Comparison and Interpretation
cat("\nInterpreting Multivariate Regressions:\n")
## 
## 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]