Enough playing to be able to call add_natural_scale_mean_sd on an out…

…put of fitting a latent_lognormal model
epinowcast · Jul 22, 2024 · bf6d60d · bf6d60d
1 parent ef592e2
commit bf6d60d
Show file tree

Hide file tree

Showing 14 changed files with 135 additions and 33 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -1,5 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(add_natural_scale_mean_sd,default)
+S3method(add_natural_scale_mean_sd,latent_gamma)
+S3method(add_natural_scale_mean_sd,latent_lognormal)
 S3method(as_latent_individual,data.frame)
 S3method(epidist,default)
 S3method(epidist_family,default)
@@ -63,6 +66,8 @@ importFrom(checkmate,assert_data_frame)
 importFrom(checkmate,assert_int)
 importFrom(checkmate,assert_names)
 importFrom(checkmate,assert_numeric)
+importFrom(cli,cli_abort)
+importFrom(cli,cli_inform)
 importFrom(posterior,as_draws_df)
 importFrom(rstan,lookup)
 importFrom(stats,as.formula)

diff --git a/R/globals.R b/R/globals.R
@@ -1,30 +1,20 @@
 # Generated by roxyglobals: do not edit by hand
 
 utils::globalVariables(c(
-  ":=", # <sample_model>
   "error", # <sample_model>
   "no_at_max_treedepth", # <sample_model>
   "max_treedepth", # <sample_model>
   "per_at_max_treedepth", # <sample_model>
   "run_time", # <sample_model>
-  ":=", # <add_natural_scale_mean_sd>
-  "meanlog", # <add_natural_scale_mean_sd>
-  "sdlog", # <add_natural_scale_mean_sd>
-  "sd", # <add_natural_scale_mean_sd>
-  ":=", # <extract_lognormal_draws>
   "sdlog", # <extract_lognormal_draws>
   "sdlog_log", # <extract_lognormal_draws>
   "meanlog", # <extract_lognormal_draws>
   "id", # <extract_lognormal_draws>
-  ":=", # <make_relative_to_truth>
   "true_value", # <make_relative_to_truth>
   "value", # <make_relative_to_truth>
   "rel_value", # <make_relative_to_truth>
-  ":=", # <summarise_variable>
   "value", # <summarise_variable>
-  ":=", # <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>
@@ -38,7 +28,6 @@ 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>
@@ -51,25 +40,21 @@ 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>
   "censored_obs_time", # <pad_zero>
-  ":=", # <pad_zero>
   "delay_lwr", # <pad_zero>
   "delay_daily", # <pad_zero>
-  ":=", # <plot_relative_recovery>
   "value", # <plot_relative_recovery>
   "rel_value", # <plot_relative_recovery>
   "case_type", # <plot_cases_by_obs_window>
@@ -85,23 +70,22 @@ utils::globalVariables(c(
   "ptime_daily", # <plot_mean_posterior_pred>
   "n", # <plot_mean_posterior_pred>
   "obs_horizon", # <plot_mean_posterior_pred>
-  ".data", # <plot_mean_posterior_pred>
-  ":=", # <linelist_to_counts>
+  "mu", # <add_natural_scale_mean_sd.latent_lognormal>
+  "sigma", # <add_natural_scale_mean_sd.latent_lognormal>
+  "sd", # <add_natural_scale_mean_sd.latent_lognormal>
+  "sigma", # <add_natural_scale_mean_sd.latent_gamma>
+  "sd", # <add_natural_scale_mean_sd.latent_gamma>
+  "mu", # <add_natural_scale_mean_sd.latent_gamma>
+  "shape", # <add_natural_scale_mean_sd.latent_gamma>
   "time", # <linelist_to_counts>
-  ".N", # <linelist_to_counts>
-  ":=", # <linelist_to_cases>
   "primary", # <linelist_to_cases>
   "secondary", # <linelist_to_cases>
-  ":=", # <reverse_obs_at>
   "obs_at", # <reverse_obs_at>
   "stime", # <construct_cases_by_obs_window>
   "ptime", # <construct_cases_by_obs_window>
-  ":=", # <construct_cases_by_obs_window>
   "case_type", # <construct_cases_by_obs_window>
-  ":=", # <combine_obs>
   "obs_at", # <combine_obs>
   "stime_daily", # <combine_obs>
-  ":=", # <calculate_censor_delay>
   "ptime_delay", # <calculate_censor_delay>
   "ptime", # <calculate_censor_delay>
   "ptime_daily", # <calculate_censor_delay>
@@ -111,12 +95,9 @@ utils::globalVariables(c(
   "stime_delay", # <calculate_censor_delay>
   "stime", # <calculate_censor_delay>
   "stime_daily", # <calculate_censor_delay>
-  ".N", # <event_to_incidence>
   "ptime_daily", # <event_to_incidence>
   "rlnorm", # <simulate_secondary>
-  ":=", # <simulate_secondary>
   "delay", # <simulate_secondary>
-  ".N", # <simulate_secondary>
   "stime", # <simulate_secondary>
   "ptime", # <simulate_secondary>
   NULL

diff --git a/R/postprocess.R b/R/postprocess.R
@@ -13,6 +13,7 @@ add_natural_scale_mean_sd <- function(data, ...) {
 #' @inheritParams add_natural_scale_mean_sd
 #' @param ... Additional arguments for method.
 #' @family postprocess
+#' @method add_natural_scale_mean_sd default
 #' @export
 add_natural_scale_mean_sd.default <- function(data, ...) {
   cli::cli_inform(
@@ -31,6 +32,7 @@ add_natural_scale_mean_sd.default <- function(data, ...) {
 #' @inheritParams add_natural_scale_mean_sd
 #' @param ... Additional arguments for method.
 #' @family postprocess
+#' @method add_natural_scale_mean_sd latent_lognormal
 #' @autoglobal
 #' @export
 add_natural_scale_mean_sd.latent_lognormal <- function(data, ...) {
@@ -47,6 +49,7 @@ add_natural_scale_mean_sd.latent_lognormal <- function(data, ...) {
 #' @inheritParams add_natural_scale_mean_sd
 #' @param ... Additional arguments for method.
 #' @family postprocess
+#' @method add_natural_scale_mean_sd latent_gamma
 #' @autoglobal
 #' @export
 add_natural_scale_mean_sd.latent_gamma <- function(data, ...) {

diff --git a/man/add_natural_scale_mean_sd.Rd b/man/add_natural_scale_mean_sd.Rd
diff --git a/man/add_natural_scale_mean_sd.default.Rd b/man/add_natural_scale_mean_sd.default.Rd
diff --git a/man/add_natural_scale_mean_sd.latent_gamma.Rd b/man/add_natural_scale_mean_sd.latent_gamma.Rd
diff --git a/man/add_natural_scale_mean_sd.latent_lognormal.Rd b/man/add_natural_scale_mean_sd.latent_lognormal.Rd
diff --git a/man/draws_to_long.Rd b/man/draws_to_long.Rd
diff --git a/man/extract_lognormal_draws.Rd b/man/extract_lognormal_draws.Rd
diff --git a/man/make_relative_to_truth.Rd b/man/make_relative_to_truth.Rd
diff --git a/man/sample_model.Rd b/man/sample_model.Rd
diff --git a/man/summarise_draws.Rd b/man/summarise_draws.Rd
diff --git a/man/summarise_variable.Rd b/man/summarise_variable.Rd
diff --git a/tests/testthat/test-unit-postprocess.R b/tests/testthat/test-unit-postprocess.R
@@ -16,10 +16,12 @@ brms::posterior_predict(fit)
 linpred_mu <- brms::posterior_linpred(fit, transform = TRUE, dpar = "mu")
 linpred_sigma <- brms::posterior_linpred(fit, transform = TRUE, dpar = "sigma")
 
-linpred_mu_melt <- reshape2::melt(linpred_mu, varnames = c("aaa", "bbb"), value.name = "mu")
-linpred_sigma_melt <- reshape2::melt(linpred_sigma, varnames = c("aaa", "bbb"), value.name = "sigma")
+linpred_mu_melt <- reshape2::melt(linpred_mu, varnames = c("draw", "index"), value.name = "mu")
+linpred_sigma_melt <- reshape2::melt(linpred_sigma, varnames = c("draw", "index"), value.name = "sigma")
 
 linpred_melt <- dplyr::left_join(linpred_mu_melt, linpred_sigma_melt)
+class(linpred_melt) <- c(class(linpred_melt), "latent_lognormal")
+add_natural_scale_mean_sd(data.table::as.data.table(linpred_melt))
 
 pp <- brms::prepare_predictions(fit)
 pp$dpars$mu$fe$b