time ordered

Author: malcolmbarrett

slides/raw/01-causal_modeling_whole_game.html

@@ -406,7 +406,7 @@ <h1 class="title">Causal Modeling in R: Whole Game</h1>
 <section id="section" class="slide level2" data-background-color="#23373B">
 <h2></h2>
 <ol type="1">
-<li class="fragment">Specify causal question</li>
+<li class="fragment">Specify causal question (e.g.&nbsp;target trial)</li>
 <li class="fragment">Draw assumptions (causal diagram)</li>
 <li class="fragment">Model assumptions (e.g.&nbsp;propensity score)</li>
 <li class="fragment">Analyze propensities (diagnostics)</li>
@@ -493,6 +493,10 @@ <h3 id="what-do-i-need-to-control-for">What do I need to control for?</h3>
 
 
 <img data-src="01-causal_modeling_whole_game_files/figure-revealjs/unnamed-chunk-7-1.png" style="width:80.0%" class="r-stretch quarto-figure-center"></section>
+<section class="slide level2">
+
+
+<img data-src="01-causal_modeling_whole_game_files/figure-revealjs/unnamed-chunk-8-1.png" style="width:80.0%" class="r-stretch quarto-figure-center"></section>
 <section id="multivariable-regression-whats-the-association" class="slide level2">
 <h2>Multivariable regression: what’s the association?</h2>
 <div class="cell" data-layout-align="center">
@@ -557,23 +561,23 @@ <h3 id="diagnose-your-model-assumptions"><strong>diagnose your model assumptions
 <section id="whats-the-distribution-of-weights" class="slide level2">
 <h2>What’s the distribution of weights?</h2>
 
-<img data-src="01-causal_modeling_whole_game_files/figure-revealjs/unnamed-chunk-11-1.png" style="width:80.0%" class="r-stretch quarto-figure-center"></section>
+<img data-src="01-causal_modeling_whole_game_files/figure-revealjs/unnamed-chunk-12-1.png" style="width:80.0%" class="r-stretch quarto-figure-center"></section>
 <section id="what-are-the-weights-doing-to-the-sample" class="slide level2">
 <h2>What are the weights doing to the sample?</h2>
 
-<img data-src="01-causal_modeling_whole_game_files/figure-revealjs/unnamed-chunk-12-1.png" style="width:80.0%" class="r-stretch quarto-figure-center"></section>
+<img data-src="01-causal_modeling_whole_game_files/figure-revealjs/unnamed-chunk-13-1.png" style="width:80.0%" class="r-stretch quarto-figure-center"></section>
 <section id="what-are-the-weights-doing-to-the-sample-1" class="slide level2">
 <h2>What are the weights doing to the sample?</h2>
 
-<img data-src="01-causal_modeling_whole_game_files/figure-revealjs/unnamed-chunk-13-1.png" style="width:80.0%" class="r-stretch quarto-figure-center"></section>
+<img data-src="01-causal_modeling_whole_game_files/figure-revealjs/unnamed-chunk-14-1.png" style="width:80.0%" class="r-stretch quarto-figure-center"></section>
 <section class="slide level2">
 
 
-<img data-src="01-causal_modeling_whole_game_files/figure-revealjs/unnamed-chunk-15-1.png" style="width:80.0%" class="r-stretch quarto-figure-center"></section>
+<img data-src="01-causal_modeling_whole_game_files/figure-revealjs/unnamed-chunk-16-1.png" style="width:80.0%" class="r-stretch quarto-figure-center"></section>
 <section class="slide level2">
 
 
-<img data-src="01-causal_modeling_whole_game_files/figure-revealjs/unnamed-chunk-16-1.png" style="width:80.0%" class="r-stretch quarto-figure-center"></section>
+<img data-src="01-causal_modeling_whole_game_files/figure-revealjs/unnamed-chunk-17-1.png" style="width:80.0%" class="r-stretch quarto-figure-center"></section>
 <section id="section-8" class="slide level2 center" data-background-color="#23373B">
 <h2></h2>
 <h3 id="estimate-the-causal-effects"><strong>estimate the causal effects</strong></h3>
@@ -712,7 +716,7 @@ <h2>Using {rsample} to bootstrap our causal effect</h2>
 </div></section><section id="section-10" class="slide level2 center">
 <h2></h2>
 
-<img data-src="01-causal_modeling_whole_game_files/figure-revealjs/unnamed-chunk-25-1.png" style="width:80.0%" class="r-stretch quarto-figure-center"></section>
+<img data-src="01-causal_modeling_whole_game_files/figure-revealjs/unnamed-chunk-26-1.png" style="width:80.0%" class="r-stretch quarto-figure-center"></section>
 <section id="section-11" class="slide level2 center" data-background-color="#23373B">
 <h2></h2>
 <h3 id="our-causal-effect-estimate-3.5-kg-95-ci-2.4-kg-4.4-kg"><em>Our causal effect estimate: <strong>3.5 kg (95% CI 2.4 kg, 4.4 kg)</strong></em></h3>
@@ -724,8 +728,8 @@ <h3 id="review-the-quarto-file-later"><strong>Review the Quarto file… later!</
 <section id="resources" class="slide level2" data-background-color="#23373B">
 <h2>Resources</h2>
 <h3 id="causal-inference-comprehensive-text-on-causal-inference.-free-online."><a href="https://www.hsph.harvard.edu/miguel-hernan/causal-inference-book/">Causal Inference</a>: Comprehensive text on causal inference. Free online.</h3>
-<h3 id="causal-inference-notebook-r-code-to-go-along-with-causal-inference"><a href="http://causalinferencebookr.netlify.com">Causal Inference Notebook</a>: R code to go along with Causal Inference</h3>
 <h3 id="bootstrap-confidence-intervals-with-rsample"><a href="https://rsample.tidymodels.org/articles/Applications/Intervals.html">Bootstrap confidence intervals with {rsample}</a></h3>
+<h3 id="r-causal-our-github-org-with-r-packages-and-examples"><a href="https://github.com/r-causal">R-causal</a>: Our GitHub org with R packages and examples</h3>
 <div class="footer footer-default">
 
 </div>

slides/raw/01-causal_modeling_whole_game.qmd

@@ -92,9 +92,17 @@ nhefs_complete_uc |>
 
 ```{r}
 #| echo: false
-#| fig.height: 5.5
+#| fig.width: 9
 library(ggdag)
 # set up DAG
+coords <- time_ordered_coords(
+  list(
+    c("active", "age", "education", "exercise", "race", "sex", "smokeintensity", 
+"smokeyrs", "wt71"),
+    "qsmk",
+    "wt82_71"
+  )
+)
 smk_wt_dag <- dagify(
   # specify causes of quitting smoking and weight gain:
   qsmk ~ sex + race + age + education + 
@@ -104,6 +112,7 @@ smk_wt_dag <- dagify(
   # specify causal question:
   exposure = "qsmk", 
   outcome = "wt82_71",
+  coords = coords,
   # set up labels:
   # here, I'll use the same variable names as the data set, but I'll label them
   # with clearer names
@@ -128,7 +137,7 @@ smk_wt_dag <- dagify(
     "smokeyrs" = "yrs of\nsmoking"
   )
 ) |>
-  tidy_dagitty(layout = "star")
+  tidy_dagitty()
 
 smk_wt_dag |>
   filter(name %in% c("qsmk", "wt82_71")) |>
@@ -142,7 +151,7 @@ smk_wt_dag |>
 
 ```{r}
 #| echo: false
-#| fig.height: 5.5
+#| fig.width: 9
 smk_wt_dag |>
   ggdag(text = FALSE, use_labels = "label") +
   ylim(min(smk_wt_dag$data$y) - 0.25, max(smk_wt_dag$data$y) + 0.25) +  
@@ -154,6 +163,80 @@ smk_wt_dag |>
 
 ### What do I need to control for?
 
+---
+
+```{r}
+#| echo: false
+#| fig.width: 15
+library(ggokabeito)
+glyph <- function(data, params, size) {
+    data$shape <- 15
+    data$size <- 12
+    ggplot2::draw_key_point(data, params, size)
+}
+
+smk_wt_dag |>
+    dag_paths() |>
+    mutate(
+        effects = case_when(
+            set == "1" & path == "open path" ~ "true effect",
+            path == "open path" ~ "confounding effect",
+            TRUE ~ NA_character_
+        ),
+        effects = factor(effects, c("true effect", "confounding effect"))
+    ) |>
+    ggplot(aes(x = x, y = y, xend = xend, yend = yend, color = effects, alpha = path)) +
+    geom_dag_edges(aes(edge_alpha = path, edge_colour = effects), show.legend = FALSE) +
+    geom_dag_point(
+        data = function(.x) dplyr::filter(.x, is.na(path)),
+        key_glyph = glyph
+    ) +
+    geom_dag_point(
+        data = function(.x) dplyr::filter(.x, !is.na(path)),
+        key_glyph = glyph
+    ) +
+    facet_wrap(vars(fct_inorder(factor(set)))) +
+    expand_plot(
+        expand_x = expansion(c(0.25, 0.25)),
+        expand_y = expansion(c(0.1, 0.1))
+    ) +
+    theme_dag() +
+    theme(
+        legend.position = "top",
+        legend.spacing.x = unit(8, "mm"),
+        legend.text = element_text(size = rel(2.5)),
+        legend.box.margin = margin(b = 20),
+        strip.text = element_blank()
+    ) +
+    coord_cartesian(clip = "off") +
+    scale_alpha_manual(
+        drop = FALSE,
+        values = c("open path" = 1),
+        na.value = .5,
+        breaks = "open path"
+    ) +
+    ggraph::scale_edge_alpha_manual(
+        drop = FALSE,
+        values = c("open path" = 1),
+        na.value = .5,
+        breaks = "open path"
+    ) +
+    scale_color_okabe_ito(
+        name = NULL,
+        na.value = "grey90",
+        order = c(3, 6),
+        breaks = c("true effect", "confounding effect")
+    ) +
+    scale_edge_color_okabe_ito(
+        name = NULL,
+        na.value = "grey90",
+        order = c(3, 6),
+        breaks = c("true effect", "confounding effect")
+    ) +
+    guides(alpha = "none", edge_alpha = "none")
+```
+
+
 ---
 
 ```{r}
@@ -291,7 +374,7 @@ plot_df <- nhefs_complete_uc |>
 #| echo: false
 #| fig.height: 5.5
 ggplot(
-  data = plot_df |> filter(method == "wts"),
+  data = plot_df |> filter(method == "observed"),
   aes(x = abs(smd), y = variable, group = method, color = method, fill = method)
 ) +
   geom_line(orientation = "y", size = 1) +
@@ -316,8 +399,8 @@ ggplot(
   geom_vline(xintercept = 0.1, color = "black", linewidth = 0.3) +
   theme_minimal(base_size = 20) +
   theme(axis.title.y = element_blank()) +
-  scale_color_manual(values = c("#00BFC4", "grey85")) +
-  scale_fill_manual(values = c("#00BFC4", "grey85")) +
+  scale_color_manual(values = c("grey85", "#00BFC4")) +
+  scale_fill_manual(values = c("grey85", "#00BFC4")) +
   xlim(0, .3)
 ```