causal-inference-basics on Ray Yang, Ph.D.

Regression Discontinuity Design

Wed, 23 Jun 2021 00:00:00 +0000

the Causality Graph

Remove the Differences in Y NOT explained by Treatment and Time

Difference-in-Difference

Wed, 16 Jun 2021 00:00:00 +0000

the Causality Graph

Remove the Differences in Y NOT explained by Treatment and Time

Matching

Wed, 09 Jun 2021 00:00:00 +0000

the Causality Graph

Removing the “Differences in Y explained by X” (to find out the pure effect of Treatment on Y)

Fixed Effects

Wed, 02 Jun 2021 00:00:00 +0000

the Causality Graph

Remove “Differences in X explained by Person” vs. Remove “Differences in Y explained by Person”

Remove Persons’s influence on “the effect of X on Y” step by step

Post-treatment Control

Wed, 26 May 2021 00:00:00 +0000

the Causality Graph

Remove “Differences in X explained by C” vs. Remove “Differences in Y explained by C”

Remove C’s influence on X and Y step by step

Collider Bias

Wed, 19 May 2021 00:00:00 +0000

the Causality Graph

Remove “Differences in X explained by C” vs. Remove “Differences in Y explained by C”

What the model does: Remove C’s influence on X and Y step by step

Instrument Variable

Wed, 12 May 2021 00:00:00 +0000

Causality Graph

Generate the Data for Analysis

# DGP
set.seed(66)
# Z is a binary variable in this case, but it can also be continuous.
df <- data.frame(Z = c(rep(0, 100), rep(1, 100)), 
                 W = rnorm(200)) %>%
  # Z affects X
  mutate(X = .5 + 2*W + 2*Z + rnorm(200)) %>% 
  # Z does NOT affect either Y or W (God's Game)
  mutate(Y = -X + 4*W + 1 + rnorm(200)) %>% 
  group_by(Z) %>%
  mutate(mean_X=mean(X), mean_Y=mean(Y)) %>%
  ungroup()

Visualization

Remove “Differences in X NOT explained by Z” vs. Remove “Differences in Y NOT explained by Z”

Retain “Differences in X and Y explained by Z” step by step

Run the Regression and Check the Estimate of X

library(AER)
# Z is the instrument variable
summary(ivreg(Y ~ X | Z , data = df)) %>% 
  coef() %>% 
  regrrr::to_long_tab()

##   n.r        var_      beta
## 1   1 (Intercept)    1.318*
## 2   1               (0.583)
## 3   2           X -1.089***
## 4   2               (0.300)

Sample Selection Bias

Wed, 12 May 2021 00:00:00 +0000

Causality Graph

DGP

set.seed(66)
# Generate Exogenous Variables
df <- data.frame(X = runif(300) * 10, 
                 W = runif(300) * 5, 
                 U = runif(300) * 2, 
                 Z = c(rep(0, 150), rep(1, 150))) %>%
  # God's Game
  # X (Visible) affects Y, W (Invisible) and U (Invisible) affect Y
  mutate(Y = .1 + .5*X + 0.8*W + 0.2*U + rnorm(300),
  # X (Visible) affects Y, W (Invisible) and U (Invisible) affect Latent Selection Function
  # Z (Visible) affect Latent Selection Function
         select_ = 10 + 3*X + 2*W + 1*U + .5*Z + rnorm(300),
  # Latent Selection Determines the True Selection
         select = ifelse(select_ > mean(select_), 1, 0)
         )

Run Heckman Regression

run_selection <- glm(select ~ X + Z, family = binomial( link = "probit" ), data = df)
df$IMR <- dnorm(run_selection$linear.predictors)/pnorm(run_selection$linear.predictors)
summary(run_selection)

## 
## Call:
## glm(formula = select ~ X + Z, family = binomial(link = "probit"), 
##     data = df)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.0059  -0.1287  -0.0013   0.1240   2.5195  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  -5.4514     0.6613  -8.244   <2e-16 ***
## X             1.0163     0.1213   8.380   <2e-16 ***
## Z             0.6183     0.2704   2.287   0.0222 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 415.03  on 299  degrees of freedom
## Residual deviance: 113.84  on 297  degrees of freedom
## AIC: 119.84
## 
## Number of Fisher Scoring iterations: 8

run_outcome <- lm(Y ~ IMR + X, data = df[which(df$select == 1),])
summary(run_outcome)

## 
## Call:
## lm(formula = Y ~ IMR + X, data = df[which(df$select == 1), ])
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.4067 -0.8600  0.0496  0.7680  3.4331 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   2.4928     0.8875   2.809  0.00569 ** 
## IMR           0.9237     0.4398   2.100  0.03749 *  
## X             0.4922     0.1099   4.477 1.56e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.338 on 139 degrees of freedom
## Multiple R-squared:  0.1532, Adjusted R-squared:  0.141 
## F-statistic: 12.58 on 2 and 139 DF,  p-value: 9.55e-06

Visualization

Double Check

# Run OLS (which is biased)
run_biased <- lm(Y ~ X, data = df[which(df$select == 1),])
summary(run_biased)

## 
## Call:
## lm(formula = Y ~ X, data = df[which(df$select == 1), ])
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.5643 -0.9695  0.1065  0.7926  3.2590 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   4.0168     0.5172   7.766 1.55e-12 ***
## X             0.3114     0.0692   4.500 1.42e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.354 on 140 degrees of freedom
## Multiple R-squared:  0.1263, Adjusted R-squared:  0.1201 
## F-statistic: 20.25 on 1 and 140 DF,  p-value: 1.419e-05

# Check the Inclusion Restriction
run_test_instrument <- lm(Y ~ X + Z, data = df[which(df$select == 1),])
summary(run_test_instrument)

## 
## Call:
## lm(formula = Y ~ X + Z, data = df[which(df$select == 1), ])
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.3369 -0.9958  0.1245  0.8445  3.1289 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  3.71761    0.54715   6.794 2.93e-10 ***
## X            0.32192    0.06913   4.657 7.42e-06 ***
## Z            0.37117    0.23158   1.603    0.111    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.347 on 139 degrees of freedom
## Multiple R-squared:  0.1422, Adjusted R-squared:  0.1299 
## F-statistic: 11.52 on 2 and 139 DF,  p-value: 2.347e-05

# In Reality, Only God Can Run This Regression (by Knowing about the Truth and Seeing the Invisibles).
run_ture <- lm(Y ~ U + W + X, data = df)
summary(run_ture)

## 
## Call:
## lm(formula = Y ~ U + W + X, data = df)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -3.02525 -0.64811 -0.01175  0.56035  2.71664 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 0.008025   0.188084   0.043  0.96600    
## U           0.330793   0.099258   3.333  0.00097 ***
## W           0.773520   0.040014  19.331  < 2e-16 ***
## X           0.499843   0.020288  24.637  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9544 on 296 degrees of freedom
## Multiple R-squared:  0.7703, Adjusted R-squared:  0.768 
## F-statistic: 330.9 on 3 and 296 DF,  p-value: < 2.2e-16

Control Variable

Wed, 05 May 2021 00:00:00 +0000

the Causality Graph

Simpson’s Paradox

Remove “Differences in X explained by W” vs. Remove “Differences in Y explained by W”

Remove W’s influence on X and Y step by step