Causal Diagrams

# Causal Diagrams

**Session 7**

]

---
class: center

---

# What causes spurious correlations?

1. Random chance

---

# What causes spurious correlations?

1. Random chance
1. Confounders

---

# How do we correct for these?

---
class: title title-1

# How do we correct for these?

# How do we correct for these?

---

![](img/spurious-correlations-book.jpg)

---

![](img/nic-cage.png)

---

```r
d <- tibble(
  year = 1999:2009,
  nic_cage = c(2, 2, 2, 3, 1, 1, 2, 3, 4, 1, 4),
  drownings = c(109, 102, 102, 98, 85, 95, 96, 98, 123, 94, 102),
)

cor.test(~ nic_cage + drownings, data = d)
```

```
## 
## 	Pearson's product-moment correlation
## 
## data:  nic_cage and drownings
## t = 2.6785, df = 9, p-value = 0.02527
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.1101273 0.9045101
## sample estimates:
##       cor 
## 0.6660043
```
]

---

```r
d <- tibble(
  year = 1999:2009,
  nic_cage = c(2, 2, 2, 3, 1, 1, 2, 3, 4, 1, 4),
  drownings = c(109, 102, 102, 98, 85, 95, 96, 98, 123, 94, 102),
)

cor.test(~ nic_cage + drownings, data = d)
```

```
## 
## 	Pearson's product-moment correlation
## 
## data:  nic_cage and drownings
## t = 2.6785, df = 9, p-value = 0.02527
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
*##  0.1101273 0.9045101
## sample estimates:
##       cor 
## 0.6660043
```
]

---

# How do we correct for these?

---

# How do we correct for these?

---

![](img/cheese.png)
---

```r
d <- tibble(
  year = 2000:2009,
  bedsheets = c(327, 456, 509, 497, 596, 573, 661, 741, 809, 717),
  cheese = c(29.8, 30.1, 30.5, 30.6, 31.3, 31.7, 32.6, 33.1, 32.7, 32.8),
)
cor.test(~bedsheets + cheese, data = d)
```

```
## 
## 	Pearson's product-moment correlation
## 
## data:  bedsheets and cheese
## t = 8.346, df = 8, p-value = 3.216e-05
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.7864140 0.9877242
## sample estimates:
##       cor 
## 0.9470911
```
]

---

```
## 
## 	Pearson's product-moment correlation
## 
## data:  bedsheets and cheese
## t = 8.346, df = 8, p-value = 3.216e-05
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
*##  0.7864140 0.9877242
## sample estimates:
##       cor 
## 0.9470911
```
]
---

# Confounder: time

.pull-left[
<img src="06-dags_files/figure-html/unnamed-chunk-6-1.png" width="504" style="display: block; margin: auto;" />
]

.pull-right[
<img src="06-dags_files/figure-html/unnamed-chunk-7-1.png" width="504" style="display: block; margin: auto;" />
]
---

```r
d <- tibble(
  year = 2000:2009,
  bedsheets = c(327, 456, 509, 497, 596, 573, 661, 741, 809, 717),
  cheese = c(29.8, 30.1, 30.5, 30.6, 31.3, 31.7, 32.6, 33.1, 32.7, 32.8),
* bedsheets_ind = bedsheets - lag(bedsheets),
* cheese_ind = cheese - lag(cheese)
)
cor.test(~bedsheets_ind + cheese_ind, data = d)
```

```
## 
## 	Pearson's product-moment correlation
## 
## data:  bedsheets_ind and cheese_ind
## t = 0.93825, df = 7, p-value = 0.3794
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.4240088  0.8170022
## sample estimates:
##       cor 
## 0.3342299
```
]
---
.small[

```r
d <- tibble(
  year = 2000:2009,
  bedsheets = c(327, 456, 509, 497, 596, 573, 661, 741, 809, 717),
  cheese = c(29.8, 30.1, 30.5, 30.6, 31.3, 31.7, 32.6, 33.1, 32.7, 32.8),
  bedsheets_ind = bedsheets - lag(bedsheets),
  cheese_ind = cheese - lag(cheese)
)
cor.test(~bedsheets_ind + cheese_ind, data = d)
```

```
## 
## 	Pearson's product-moment correlation
## 
## data:  bedsheets_ind and cheese_ind
*## t = 0.93825, df = 7, p-value = 0.3794
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
*##  -0.4240088  0.8170022
## sample estimates:
##       cor 
## 0.3342299
```
]
---

# Causal Diagrams

---
class: title title-1

# Causal Diagrams

---

# Causal Diagrams: DAGs

.box-inv-1.medium[directed]

]

.box-inv-1.medium[acyclic]

]

.box-inv-1.medium[graph]

]
---

# Causal Diagrams: DAGs

.box-inv-1.medium[directed]

]

.box-inv-1.medium[acyclic]

]

.box-inv-1.medium[graph]

]
---

# Causal Diagrams: DAGs

.box-inv-1.medium[directed]

]

.box-inv-1.medium[acyclic]

.box-inv-1.medium[graph]

]
---

# Causal Diagrams: DAGs

.box-inv-1.medium[directed]

]

.box-inv-1.medium[acyclic]

.box-inv-1.medium[graph]

# "Draw your assumptions before your conclusions" 
## -- Miguel Hernán
---
class: title-1 title

# Drawing causal diagrams

1. Specify your causal question

.footer[
Barrett & D'Agostino McGowan *Causal Inference Workshop* https://causal-inference-r-workshop.netlify.app
]

---

# Drawing causal diagrams

1. Specify your causal question
1. Use domain knowledge

.footer[
Barrett & D'Agostino McGowan *Causal Inference Workshop* https://causal-inference-r-workshop.netlify.app
]

---

# Drawing causal diagrams

1. Specify your causal question
1. Use domain knowledge
1. Write variables as nodes

.footer[
Barrett & D'Agostino McGowan *Causal Inference Workshop* https://causal-inference-r-workshop.netlify.app
]

---

# Drawing causal diagrams

1. Specify your causal question
1. Use domain knowledge
1. Write variables as nodes
1. Write causal pathways as arrows (edges)

.footer[
Barrett & D'Agostino McGowan *Causal Inference Workshop* https://causal-inference-r-workshop.netlify.app
]

---

# Specify your causal question

.box-inv-1.medium[Does listening to a comedy podcast the morning before an exam improve graduate students test scores?]

---

# Specify your causal question

---

# Specify your causal question

---

# Use domain knowledge

.pull-left[
.box-1[What are all of the things that could "cause" you to listen to a comedy podcast]
]
--

# <svg aria-hidden="true" role="img" viewBox="0 0 640 512" style="height:1em;width:1.25em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;"><path d="M624 416H381.54c-.74 19.81-14.71 32-32.74 32H288c-18.69 0-33.02-17.47-32.77-32H16c-8.8 0-16 7.2-16 16v16c0 35.2 28.8 64 64 64h512c35.2 0 64-28.8 64-64v-16c0-8.8-7.2-16-16-16zM576 48c0-26.4-21.6-48-48-48H112C85.6 0 64 21.6 64 48v336h512V48zm-64 272H128V64h384v256z"/></svg> Application Exercise

## [bit.ly/sta-679-s22-ae6](https://bit.ly/sta-679-s22-ae6)

---

# install.packages("ggdag")

---

# Specify your DAG

```r
library(ggdag)
dagify(
  podcast ~ mood + humor + prepared,
  exam ~ mood + prepared,
  exposure = "podcast",
  outcome = "exam"
) %>%
  ggdag() + 
  theme_dag()
```

---
class: title title-1

# Specify your DAG

```r
library(ggdag)
dagify(
* podcast ~ mood + humor + prepared,
  exam ~ mood + prepared,
  exposure = "podcast",
  outcome = "exam"
) %>%
  ggdag() + 
  theme_dag()
```

---
class: title title-1

# Specify your DAG

```r
library(ggdag)
dagify(
  podcast ~ mood + humor + prepared,
* exam ~ mood + prepared,
  exposure = "podcast",
  outcome = "exam"
) %>%
  ggdag() + 
  theme_dag()
```

---
class: title title-1

# Specify your DAG

```r
library(ggdag)
dagify(
  podcast ~ mood + humor + prepared,
  exam ~ mood + prepared,
* exposure = "podcast",
  outcome = "exam"
) %>%
  ggdag() + 
  theme_dag()
```

---
class: title title-1

# Specify your DAG

```r
library(ggdag)
dagify(
  podcast ~ mood + humor + prepared,
  exam ~ mood + prepared,
  exposure = "podcast",
* outcome = "exam"
) %>%
  ggdag() + 
  theme_dag()
```

---

# Specify your DAG

```r
library(ggdag)
dagify(
  podcast ~ mood + humor + prepared,
  exam ~ mood + prepared,
  exposure = "podcast",
  outcome = "exam"
) %>%
* ggdag() +
  theme_dag()
```

---

# Specify your DAG

---

# Spurious causal effect?

.box-inv-1.medium[Backdoor paths]

---

# Spurious associations

![](img/dags-cars/dags-cars.001.png)
---

# Eliminate backdoor paths

```r
dagify(
  podcast ~ mood + humor + prepared,
  exam ~ mood + prepared,
  exposure = "podcast",
  outcome = "exam"
) %>%
  ggdag_paths()
```

---

# Eliminate backdoor paths

```r
dagify(
  podcast ~ mood + humor + prepared,
  exam ~ mood + prepared,
  exposure = "podcast",
  outcome = "exam"
) %>%
* ggdag_paths()
```

---

# Eliminate backdoor paths

.pull-left[
<img src="06-dags_files/figure-html/unnamed-chunk-20-1.png" width="504" style="display: block; margin: auto;" />
]
--
.pull-right[
.box-1[What isn't here? Why?]
]
---

# Identify adjustment sets

```r
dagify(
  podcast ~ mood + humor + prepared,
  exam ~ mood + prepared,
  exposure = "podcast",
  outcome = "exam"
) %>%
  ggdag_adjustment_set()
```

---

# Identify adjustment sets

```r
dagify(
  podcast ~ mood + humor + prepared,
  exam ~ mood + prepared,
  exposure = "podcast",
  outcome = "exam"
) %>%
* ggdag_adjustment_set()
```

---

# Identify adjustment sets

---

# Time order

```r
coord_dag <- list(
  x = c(mood = 1, prepared = 1, podcast = 2, exam = 3),
  y = c(mood = 0.5, prepared = 1.5, podcast = 1, exam = 1)
)

dagify(
  podcast ~ prepared + mood ,
  exam ~ prepared + mood,
  coords = coord_dag
) %>%
  ggdag() +
  theme_dag()
```

---
class: title title-1
# Time order

```r
*coord_dag <- list(
  x = c(mood = 1, prepared = 1, podcast = 2, exam = 3), 
  y = c(mood = 0.5, prepared = 1.5, podcast = 1, exam = 1) 
*)

dagify(
  podcast ~ prepared + mood ,
  exam ~ prepared + mood,
  coords = coord_dag
) %>%
  ggdag() +
  theme_dag()
```

---

```r
coord_dag <- list( 
* x = c(mood = 1, prepared = 1, podcast = 2, exam = 3),
  y = c(mood = 0.5, prepared = 1.5, podcast = 1, exam = 1) 
)

dagify(
  podcast ~ prepared + mood ,
  exam ~ prepared + mood,
  coords = coord_dag
) %>%
  ggdag() +
  theme_dag()
```

---

```r
coord_dag <- list( 
  x = c(mood = 1, prepared = 1, podcast = 2, exam = 3), 
* y = c(mood = 0.5, prepared = 1.5, podcast = 1, exam = 1)
)

dagify(
  podcast ~ prepared + mood ,
  exam ~ prepared + mood,
  coords = coord_dag
) %>%
  ggdag() +
  theme_dag()
```

---

```r
coord_dag <- list( 
  x = c(mood = 1, prepared = 1, podcast = 2, exam = 3), 
  y = c(mood = 0.5, prepared = 1.5, podcast = 1, exam = 1) 
)

dagify(
  podcast ~ prepared + mood ,
  exam ~ prepared + mood,
* coords = coord_dag
) %>%
  ggdag() +
  theme_dag()
```

---

---

# Causal Diagram Practice

---

# Causal Diagram Practice

---

---

---

---

---

---