diff --git a/R/plot.R b/R/plot.R index bbea882..72322cc 100644 --- a/R/plot.R +++ b/R/plot.R @@ -102,12 +102,31 @@ plot.outstandR <- function(x, ..., plot_df$Model <- factor(plot_df$Model, levels = model_levels) } + # Define custom colors so that any naive model is plotted in black + n_models <- length(model_levels) + is_naive <- grepl("Naive", model_levels, ignore.case = TRUE) + n_non_naive <- sum(!is_naive) + + if (n_non_naive > 0) { + non_naive_colors <- grDevices::hcl( + h = seq(15, 375, length.out = n_non_naive + 1)[1:n_non_naive], + c = 100, + l = 65 + ) + } else { + non_naive_colors <- character(0) + } + + model_colors <- stats::setNames(rep("black", n_models), model_levels) + model_colors[!is_naive] <- non_naive_colors + # combined forest plot ggplot( plot_df, aes(x = .data$Estimate, y = .data$Treatments, color = .data$Model)) + geom_point(position = position_dodge(width = 0.5), size = 3) + geom_errorbarh(aes(xmin = .data$lower.0.95, xmax = .data$upper.0.95), position = position_dodge(width = 0.5), height = 0.2, na.rm = TRUE) + + scale_color_manual(values = model_colors) + facet_wrap(~.data$Type, scales = "free") + geom_vline(data = dplyr::filter(plot_df, .data$Type == "Relative Contrasts"), aes(xintercept = 0), linetype = "dashed", color = "gray50") + diff --git a/scripts/exercises2.html b/scripts/exercises2.html index 854ab4f..7b31f55 100644 --- a/scripts/exercises2.html +++ b/scripts/exercises2.html @@ -327,15 +327,15 @@

Function Arguments

Chain 1: Iteration: 1500 / 2000 [ 75%] (Sampling) Chain 1: Iteration: 2000 / 2000 [100%] (Sampling) Chain 1: -Chain 1: Elapsed Time: 0.228 seconds (Warm-up) -Chain 1: 0.202 seconds (Sampling) -Chain 1: 0.43 seconds (Total) +Chain 1: Elapsed Time: 0.218 seconds (Warm-up) +Chain 1: 0.204 seconds (Sampling) +Chain 1: 0.422 seconds (Total) Chain 1: SAMPLING FOR MODEL 'bernoulli' NOW (CHAIN 2). Chain 2: -Chain 2: Gradient evaluation took 2.1e-05 seconds -Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.21 seconds. +Chain 2: Gradient evaluation took 1.7e-05 seconds +Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.17 seconds. Chain 2: Adjust your expectations accordingly! Chain 2: Chain 2: @@ -347,8 +347,8 @@

Function Arguments

Chain 2: Iteration: 2000 / 2000 [100%] (Sampling) Chain 2: Chain 2: Elapsed Time: 0.213 seconds (Warm-up) -Chain 2: 0.201 seconds (Sampling) -Chain 2: 0.414 seconds (Total) +Chain 2: 0.202 seconds (Sampling) +Chain 2: 0.415 seconds (Total) Chain 2: @@ -369,8 +369,8 @@

Function Arguments


 SAMPLING FOR MODEL 'bernoulli' NOW (CHAIN 1).
 Chain 1: 
-Chain 1: Gradient evaluation took 2.8e-05 seconds
-Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.28 seconds.
+Chain 1: Gradient evaluation took 3.2e-05 seconds
+Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.32 seconds.
 Chain 1: Adjust your expectations accordingly!
 Chain 1: 
 Chain 1: 
@@ -387,9 +387,9 @@ 
Function Arguments

 Chain 1: Iteration: 1800 / 2000 [ 90%]  (Sampling)
 Chain 1: Iteration: 2000 / 2000 [100%]  (Sampling)
 Chain 1: 
-Chain 1:  Elapsed Time: 0.224 seconds (Warm-up)
-Chain 1:                0.208 seconds (Sampling)
-Chain 1:                0.432 seconds (Total)
+Chain 1:  Elapsed Time: 0.228 seconds (Warm-up)
+Chain 1:                0.205 seconds (Sampling)
+Chain 1:                0.433 seconds (Total)
 Chain 1: 
 
 SAMPLING FOR MODEL 'bernoulli' NOW (CHAIN 2).
@@ -413,8 +413,8 @@ 
Function Arguments

 Chain 2: Iteration: 2000 / 2000 [100%]  (Sampling)
 Chain 2: 
 Chain 2:  Elapsed Time: 0.21 seconds (Warm-up)
-Chain 2:                0.213 seconds (Sampling)
-Chain 2:                0.423 seconds (Total)
+Chain 2:                0.215 seconds (Sampling)
+Chain 2:                0.425 seconds (Total)
 Chain 2:
@@ -570,8 +570,8 @@

Function Arguments


 SAMPLING FOR MODEL 'bernoulli' NOW (CHAIN 1).
 Chain 1: 
-Chain 1: Gradient evaluation took 2.4e-05 seconds
-Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.24 seconds.
+Chain 1: Gradient evaluation took 2.5e-05 seconds
+Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.25 seconds.
 Chain 1: Adjust your expectations accordingly!
 Chain 1: 
 Chain 1: 
@@ -582,9 +582,9 @@ 
Function Arguments

 Chain 1: Iteration: 1500 / 2000 [ 75%]  (Sampling)
 Chain 1: Iteration: 2000 / 2000 [100%]  (Sampling)
 Chain 1: 
-Chain 1:  Elapsed Time: 0.223 seconds (Warm-up)
-Chain 1:                0.206 seconds (Sampling)
-Chain 1:                0.429 seconds (Total)
+Chain 1:  Elapsed Time: 0.219 seconds (Warm-up)
+Chain 1:                0.203 seconds (Sampling)
+Chain 1:                0.422 seconds (Total)
 Chain 1: 
 
 SAMPLING FOR MODEL 'bernoulli' NOW (CHAIN 2).
@@ -601,9 +601,9 @@ 
Function Arguments

 Chain 2: Iteration: 1500 / 2000 [ 75%]  (Sampling)
 Chain 2: Iteration: 2000 / 2000 [100%]  (Sampling)
 Chain 2: 
-Chain 2:  Elapsed Time: 0.216 seconds (Warm-up)
+Chain 2:  Elapsed Time: 0.21 seconds (Warm-up)
 Chain 2:                0.202 seconds (Sampling)
-Chain 2:                0.418 seconds (Total)
+Chain 2:                0.412 seconds (Total)
 Chain 2:
@@ -659,8 +659,8 @@

Function Arguments


 SAMPLING FOR MODEL 'bernoulli' NOW (CHAIN 1).
 Chain 1: 
-Chain 1: Gradient evaluation took 3.4e-05 seconds
-Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.34 seconds.
+Chain 1: Gradient evaluation took 3.9e-05 seconds
+Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.39 seconds.
 Chain 1: Adjust your expectations accordingly!
 Chain 1: 
 Chain 1: 
@@ -677,15 +677,15 @@ 
Function Arguments

 Chain 1: Iteration: 1800 / 2000 [ 90%]  (Sampling)
 Chain 1: Iteration: 2000 / 2000 [100%]  (Sampling)
 Chain 1: 
-Chain 1:  Elapsed Time: 0.285 seconds (Warm-up)
-Chain 1:                0.253 seconds (Sampling)
-Chain 1:                0.538 seconds (Total)
+Chain 1:  Elapsed Time: 0.225 seconds (Warm-up)
+Chain 1:                0.205 seconds (Sampling)
+Chain 1:                0.43 seconds (Total)
 Chain 1: 
 
 SAMPLING FOR MODEL 'bernoulli' NOW (CHAIN 2).
 Chain 2: 
-Chain 2: Gradient evaluation took 3e-05 seconds
-Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.3 seconds.
+Chain 2: Gradient evaluation took 1.7e-05 seconds
+Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.17 seconds.
 Chain 2: Adjust your expectations accordingly!
 Chain 2: 
 Chain 2: 
@@ -702,9 +702,9 @@ 
Function Arguments

 Chain 2: Iteration: 1800 / 2000 [ 90%]  (Sampling)
 Chain 2: Iteration: 2000 / 2000 [100%]  (Sampling)
 Chain 2: 
-Chain 2:  Elapsed Time: 0.243 seconds (Warm-up)
-Chain 2:                0.214 seconds (Sampling)
-Chain 2:                0.457 seconds (Total)
+Chain 2:  Elapsed Time: 0.205 seconds (Warm-up)
+Chain 2:                0.217 seconds (Sampling)
+Chain 2:                0.422 seconds (Total)
 Chain 2:
@@ -880,22 +880,33 @@

Function Arguments

5. Build the Forest Plot

-
ggplot(all_results_intro, aes(x = Estimate, y = Method, color = Method)) +
-  geom_point(size = 4) +
-  geom_errorbarh(aes(xmin = lower.0.95, xmax = upper.0.95), height = 0.2, linewidth = 1, na.rm = TRUE) +
-  geom_vline(xintercept = 0, linetype = "dashed", color = "gray50", linewidth = 1) +
-  theme_minimal() +
-  labs(
-    title = "Relative Treatment Effect (A vs B)",
-    subtitle = "Adjusted vs. Unadjusted Anchored Estimates",
-    x = "Risk Difference",
-    y = ""
-  ) +
-  theme(
-    legend.position = "none",
-    axis.text.y = element_text(size = 11, face = "bold"),
-    plot.title = element_text(face = "bold", size = 14)
-  )
+
# Define colors: naive is black, others are default ggplot2 colors
+methods_intro <- levels(all_results_intro$Method)
+is_naive_intro <- grepl("Naive", methods_intro, ignore.case = TRUE)
+n_non_naive_intro <- sum(!is_naive_intro)
+colors_intro <- stats::setNames(rep("black", length(methods_intro)), methods_intro)
+colors_intro[!is_naive_intro] <- grDevices::hcl(
+  h = seq(15, 375, length.out = n_non_naive_intro + 1)[1:n_non_naive_intro], 
+  c = 100, l = 65
+)
+
+ggplot(all_results_intro, aes(x = Estimate, y = Method, color = Method)) +
+  geom_point(size = 4) +
+  geom_errorbarh(aes(xmin = lower.0.95, xmax = upper.0.95), height = 0.2, linewidth = 1, na.rm = TRUE) +
+  scale_color_manual(values = colors_intro) +
+  geom_vline(xintercept = 0, linetype = "dashed", color = "gray50", linewidth = 1) +
+  theme_minimal() +
+  labs(
+    title = "Relative Treatment Effect (A vs B)",
+    subtitle = "Adjusted vs. Unadjusted Anchored Estimates",
+    x = "Risk Difference",
+    y = ""
+  ) +
+  theme(
+    legend.position = "none",
+    axis.text.y = element_text(size = 11, face = "bold"),
+    plot.title = element_text(face = "bold", size = 14)
+  )
@@ -1009,8 +1020,8 @@

Exercises


 SAMPLING FOR MODEL 'continuous' NOW (CHAIN 1).
 Chain 1: 
-Chain 1: Gradient evaluation took 8.4e-05 seconds
-Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.84 seconds.
+Chain 1: Gradient evaluation took 4.7e-05 seconds
+Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.47 seconds.
 Chain 1: Adjust your expectations accordingly!
 Chain 1: 
 Chain 1: 
@@ -1028,8 +1039,8 @@ 
Exercises

 
 SAMPLING FOR MODEL 'continuous' NOW (CHAIN 2).
 Chain 2: 
-Chain 2: Gradient evaluation took 1e-05 seconds
-Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.1 seconds.
+Chain 2: Gradient evaluation took 9e-06 seconds
+Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.09 seconds.
 Chain 2: Adjust your expectations accordingly!
 Chain 2: 
 Chain 2: 
@@ -1040,9 +1051,9 @@ 
Exercises

 Chain 2: Iteration: 1500 / 2000 [ 75%]  (Sampling)
 Chain 2: Iteration: 2000 / 2000 [100%]  (Sampling)
 Chain 2: 
-Chain 2:  Elapsed Time: 0.073 seconds (Warm-up)
-Chain 2:                0.09 seconds (Sampling)
-Chain 2:                0.163 seconds (Total)
+Chain 2:  Elapsed Time: 0.072 seconds (Warm-up)
+Chain 2:                0.087 seconds (Sampling)
+Chain 2:                0.159 seconds (Total)
 Chain 2:
@@ -1082,15 +1093,15 @@

Exercises

Chain 1: Iteration: 1800 / 2000 [ 90%] (Sampling) Chain 1: Iteration: 2000 / 2000 [100%] (Sampling) Chain 1: -Chain 1: Elapsed Time: 0.082 seconds (Warm-up) +Chain 1: Elapsed Time: 0.08 seconds (Warm-up) Chain 1: 0.082 seconds (Sampling) -Chain 1: 0.164 seconds (Total) +Chain 1: 0.162 seconds (Total) Chain 1: SAMPLING FOR MODEL 'continuous' NOW (CHAIN 2). Chain 2: -Chain 2: Gradient evaluation took 3.2e-05 seconds -Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.32 seconds. +Chain 2: Gradient evaluation took 1.1e-05 seconds +Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.11 seconds. Chain 2: Adjust your expectations accordingly! Chain 2: Chain 2: @@ -1108,8 +1119,8 @@

Exercises

Chain 2: Iteration: 2000 / 2000 [100%] (Sampling) Chain 2: Chain 2: Elapsed Time: 0.082 seconds (Warm-up) -Chain 2: 0.091 seconds (Sampling) -Chain 2: 0.173 seconds (Total) +Chain 2: 0.093 seconds (Sampling) +Chain 2: 0.175 seconds (Total) Chain 2:
@@ -1477,27 +1488,38 @@

Exercises

"G-comp ML (Anchored, Adjusted)" )) -ggplot(all_results_final, aes(x = Estimate, y = Method, color = Method)) + - geom_point(size = 4) + - geom_errorbarh(aes(xmin = lower.0.95, xmax = upper.0.95), height = 0.2, linewidth = 1, na.rm = TRUE) + - - # Highlight True Effect (0.0) with a distinct line - geom_vline(aes(xintercept = 0, linetype = "True Underlying Effect"), color = "red", linewidth = 1.2) + - scale_linetype_manual(name = "", values = "dashed") + - - theme_minimal() + - labs( - title = "Relative Treatment Effect (A vs B)", - subtitle = "The Impact of Population Adjustment and Anchoring Assumptions", - x = "Risk Difference", - y = "" - ) + - theme( - legend.position = "bottom", # Show the legend so can see the "True Effect" label - axis.text.y = element_text(size = 11, face = "bold"), - plot.title = element_text(face = "bold", size = 14) - ) + - guides(color = "none") # Hide redundant colour legend for methods
+# Define colors dynamically: naive is black, others are default ggplot2 colors +methods_final <- levels(all_results_final$Method) +is_naive_final <- grepl("Naive", methods_final, ignore.case = TRUE) +n_non_naive_final <- sum(!is_naive_final) +colors_final <- stats::setNames(rep("black", length(methods_final)), methods_final) +colors_final[!is_naive_final] <- grDevices::hcl( + h = seq(15, 375, length.out = n_non_naive_final + 1)[1:n_non_naive_final], + c = 100, l = 65 +) + +ggplot(all_results_final, aes(x = Estimate, y = Method, color = Method)) + + geom_point(size = 4) + + geom_errorbarh(aes(xmin = lower.0.95, xmax = upper.0.95), height = 0.2, linewidth = 1, na.rm = TRUE) + + scale_color_manual(values = colors_final) + + + # Highlight True Effect (0.0) with a distinct line + geom_vline(aes(xintercept = 0, linetype = "True Underlying Effect"), color = "red", linewidth = 1.2) + + scale_linetype_manual(name = "", values = "dashed") + + + theme_minimal() + + labs( + title = "Relative Treatment Effect (A vs B)", + subtitle = "The Impact of Population Adjustment and Anchoring Assumptions", + x = "Risk Difference", + y = "" + ) + + theme( + legend.position = "bottom", # Show the legend so can see the "True Effect" label + axis.text.y = element_text(size = 11, face = "bold"), + plot.title = element_text(face = "bold", size = 14) + ) + + guides(color = "none") # Hide redundant colour legend for methods
diff --git a/scripts/exercises2.qmd b/scripts/exercises2.qmd index 8d5427b..dad4bca 100644 --- a/scripts/exercises2.qmd +++ b/scripts/exercises2.qmd @@ -341,9 +341,20 @@ all_results_intro$Method <- factor(all_results_intro$Method, levels = c( ```{r} #| echo: true +# Define colors: naive is black, others are default ggplot2 colors +methods_intro <- levels(all_results_intro$Method) +is_naive_intro <- grepl("Naive", methods_intro, ignore.case = TRUE) +n_non_naive_intro <- sum(!is_naive_intro) +colors_intro <- stats::setNames(rep("black", length(methods_intro)), methods_intro) +colors_intro[!is_naive_intro] <- grDevices::hcl( + h = seq(15, 375, length.out = n_non_naive_intro + 1)[1:n_non_naive_intro], + c = 100, l = 65 +) + ggplot(all_results_intro, aes(x = Estimate, y = Method, color = Method)) + geom_point(size = 4) + geom_errorbarh(aes(xmin = lower.0.95, xmax = upper.0.95), height = 0.2, linewidth = 1, na.rm = TRUE) + + scale_color_manual(values = colors_intro) + geom_vline(xintercept = 0, linetype = "dashed", color = "gray50", linewidth = 1) + theme_minimal() + labs( @@ -696,9 +707,20 @@ all_results_final$Method <- factor(all_results_final$Method, levels = c( "G-comp ML (Anchored, Adjusted)" )) +# Define colors dynamically: naive is black, others are default ggplot2 colors +methods_final <- levels(all_results_final$Method) +is_naive_final <- grepl("Naive", methods_final, ignore.case = TRUE) +n_non_naive_final <- sum(!is_naive_final) +colors_final <- stats::setNames(rep("black", length(methods_final)), methods_final) +colors_final[!is_naive_final] <- grDevices::hcl( + h = seq(15, 375, length.out = n_non_naive_final + 1)[1:n_non_naive_final], + c = 100, l = 65 +) + ggplot(all_results_final, aes(x = Estimate, y = Method, color = Method)) + geom_point(size = 4) + geom_errorbarh(aes(xmin = lower.0.95, xmax = upper.0.95), height = 0.2, linewidth = 1, na.rm = TRUE) + + scale_color_manual(values = colors_final) + # Highlight True Effect (0.0) with a distinct line geom_vline(aes(xintercept = 0, linetype = "True Underlying Effect"), color = "red", linewidth = 1.2) + diff --git a/scripts/exercises2_files/figure-html/unnamed-chunk-12-1.png b/scripts/exercises2_files/figure-html/unnamed-chunk-12-1.png index 6810bff..9fcfc86 100644 Binary files a/scripts/exercises2_files/figure-html/unnamed-chunk-12-1.png and b/scripts/exercises2_files/figure-html/unnamed-chunk-12-1.png differ diff --git a/scripts/exercises2_files/figure-html/unnamed-chunk-14-1.png b/scripts/exercises2_files/figure-html/unnamed-chunk-14-1.png index 85dfa1d..e9c6b5d 100644 Binary files a/scripts/exercises2_files/figure-html/unnamed-chunk-14-1.png and b/scripts/exercises2_files/figure-html/unnamed-chunk-14-1.png differ diff --git a/scripts/exercises2_files/figure-html/unnamed-chunk-25-1.png b/scripts/exercises2_files/figure-html/unnamed-chunk-25-1.png index e07e43f..06d92b5 100644 Binary files a/scripts/exercises2_files/figure-html/unnamed-chunk-25-1.png and b/scripts/exercises2_files/figure-html/unnamed-chunk-25-1.png differ diff --git a/scripts/exercises2_files/figure-html/unnamed-chunk-9-1.png b/scripts/exercises2_files/figure-html/unnamed-chunk-9-1.png index 9f851e9..95ea92d 100644 Binary files a/scripts/exercises2_files/figure-html/unnamed-chunk-9-1.png and b/scripts/exercises2_files/figure-html/unnamed-chunk-9-1.png differ diff --git a/scripts/practical_paic.pdf b/scripts/practical_paic.pdf index 20c31f5..f368c6a 100644 Binary files a/scripts/practical_paic.pdf and b/scripts/practical_paic.pdf differ