debug implementation

epinowcast · seabbs · Sep 1, 2022 · Aug 4, 2022 · Aug 4, 2022 · Aug 4, 2022
commit a87f63d14b4882900a3b92513a0de15a92e8141e
diff --git a/R/model-modules.R b/R/model-modules.R
@@ -244,6 +244,8 @@ enw_report <- function(non_parametric = ~0, structural = ~0, data) {
 #' multiplying a probability mass function by some fraction) to account
 #' ascertainment etc.
 #'
+#' @param ... Additional parameters passed to [enw_add_metaobs_features()]. The
+#' same arguments as passed to `enw_preprocess_data()` should be used here.
 #' @inherit enw_report return
 #' @inheritParams enw_obs
 #' @family modelmodules
@@ -312,7 +314,7 @@ enw_expectation <- function(r = ~ rw(day, by = .group), generation_time = 1,
     0, 1
   )
   # Observation formula
-  obs_form <- enw_formula(osbervation, data$metareference[[1]], sparse = FALSE)
+  obs_form <- enw_formula(observation, data$metareference[[1]], sparse = FALSE)
   obs_data <- enw_formula_as_data_list(
     obs_form,
     prefix = "expo", drop_intercept = TRUE
@@ -324,7 +326,7 @@ enw_expectation <- function(r = ~ rw(day, by = .group), generation_time = 1,
 
   names(r_list) <- paste0("expr_", names(r_list))
   names(obs_list) <- paste0("expo_", names(obs_list))
-  out$data <- c(r_list, r_data, obs_data)
+  out$data <- c(r_list, r_data, obs_list, obs_data)
 
   out$priors <- data.table::data.table(
     variable = c(
@@ -364,7 +366,7 @@ enw_expectation <- function(r = ~ rw(day, by = .group), generation_time = 1,
           1, priors$expr_r_int[1], priors$expr_r_int[2] * 0.1
         ),
         expo_beta = numeric(0),
-        expo_beta_sd = numeric(0),
+        expo_beta_sd = numeric(0)
       )
       if (data$expr_fncol > 0) {
         init$expr_beta <- rnorm(data$expr_fncol, 0, 0.01)

diff --git a/R/preprocess.R b/R/preprocess.R
@@ -64,7 +64,7 @@ enw_add_metaobs_features <- function(metaobs, holidays = c(),
 #' @description FUNCTION_DESCRIPTION
 #' @param metaobs PARAM_DESCRIPTION
 #' @param days
-#' @param position Should new dates be added at the begining or end of
+#' @param direction Should new dates be added at the begining or end of
 #' the data. Default is "end" with "start" also available
 #' @return OUTPUT_DESCRIPTION
 #' @family preprocess

diff --git a/inst/examples/germany_simple.R b/inst/examples/germany_simple.R
@@ -41,7 +41,13 @@ pobs <- enw_preprocess_data(retro_nat_germany, max_delay = 20)
 # Fit the default nowcast model and produce a nowcast
 # Note that we have reduced samples for this example to reduce runtimes
 nowcast <- epinowcast(pobs,
-  expectation = enw_expectation(~1, data = pobs),
+  expectation = enw_expectation(
+    ~ rw(week),
+    generation_time = c(0.2, 0.6, 0.2),
+    observation = ~ (1 | day_of_week),
+    latent_reporting_delay = c(0.3, 0.2, 0.1),
+    data = pobs
+  ),
   fit = enw_fit_opts(
     save_warmup = FALSE, pp = TRUE,
     chains = 2, iter_warmup = 500, iter_sampling = 500

diff --git a/inst/stan/functions/log_expected_obs_from_latent_obs.stan b/inst/stan/functions/log_expected_obs_from_latent_obs.stan
@@ -5,12 +5,12 @@
     array[g] vector[t] exp_lobs;
     for (k in 1:g) {
       if (rd_n == 1) {
-        exp_lobs[k] = exp_latent_lobs[k] + lrrd;
+        exp_lobs[k] = exp_latent_lobs[k] + rep_vector(lrrd[1], t);
       }else{
         for (i in 1:t){
           exp_lobs[k][i] = 
             log_sum_exp(
-              segment(exp_latent_lobs[k], rd_n + i, rd_n) + lrrd
+              segment(exp_latent_lobs[k], i, rd_n) + lrrd
             );
         }
       }

diff --git a/man/enw_expectation.Rd b/man/enw_expectation.Rd
diff --git a/man/enw_extend_date.Rd b/man/enw_extend_date.Rd
diff --git a/man/epinowcast.Rd b/man/epinowcast.Rd