Week 6 - Good & Bad Controls

Multiple regression is no oracle, but only a golem. It is logical, but the relationships it describes are conditional associations, not causal influences. Therefore additional information, from outside the model, is needed to make sense of it. This chapter presented introductory examples of some common frustrations: multi-collinearity, post-treatment bias, and collider bias. Solutions to these frustrations can be organized under a coherent framework in which hypothetical causal relations among variables are analyzed to cope with confounding. In all cases, causal models exist outside the statistical model and can be difficult to test. However, it is possible to reach valid causal inferences in the absence of experiments. This is good news, because we often cannot perform experiments, both for practical and ethical reasons.

Place each answer inside the code chunk (grey box). The code chunks should contain a text response or a code that completes/answers the question or activity requested. Make sure to include plots if the question requests them.

Finally, upon completion, name your final output .html file as: YourName_ANLY505-Year-Semester.html and publish the assignment to your R Pubs account and submit the link to Canvas. Each question is worth 5 points.

Questions

6-1. Use the Waffle House data, data(WaffleDivorce), to find the total causal influence of number of Waffle Houses on divorce rate. Justify your model or models with a causal graph (draw a DAG).

##Model
data(WaffleDivorce)
waffl <- WaffleDivorce

model_waff <- quap(
  alist(
    Divorce ~ dnorm(mu, sigma),
    mu <- a + bS * South + bW * WaffleHouses,
    a ~ dnorm(0, 0.2),
    c(bS, bW) ~ dnorm(0, 0.5),
    sigma ~ dexp(1)
  ),
  data = waffl
)
precis(model_waff)
##             mean         sd        5.5%      94.5%
## a     0.24107359 0.20212236 -0.08195698 0.56410415
## bS    0.21518590 0.49545904 -0.57665335 1.00702515
## bW    0.06218674 0.01549952  0.03741552 0.08695797
## sigma 7.82235577 0.72281334  6.66716045 8.97755110
##DAG
DAG <- dagitty("dag {
    A -> D
    A -> M -> D
    A <- S -> M
    S -> W -> D
  }")

coordinates(DAG) <- list(
  x = c(A = 1, S = 1, M = 2, W = 3, D = 3),
  y = c(A = 1, S = 3, M = 2, W = 3, D = 1)
)
drawdag(DAG)

6-2. Build a series of models to test the implied conditional independencies of the causal graph you used in the previous problem. If any of the tests fail, how do you think the graph needs to be amended? Does the graph need more or fewer arrows? Feel free to nominate variables that arenโ€™t in the data.

# Implied conditional independence
impliedConditionalIndependencies(DAG)
## A _||_ W | S
## D _||_ S | A, M, W
## M _||_ W | S
# Check A _||_ W | S
model_waff1 <- quap(
alist(
    MedianAgeMarriage ~ dnorm(mu, sigma),
    mu <- a + bS * South + bW * WaffleHouses,
    a ~ dnorm(0, 0.2),
    c(bS, bW) ~ dnorm(0, 0.5),
    sigma ~ dexp(1))
  ,
  data = waffl
)

precis(model_waff1)
##              mean         sd        5.5%      94.5%
## a      0.10712612 0.20030749 -0.21300393  0.4272562
## bS     0.08254151 0.49920381 -0.71528259  0.8803656
## bW     0.15553096 0.03841525  0.09413597  0.2169259
## sigma 19.75044788 1.57124136 17.23930071 22.2615951
# Check D _||_ S | A, M, W
model_waff2 <- quap(
  alist(
    Divorce ~ dnorm(mu, sigma),
    mu <- a + bA * MedianAgeMarriage + bS * South + bM * Marriage + bW * WaffleHouses,
    a ~ dnorm(0, 0.2),
    c(bA, bS, bM, bW) ~ dnorm(0, 0.5),
    sigma ~ dexp(1)
  ),
  data = waffl
)

precis(model_waff2)
##              mean          sd         5.5%      94.5%
## a     0.018791279 0.199960954 -0.300784947 0.33836750
## bA    0.168965027 0.040746725  0.103843891 0.23408616
## bS    0.398898448 0.413037306 -0.261214940 1.05901184
## bM    0.246385770 0.051536500  0.164020489 0.32875105
## bW    0.005348704 0.004059425 -0.001139041 0.01183645
## sigma 1.640577933 0.161618288  1.382280693 1.89887517
# Check M _||_ W | S
model_waff3 <- quap(
  alist(
    Marriage ~ dnorm(mu, sigma),
    mu <- a + bS * South + bW * WaffleHouses,
    a ~ dnorm(0, 0.2),
    c(bS, bW) ~ dnorm(0, 0.5),
    sigma ~ dexp(1)
  ),
  data = waffl
)

precis(model_waff3)
##             mean         sd        5.5%      94.5%
## a      0.1267894 0.20045205 -0.19357168  0.4471505
## bS     0.1059497 0.49881614 -0.69125488  0.9031542
## bW     0.1224452 0.03098114  0.07293133  0.1719590
## sigma 15.8855053 1.31520224 13.78355808 17.9874525

6-3. Consider your own research question. Draw a DAG to represent it. What are the testable implications of your DAG? Are there any variables you could condition on to close all backdoor paths? Are there unobserved variables that you have omitted? Would a reasonable colleague imagine additional threats to causal inference that you have ignored?

##Question: Will Consumption of salmon will affect price?
#Directional Relationship: As consumption increases, so will demand and hence price.
#Backdoor channel: With more demand, the salmon farms/fisherman will increase production . This increased supply will affect price.
##DAG
DAG_salmon <- dagitty("dag {
    Sal_Consumption -> Sal_Price
    Sal_Consumption -> Sal_Production -> Sal_Price

  }")


drawdag(DAG_salmon)

6-4. For the DAG you made in the previous problem, can you write a data generating simulation for it? Can you design one or more statistical models to produce causal estimates? If so, try to calculate interesting counterfactuals. If not, use the simulation to estimate the size of the bias you might expect. Under what conditions would you, for example, infer the opposite of a true causal effect?

##Simulation:
N <-5000
set.seed(12345)
sal_consumption <-rnorm(N,10,3) 
sal_production <-sal_consumption*rnorm(N,0,2)+rnorm(N,10,3)
sal_price <-sal_consumption - sal_production + rnorm(N,0,2)
sal_data <-data.frame(sal_consumption,sal_production,sal_price)
# Model
model_salmon <- quap(
alist(
    sal_price ~ dnorm(mu, sigma),
    mu <- a + bD * sal_consumption + bS * sal_production,
    a ~ dnorm(0, 1),
    c(bD, bS) ~ dnorm(0, 2),
    sigma ~ dexp(1))
  ,
  data = sal_data
)

precis(model_salmon)
##              mean          sd       5.5%      94.5%
## a     -0.02277196 0.098347102 -0.1799496  0.1344057
## bD     1.00120874 0.009338947  0.9862833  1.0161342
## bS    -1.00018958 0.001312383 -1.0022870 -0.9980921
## sigma  1.96734004 0.019667675  1.9359073  1.9987728