Issue #304: Update approximate inference vignette and remove `draws_t…

…o_long` (#328)

* Use tidybayes geom, get rid of draws_to_long, and add figure captions

* Remove draws_to_long and replace in FAQ also

* Remove draws_to_long

* Split problem chunk to see if I can isolate the issue

* Try comment out this section

* Try reverting hotfix

* Readd hotfix

NAMESPACE

@@ -18,7 +18,6 @@ S3method(epidist_validate,default)
 S3method(epidist_validate,epidist_latent_individual)
 export(add_mean_sd)
 export(as_latent_individual)
-export(draws_to_long)
 export(epidist)
 export(epidist_diagnostics)
 export(epidist_family)

R/globals.R

@@ -1,11 +1,14 @@
 # Generated by roxyglobals: do not edit by hand
 
 utils::globalVariables(c(
+  ":=", # <epidist_diagnostics>
   "no_at_max_treedepth", # <epidist_diagnostics>
   "max_treedepth", # <epidist_diagnostics>
   "per_at_max_treedepth", # <epidist_diagnostics>
   "samples", # <epidist_diagnostics>
+  ":=", # <as_latent_individual.data.frame>
   "id", # <as_latent_individual.data.frame>
+  ".N", # <as_latent_individual.data.frame>
   "obs_t", # <as_latent_individual.data.frame>
   "obs_at", # <as_latent_individual.data.frame>
   "ptime_lwr", # <as_latent_individual.data.frame>
@@ -19,6 +22,7 @@ utils::globalVariables(c(
   "row_id", # <as_latent_individual.data.frame>
   "woverlap", # <epidist_stancode.epidist_latent_individual>
   "row_id", # <epidist_stancode.epidist_latent_individual>
+  ":=", # <observe_process>
   "ptime_daily", # <observe_process>
   "ptime", # <observe_process>
   "ptime_lwr", # <observe_process>
@@ -31,25 +35,32 @@ utils::globalVariables(c(
   "delay_lwr", # <observe_process>
   "delay_upr", # <observe_process>
   "obs_at", # <observe_process>
+  ":=", # <filter_obs_by_obs_time>
   "obs_at", # <filter_obs_by_obs_time>
   "ptime", # <filter_obs_by_obs_time>
   "censored_obs_time", # <filter_obs_by_obs_time>
   "ptime_lwr", # <filter_obs_by_obs_time>
   "censored", # <filter_obs_by_obs_time>
   "stime_upr", # <filter_obs_by_obs_time>
+  ":=", # <filter_obs_by_ptime>
   "censored", # <filter_obs_by_ptime>
   "ptime_upr", # <filter_obs_by_ptime>
   "stime_upr", # <filter_obs_by_ptime>
   "ptime", # <filter_obs_by_ptime>
   "censored_obs_time", # <filter_obs_by_ptime>
   "ptime_lwr", # <filter_obs_by_ptime>
+  ":=", # <add_mean_sd.lognormal_samples>
   "mu", # <add_mean_sd.lognormal_samples>
   "sigma", # <add_mean_sd.lognormal_samples>
   "sd", # <add_mean_sd.lognormal_samples>
+  ":=", # <add_mean_sd.gamma_samples>
   "mu", # <add_mean_sd.gamma_samples>
   "sd", # <add_mean_sd.gamma_samples>
   "shape", # <add_mean_sd.gamma_samples>
+  "rlnorm", # <simulate_secondary>
+  ":=", # <simulate_secondary>
   "delay", # <simulate_secondary>
+  ".N", # <simulate_secondary>
   "stime", # <simulate_secondary>
   "ptime", # <simulate_secondary>
   "prior_old", # <.replace_prior>

R/postprocess.R

@@ -34,20 +34,6 @@ predict_delay_parameters <- function(fit, newdata = NULL, ...) {
 #' @export
 predict_dpar <- predict_delay_parameters
 
-#' Convert posterior lognormal samples to long format
-#'
-#' @param draws ...
-#' @family postprocess
-#' @export
-draws_to_long <- function(draws) {
-  long_draws <- data.table::melt(
-    draws,
-    measure.vars = c("mu", "sigma", "mean", "sd"),
-    variable.name = "parameter"
-  )
-  return(long_draws[])
-}
-
 #' Add natural scale mean and standard deviation parameters
 #'
 #' @param data A dataframe of distributional parameters

vignettes/approx-inference.Rmd

@@ -98,6 +98,7 @@ library(gt)
 library(purrr)
 library(tidyr)
 library(tibble)
+library(tidybayes)
 ```
 
 First, we begin by simulating data.
@@ -171,7 +172,12 @@ fits <- list(
 
 draws <- imap(fits, function(fit, name) {
   predict_delay_parameters(fit) |>
-    draws_to_long() |>
+    as.data.frame() |>
+    pivot_longer(
+      cols = c("mu", "sigma", "mean", "sd"),
+      names_to = "parameter",
+      values_to = "value"
+    ) |>
     filter(parameter %in% c("mu", "sigma")) |>
     mutate(method = as.factor(name))
 })
@@ -194,37 +200,29 @@ pars |>
   gt()
 ```
 
-More comprehensively, the estimated posterior distributions are as follows.
+More comprehensively, the estimated posterior distributions are shown in Figure \@ref(fig:posterior).
 
-```{r}
-draws |>
-  filter(parameter == "mu") |>
-  ggplot(aes(x = value, fill = method)) +
-  geom_histogram(aes(y = ..density..)) +
-  scale_fill_manual(values = c("#56B4E9", "#009E73", "#E69F00", "#CC79A7")) +
-  facet_grid(method ~ parameter) +
-  theme_minimal() +
-  guides(fill = "none") +
-  labs(x = "", y = "")
-```
+(ref:posterior) Estimated posterior distributions for the `mu` and `sigma` parameters using each inference method, shown using `tidybayes::stat_slabinterval()`.
 
-```{r}
+```{r posterior, fig.cap="(ref:posterior)"}
 draws |>
-  filter(parameter == "sigma") |>
-  ggplot(aes(x = value, fill = method)) +
-  geom_histogram(aes(y = ..density..)) +
-  scale_fill_manual(values = c("#56B4E9", "#009E73", "#E69F00", "#CC79A7")) +
-  facet_grid(method ~ parameter) +
+  ggplot(aes(x = value, col = method)) +
+  stat_slabinterval(density = "histogram", breaks = 30, alpha = 0.8) +
+  scale_colour_manual(values = c("#56B4E9", "#009E73", "#E69F00", "#CC79A7")) +
+  facet_grid(method ~ parameter, scales = "free_x") +
   theme_minimal() +
   guides(fill = "none") +
-  labs(x = "", y = "")
+  labs(x = "", y = "", col = "Method") +
+  theme(legend.position = "bottom")
 ```
 
 ## Comparison of resulting delay distributions
 
-How do these different distributions on the `mu` and `sigma` parameters effect the estimated delay distribution?
+Figure \@ref(fig:delay-pdf) shows how the different `mu` and `sigma` posterior mean estimates from each inference method alter an estimated delay distribution.
 
-```{r}
+(ref:delay-pdf) Delay probability density functions obtained based on the posterior mean estimated `mu` and `sigma` parameters.
+
+```{r delay-pdf, fig.cap="(ref:delay-pdf)"}
 pmap_df(
   filter(pars), ~ tibble(
     x = seq(0, 25, by = 0.1),

vignettes/faq.Rmd

@@ -28,6 +28,7 @@ library(brms)
 library(dplyr)
 library(ggplot2)
 library(scales)
+library(tidyr)
 
 set.seed(1)
 
@@ -135,7 +136,12 @@ fit_ppc <- epidist(
 pred <- predict_delay_parameters(fit_ppc)
 
 pred |>
-  draws_to_long() |>
+  as.data.frame() |>
+  pivot_longer(
+    cols = c("mu", "sigma", "mean", "sd"),
+    names_to = "parameter",
+    values_to = "value"
+  ) |>
   filter(parameter %in% c("mean", "sd")) |>
   ggplot(aes(x = value, y = after_stat(density))) +
   geom_histogram() +