The small districts are worse, but I still think the priors are wrong

Author: athowes

vignettes/ebola.Rmd

@@ -178,17 +178,21 @@ Sub-sample the data for speed.
 Use ADVI for speed.
 
 ```{r}
+set.seed(1)
+
 N <- nrow(obs_cens)
 obs_cens <- obs_cens[complete.cases(obs_cens)]
 N_complete <- nrow(obs_cens)
-obs_cens <- obs_cens[sample(seq_len(.N), N_complete / 10, replace = FALSE)]
+N_complete / N
+obs_cens <- obs_cens[sample(seq_len(.N), N_complete / 5, replace = FALSE)]
 obs_prep <- as_latent_individual(obs_cens)
 
 fit <- epidist::epidist(
   data = obs_prep,
   formula = brms::bf(mu ~ 1, sigma ~ 1),
   family = brms::lognormal(),
-  algorithm = "laplace"
+  algorithm = "laplace",
+  refresh = 0
 )
 
 summary(fit)
@@ -201,7 +205,8 @@ fit_sex <- epidist::epidist(
   data = obs_prep,
   formula = brms::bf(mu ~ 1 + sex, sigma ~ 1 + sex),
   family = brms::lognormal(),
-  algorithm = "laplace"
+  algorithm = "laplace",
+  refresh = 0
 )
 
 summary(fit_sex)
@@ -214,7 +219,8 @@ fit_sex_district <- epidist::epidist(
   data = obs_prep,
   formula = brms::bf(mu ~ 1 + sex + district, sigma ~ 1 + sex + district),
   family = brms::lognormal(),
-  algorithm = "laplace"
+  algorithm = "laplace",
+  refresh = 0
 )
 
 summary(fit_sex_district)
@@ -227,8 +233,16 @@ Posterior expectation of the delay distribution by covariate under no censoring
 ```{r}
 epred_draws <- obs_prep |>
   as.data.frame() |>
+  modelr::data_grid(NA) |>
+  dplyr::mutate(obs_t = NA, pwindow_upr = NA, swindow_upr = NA) |>
   add_epred_draws(fit, dpar = TRUE)
 
+epred_draws |>
+  ggplot(aes(x = .epred)) +
+    tidybayes::stat_slab() +
+    labs(x = "Posterior expectation of the delay", y = "") +
+    theme_minimal()
+
 # We will probably want to add functionality for users to mutate these things
 # to the newdata themselves
 epred_draws_sex <- obs_prep |>
@@ -245,7 +259,7 @@ epred_draws_sex |>
     )
   ) |>
   ggplot(aes(x = .epred, y = sex)) +
-    stat_slab() +
+    tidybayes::stat_slab() +
     labs(x = "Posterior expectation of the delay", y = "") +
     theme_minimal()
 
@@ -255,9 +269,47 @@ epred_draws_sex_district <- obs_prep |>
   dplyr::mutate(obs_t = NA, pwindow_upr = NA, swindow_upr = NA) |>
   add_epred_draws(fit_sex_district, dpar = TRUE)
 
-# Some strata that don't have much data?
-# Some very bad priors?
+epred_draws_sex_district |>
+  dplyr::mutate(
+    sex = dplyr::case_when(
+      sex == "F" ~ "Female",
+      sex == "M" ~ "Male"
+    )
+  ) |>
+  ggplot(aes(x = .epred, y = district)) +
+    tidybayes::stat_slab() +
+    facet_grid(. ~ sex) +
+    labs(x = "Posterior expectation of the delay", y = "") +
+    theme_minimal()
+
+# Some strata that don't have much data? Some very bad priors?
 summary(epred_draws_sex_district$.epred)
+
+obs_prep$district |>
+  table()
+
+epred_draws_sex_district |>
+  dplyr::filter(district %in% c("Port Loko", "Western Urban")) |>
+  dplyr::mutate(
+    sex = dplyr::case_when(
+      sex == "F" ~ "Female",
+      sex == "M" ~ "Male"
+    )
+  ) |>
+  ggplot(aes(x = .epred, y = district)) +
+    tidybayes::stat_slab() +
+    facet_grid(. ~ sex) +
+    labs(x = "Posterior expectation of the delay", y = "") +
+    theme_minimal()
+
+epred_draws_sex_district |>
+  dplyr::group_by(district) |>
+  dplyr::summarise(q90 = quantile(.epred, 0.9)) |>
+  ggplot(aes(x = district, y = q90)) +
+    geom_point()
+
+obs_prep$district |>
+  table()
 ```
 
 ## Posterior predictions