diff --git a/R/marginal_model.R b/R/marginal_model.R index 45990f9b3..a75278be8 100644 --- a/R/marginal_model.R +++ b/R/marginal_model.R @@ -144,7 +144,7 @@ epidist_formula_model.epidist_marginal_model <- function( # data is only used to dispatch on formula <- stats::update( formula, delay_lwr | weights(n) + - vreal(delay_upr, relative_obs_time, pwindow, swindow) ~ . + vreal(relative_obs_time, pwindow, swindow, delay_upr) ~ . ) return(formula) } diff --git a/inst/stan/marginal_model/functions.stan b/inst/stan/marginal_model/functions.stan index 1985413c5..3c1f05cf1 100644 --- a/inst/stan/marginal_model/functions.stan +++ b/inst/stan/marginal_model/functions.stan @@ -11,18 +11,17 @@ * * @param y Real value of observed delay * @param dpars_A Distribution parameters (replaced via regex) - * @param y_upper Upper bound of delay interval * @param relative_obs_t Observation time relative to primary window start * @param pwindow_width Primary window width (actual time scale) * @param swindow_width Secondary window width (actual time scale) + * @param y_upper Upper bound of delay interval * @param primary_params Array of parameters for primary distribution * * @return Log probability mass with censoring adjustment for marginal model */ - real marginal_family_lpmf(data int y, dpars_A, data real y_upper, - data real relative_obs_t, data real pwindow_width, - data real swindow_width, - array[] real primary_params) { + real marginal_family_lpmf(data int y, dpars_A, data real relative_obs_t, + data real pwindow_width, data real swindow_width, + data real y_upper, array[] real primary_params) { return primarycensored_lpmf( y | dist_id, {dpars_B}, pwindow_width, y_upper, relative_obs_t, diff --git a/vignettes/ebola.Rmd b/vignettes/ebola.Rmd index 5ac15f6bc..c0cded2f6 100644 --- a/vignettes/ebola.Rmd +++ b/vignettes/ebola.Rmd @@ -406,20 +406,18 @@ In this section, we demonstrate how to produce either a discrete probability mas ### Discrete probability mass function To generate a discrete probability mass function (PMF) we predict the delay distribution that would be observed with daily censoring and no right truncation. -To do this, we set each of `pwindow` and `swindow` to 1 for daily censoring, and `relative_obs_time` to 1000 for no censoring. +To do this, we set each of `pwindow` and `swindow` to 1 for daily censoring, and `relative_obs_time` to `Inf` for no censoring. Figure \@ref(fig:pmf) shows the result, where the few delays greater than 30 are omitted from the figure. ```{r} add_marginal_pmf_vars <- function(data) { data |> mutate( - relative_obs_time = 1000, pwindow = 1, swindow = 1, - delay_upr = .data$delay_lwr + .data$swindow + relative_obs_time = Inf, pwindow = 1, swindow = 1, delay_upr = NA ) } draws_pmf <- obs_prep |> - as.data.frame() |> add_marginal_pmf_vars() |> add_predicted_draws(fit, ndraws = 1000) @@ -430,7 +428,6 @@ pmf_base_figure <- ggplot(draws_pmf, aes(x = .prediction)) + theme_minimal() draws_sex_pmf <- obs_prep |> - as.data.frame() |> data_grid(sex) |> add_marginal_pmf_vars() |> add_predicted_draws(fit_sex, ndraws = 1000) @@ -444,7 +441,6 @@ pmf_sex_figure <- draws_sex_pmf |> theme_minimal() draws_sex_district_pmf <- obs_prep |> - as.data.frame() |> data_grid(sex, district) |> add_marginal_pmf_vars() |> add_predicted_draws(fit_sex_district, ndraws = 1000) @@ -485,13 +481,11 @@ That is to produce continuous delay times (Figure \@ref(fig:pdf)): add_marginal_pdf_vars <- function(data) { data |> mutate( - relative_obs_time = 1000, pwindow = 0, swindow = 0, - delay_upr = .data$delay_lwr + .data$swindow + relative_obs_time = Inf, pwindow = 0, swindow = 0, delay_upr = NA ) } draws_pdf <- obs_prep |> - as.data.frame() |> add_marginal_pdf_vars() |> add_predicted_draws(fit, ndraws = 1000) @@ -502,7 +496,6 @@ pdf_base_figure <- ggplot(draws_pdf, aes(x = .prediction)) + theme_minimal() draws_sex_pdf <- obs_prep |> - as.data.frame() |> data_grid(sex) |> add_marginal_pdf_vars() |> add_predicted_draws(fit_sex, ndraws = 1000) @@ -516,7 +509,6 @@ pdf_sex_figure <- draws_sex_pdf |> theme_minimal() draws_sex_district_pdf <- obs_prep |> - as.data.frame() |> data_grid(sex, district) |> add_marginal_pdf_vars() |> add_predicted_draws(fit_sex_district, ndraws = 1000)