From 880f181267937b54da9b08035ae957cac8e9cb5c Mon Sep 17 00:00:00 2001 From: athowes Date: Thu, 14 Nov 2024 09:57:24 +0000 Subject: [PATCH 01/13] Rename direct model to naive model in R file --- R/direct_model.R | 48 ------------------------------------------------ R/naive_model.R | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 48 insertions(+), 48 deletions(-) delete mode 100644 R/direct_model.R create mode 100644 R/naive_model.R diff --git a/R/direct_model.R b/R/direct_model.R deleted file mode 100644 index 603c0ada8..000000000 --- a/R/direct_model.R +++ /dev/null @@ -1,48 +0,0 @@ -#' Prepare direct model to pass through to `brms` -#' -#' @param data A `data.frame` containing line list data -#' @family direct_model -#' @export -as_direct_model <- function(data) { - UseMethod("as_direct_model") -} - -assert_direct_model_input <- function(data) { - assert_data_frame(data) - assert_names(names(data), must.include = c("case", "ptime", "stime")) - assert_integer(data$case, lower = 0) - assert_numeric(data$ptime, lower = 0) - assert_numeric(data$stime, lower = 0) -} - -#' @method as_direct_model data.frame -#' @family direct_model -#' @autoglobal -#' @export -as_direct_model.data.frame <- function(data) { - assert_direct_model_input(data) - class(data) <- c("epidist_direct_model", class(data)) - data <- data |> - mutate(delay = .data$stime - .data$ptime) - epidist_validate_model(data) - return(data) -} - -#' @method epidist_validate_model epidist_direct_model -#' @family direct_model -#' @export -epidist_validate_model.epidist_direct_model <- function(data, ...) { - assert_true(is_direct_model(data)) - assert_direct_model_input(data) - assert_names(names(data), must.include = c("case", "ptime", "stime", "delay")) - assert_numeric(data$delay, lower = 0) -} - -#' Check if data has the `epidist_direct_model` class -#' -#' @param data A `data.frame` containing line list data -#' @family latent_individual -#' @export -is_direct_model <- function(data) { - inherits(data, "epidist_direct_model") -} diff --git a/R/naive_model.R b/R/naive_model.R new file mode 100644 index 000000000..47d03168d --- /dev/null +++ b/R/naive_model.R @@ -0,0 +1,48 @@ +#' Prepare naive model to pass through to `brms` +#' +#' @param data A `data.frame` containing line list data +#' @family naive_model +#' @export +as_naive_model <- function(data) { + UseMethod("as_naive_model") +} + +assert_naive_model_input <- function(data) { + assert_data_frame(data) + assert_names(names(data), must.include = c("case", "ptime", "stime")) + assert_integer(data$case, lower = 0) + assert_numeric(data$ptime, lower = 0) + assert_numeric(data$stime, lower = 0) +} + +#' @method as_naive_model data.frame +#' @family naive_model +#' @autoglobal +#' @export +as_naive_model.data.frame <- function(data) { + assert_naive_model_input(data) + class(data) <- c("epidist_naive_model", class(data)) + data <- data |> + mutate(delay = .data$stime - .data$ptime) + epidist_validate_model(data) + return(data) +} + +#' @method epidist_validate_model epidist_naive_model +#' @family naive_model +#' @export +epidist_validate_model.epidist_naive_model <- function(data, ...) { + assert_true(is_naive_model(data)) + assert_naive_model_input(data) + assert_names(names(data), must.include = c("case", "ptime", "stime", "delay")) + assert_numeric(data$delay, lower = 0) +} + +#' Check if data has the `epidist_naive_model` class +#' +#' @param data A `data.frame` containing line list data +#' @family latent_individual +#' @export +is_naive_model <- function(data) { + inherits(data, "epidist_naive_model") +} From cf2bd888f4fcf25f359f0ac11401c03b3b4687af Mon Sep 17 00:00:00 2001 From: athowes Date: Thu, 14 Nov 2024 16:21:43 +0000 Subject: [PATCH 02/13] All other direct to naive replacements --- NAMESPACE | 12 ++++-- R/globals.R | 14 +++++++ _pkgdown.yml | 4 +- man/as_direct_model.Rd | 15 -------- man/as_latent_individual.Rd | 4 +- man/as_naive_model.Rd | 15 ++++++++ ..._family_model.epidist_latent_individual.Rd | 4 +- ...formula_model.epidist_latent_individual.Rd | 4 +- man/is_latent_individual.Rd | 2 +- man/{is_direct_model.Rd => is_naive_model.Rd} | 12 +++--- tests/testthat/test-direct_model.R | 38 +++++++++---------- ...-direct_model.R => test-int-naive_model.R} | 4 +- 12 files changed, 74 insertions(+), 54 deletions(-) delete mode 100644 man/as_direct_model.Rd create mode 100644 man/as_naive_model.Rd rename man/{is_direct_model.Rd => is_naive_model.Rd} (63%) rename tests/testthat/{test-int-direct_model.R => test-int-naive_model.R} (78%) diff --git a/NAMESPACE b/NAMESPACE index 0bc85d4be..83164b97c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,8 +3,8 @@ S3method(add_mean_sd,default) S3method(add_mean_sd,gamma_samples) S3method(add_mean_sd,lognormal_samples) -S3method(as_direct_model,data.frame) S3method(as_latent_individual,epidist_linelist) +S3method(as_naive_model,data.frame) S3method(epidist,default) S3method(epidist_family_model,default) S3method(epidist_family_model,epidist_latent_individual) @@ -20,12 +20,12 @@ S3method(epidist_stancode,epidist_latent_individual) S3method(epidist_validate_data,default) S3method(epidist_validate_data,epidist_linelist) S3method(epidist_validate_model,default) -S3method(epidist_validate_model,epidist_direct_model) S3method(epidist_validate_model,epidist_latent_individual) +S3method(epidist_validate_model,epidist_naive_model) export(add_mean_sd) -export(as_direct_model) export(as_epidist_linelist) export(as_latent_individual) +export(as_naive_model) export(epidist) export(epidist_diagnostics) export(epidist_family) @@ -39,9 +39,15 @@ export(epidist_prior) export(epidist_stancode) export(epidist_validate_data) export(epidist_validate_model) +<<<<<<< HEAD export(is_direct_model) +======= +export(filter_obs_by_obs_time) +export(filter_obs_by_ptime) +>>>>>>> 989328c5 (All other direct to naive replacements) export(is_epidist_linelist) export(is_latent_individual) +export(is_naive_model) export(observe_process) export(predict_delay_parameters) export(predict_dpar) diff --git a/R/globals.R b/R/globals.R index 64d98ea51..26be9028b 100644 --- a/R/globals.R +++ b/R/globals.R @@ -1,9 +1,23 @@ # Generated by roxyglobals: do not edit by hand utils::globalVariables(c( + ".data", # "samples", # + ".data", # "woverlap", # +<<<<<<< HEAD +======= + ".data", # + ".data", # + ".data", # + ".data", # + ":=", # + ".data", # + ".data", # +>>>>>>> 989328c5 (All other direct to naive replacements) "rlnorm", # + ".data", # + ".data", # <.replace_prior> "prior_new", # <.replace_prior> "source_new", # <.replace_prior> NULL diff --git a/_pkgdown.yml b/_pkgdown.yml index 06b1422ac..9320b7ff4 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -70,9 +70,9 @@ reference: contents: - has_concept("latent_individual") - title: Direct model - desc: Specific methods for the direct model + desc: Specific methods for the naive model contents: - - has_concept("direct_model") + - has_concept("naive_model") - title: Postprocess desc: Functions for postprocessing model output contents: diff --git a/man/as_direct_model.Rd b/man/as_direct_model.Rd deleted file mode 100644 index cbce0425c..000000000 --- a/man/as_direct_model.Rd +++ /dev/null @@ -1,15 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/direct_model.R -\name{as_direct_model} -\alias{as_direct_model} -\title{Prepare direct model to pass through to \code{brms}} -\usage{ -as_direct_model(data) -} -\arguments{ -\item{data}{A \code{data.frame} containing line list data} -} -\description{ -Prepare direct model to pass through to \code{brms} -} -\concept{direct_model} diff --git a/man/as_latent_individual.Rd b/man/as_latent_individual.Rd index d69065ccd..9dc24f333 100644 --- a/man/as_latent_individual.Rd +++ b/man/as_latent_individual.Rd @@ -16,7 +16,7 @@ Prepare latent individual model Other latent_individual: \code{\link{epidist_family_model.epidist_latent_individual}()}, \code{\link{epidist_formula_model.epidist_latent_individual}()}, -\code{\link{is_direct_model}()}, -\code{\link{is_latent_individual}()} +\code{\link{is_latent_individual}()}, +\code{\link{is_naive_model}()} } \concept{latent_individual} diff --git a/man/as_naive_model.Rd b/man/as_naive_model.Rd new file mode 100644 index 000000000..118f83ec0 --- /dev/null +++ b/man/as_naive_model.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/naive_model.R +\name{as_naive_model} +\alias{as_naive_model} +\title{Prepare naive model to pass through to \code{brms}} +\usage{ +as_naive_model(data) +} +\arguments{ +\item{data}{A \code{data.frame} containing line list data} +} +\description{ +Prepare naive model to pass through to \code{brms} +} +\concept{naive_model} diff --git a/man/epidist_family_model.epidist_latent_individual.Rd b/man/epidist_family_model.epidist_latent_individual.Rd index b73050a74..3ccac8f30 100644 --- a/man/epidist_family_model.epidist_latent_individual.Rd +++ b/man/epidist_family_model.epidist_latent_individual.Rd @@ -21,7 +21,7 @@ Create the model-specific component of an \code{epidist} custom family Other latent_individual: \code{\link{as_latent_individual}()}, \code{\link{epidist_formula_model.epidist_latent_individual}()}, -\code{\link{is_direct_model}()}, -\code{\link{is_latent_individual}()} +\code{\link{is_latent_individual}()}, +\code{\link{is_naive_model}()} } \concept{latent_individual} diff --git a/man/epidist_formula_model.epidist_latent_individual.Rd b/man/epidist_formula_model.epidist_latent_individual.Rd index 4830098ee..db5509337 100644 --- a/man/epidist_formula_model.epidist_latent_individual.Rd +++ b/man/epidist_formula_model.epidist_latent_individual.Rd @@ -20,7 +20,7 @@ Define the model-specific component of an \code{epidist} custom formula Other latent_individual: \code{\link{as_latent_individual}()}, \code{\link{epidist_family_model.epidist_latent_individual}()}, -\code{\link{is_direct_model}()}, -\code{\link{is_latent_individual}()} +\code{\link{is_latent_individual}()}, +\code{\link{is_naive_model}()} } \concept{latent_individual} diff --git a/man/is_latent_individual.Rd b/man/is_latent_individual.Rd index 94fb1428b..26a01d374 100644 --- a/man/is_latent_individual.Rd +++ b/man/is_latent_individual.Rd @@ -17,6 +17,6 @@ Other latent_individual: \code{\link{as_latent_individual}()}, \code{\link{epidist_family_model.epidist_latent_individual}()}, \code{\link{epidist_formula_model.epidist_latent_individual}()}, -\code{\link{is_direct_model}()} +\code{\link{is_naive_model}()} } \concept{latent_individual} diff --git a/man/is_direct_model.Rd b/man/is_naive_model.Rd similarity index 63% rename from man/is_direct_model.Rd rename to man/is_naive_model.Rd index fbeea635c..6178f0e5e 100644 --- a/man/is_direct_model.Rd +++ b/man/is_naive_model.Rd @@ -1,16 +1,16 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/direct_model.R -\name{is_direct_model} -\alias{is_direct_model} -\title{Check if data has the \code{epidist_direct_model} class} +% Please edit documentation in R/naive_model.R +\name{is_naive_model} +\alias{is_naive_model} +\title{Check if data has the \code{epidist_naive_model} class} \usage{ -is_direct_model(data) +is_naive_model(data) } \arguments{ \item{data}{A \code{data.frame} containing line list data} } \description{ -Check if data has the \code{epidist_direct_model} class +Check if data has the \code{epidist_naive_model} class } \seealso{ Other latent_individual: diff --git a/tests/testthat/test-direct_model.R b/tests/testthat/test-direct_model.R index 17c8c2efa..75a7a2602 100644 --- a/tests/testthat/test-direct_model.R +++ b/tests/testthat/test-direct_model.R @@ -1,50 +1,50 @@ -test_that("as_direct_model.data.frame with default settings an object with the correct classes", { # nolint: line_length_linter. - prep_obs <- as_direct_model(sim_obs) +test_that("as_naive_model.data.frame with default settings an object with the correct classes", { # nolint: line_length_linter. + prep_obs <- as_naive_model(sim_obs) expect_s3_class(prep_obs, "data.frame") - expect_s3_class(prep_obs, "epidist_direct_model") + expect_s3_class(prep_obs, "epidist_naive_model") }) -test_that("as_direct_model.data.frame errors when passed incorrect inputs", { # nolint: line_length_linter. - expect_error(as_direct_model(list())) - expect_error(as_direct_model(sim_obs[, 1])) +test_that("as_naive_model.data.frame errors when passed incorrect inputs", { # nolint: line_length_linter. + expect_error(as_naive_model(list())) + expect_error(as_naive_model(sim_obs[, 1])) expect_error({ sim_obs$case <- paste("case_", seq_len(nrow(sim_obs))) - as_direct_model(sim_obs) + as_naive_model(sim_obs) }) }) # Make this data available for other tests -prep_obs <- as_direct_model(sim_obs) +prep_obs <- as_naive_model(sim_obs) family_lognormal <- epidist_family(prep_obs, family = brms::lognormal()) -test_that("is_direct_model returns TRUE for correct input", { # nolint: line_length_linter. - expect_true(is_direct_model(prep_obs)) +test_that("is_naive_model returns TRUE for correct input", { # nolint: line_length_linter. + expect_true(is_naive_model(prep_obs)) expect_true({ x <- list() - class(x) <- "epidist_direct_model" - is_direct_model(x) + class(x) <- "epidist_naive_model" + is_naive_model(x) }) }) -test_that("is_direct_model returns FALSE for incorrect input", { # nolint: line_length_linter. - expect_false(is_direct_model(list())) +test_that("is_naive_model returns FALSE for incorrect input", { # nolint: line_length_linter. + expect_false(is_naive_model(list())) expect_false({ x <- list() - class(x) <- "epidist_direct_model_extension" - is_direct_model(x) + class(x) <- "epidist_naive_model_extension" + is_naive_model(x) }) }) -test_that("epidist_validate_model.epidist_direct_model doesn't produce an error for correct input", { # nolint: line_length_linter. +test_that("epidist_validate_model.epidist_naive_model doesn't produce an error for correct input", { # nolint: line_length_linter. expect_no_error(epidist_validate_model(prep_obs)) }) -test_that("epidist_validate_model.epidist_direct_model returns FALSE for incorrect input", { # nolint: line_length_linter. +test_that("epidist_validate_model.epidist_naive_model returns FALSE for incorrect input", { # nolint: line_length_linter. expect_error(epidist_validate_model(list())) expect_error(epidist_validate_model(prep_obs[, 1])) expect_error({ x <- list() - class(x) <- "epidist_direct_model" + class(x) <- "epidist_naive_model" epidist_validate_model(x) }) }) diff --git a/tests/testthat/test-int-direct_model.R b/tests/testthat/test-int-naive_model.R similarity index 78% rename from tests/testthat/test-int-direct_model.R rename to tests/testthat/test-int-naive_model.R index f1f49aefd..0fbae8264 100644 --- a/tests/testthat/test-int-direct_model.R +++ b/tests/testthat/test-int-naive_model.R @@ -4,7 +4,7 @@ # varying the input seed. Test failure at an unusually high rate does suggest # a potential code issue. -test_that("epidist.epidist_direct_model Stan code has no syntax errors in the default case", { # nolint: line_length_linter. +test_that("epidist.epidist_naive_model Stan code has no syntax errors in the default case", { # nolint: line_length_linter. skip_on_cran() stancode <- epidist( data = prep_direct_obs, @@ -16,7 +16,7 @@ test_that("epidist.epidist_direct_model Stan code has no syntax errors in the de expect_true(mod$check_syntax()) }) -test_that("epidist.epidist_direct_model fits and the MCMC converges in the default case", { # nolint: line_length_linter. +test_that("epidist.epidist_naive_model fits and the MCMC converges in the default case", { # nolint: line_length_linter. # Note: this test is stochastic. See note at the top of this script skip_on_cran() set.seed(1) From 389ecb743c2cbfaa52c52ae0497859e9c1cfd2bf Mon Sep 17 00:00:00 2001 From: athowes Date: Thu, 14 Nov 2024 10:03:31 +0000 Subject: [PATCH 03/13] Rename R file to latent --- R/{latent_individual.R => latent.R} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename R/{latent_individual.R => latent.R} (100%) diff --git a/R/latent_individual.R b/R/latent.R similarity index 100% rename from R/latent_individual.R rename to R/latent.R From 6cfd6cacf35871f7823d6c4891bae176a2e86f9b Mon Sep 17 00:00:00 2001 From: athowes Date: Thu, 14 Nov 2024 16:22:50 +0000 Subject: [PATCH 04/13] Latent model rather than latent individual --- .github/workflows/check-cmdstan.yaml | 2 +- NAMESPACE | 14 ++-- R/globals.R | 8 ++- R/{latent.R => latent_model.R} | 64 ++++++++++--------- R/naive_model.R | 2 +- _pkgdown.yml | 6 +- man/as_latent_individual.Rd | 22 ------- man/as_latent_model.Rd | 21 ++++++ man/as_naive_model.Rd | 4 ++ ...dist_family_model.epidist_latent_model.Rd} | 19 +++--- ...formula_model.epidist_latent_individual.Rd | 26 -------- ...dist_formula_model.epidist_latent_model.Rd | 25 ++++++++ man/is_latent_individual.Rd | 22 ------- man/is_latent_model.Rd | 21 ++++++ man/is_naive_model.Rd | 9 +-- tests/testthat/test-diagnostics.R | 2 +- tests/testthat/test-formula.R | 2 +- tests/testthat/test-int-latent_individual.R | 25 ++++---- tests/testthat/test-latent_individual.R | 38 +++++------ tests/testthat/test-prior.R | 2 +- tests/testthat/test-utils.R | 4 +- vignettes/approx-inference.Rmd | 6 +- vignettes/ebola.Rmd | 6 +- vignettes/epidist.Rmd | 10 +-- vignettes/faq.Rmd | 6 +- 25 files changed, 182 insertions(+), 184 deletions(-) rename R/{latent.R => latent_model.R} (75%) delete mode 100644 man/as_latent_individual.Rd create mode 100644 man/as_latent_model.Rd rename man/{epidist_family_model.epidist_latent_individual.Rd => epidist_family_model.epidist_latent_model.Rd} (51%) delete mode 100644 man/epidist_formula_model.epidist_latent_individual.Rd create mode 100644 man/epidist_formula_model.epidist_latent_model.Rd delete mode 100644 man/is_latent_individual.Rd create mode 100644 man/is_latent_model.Rd diff --git a/.github/workflows/check-cmdstan.yaml b/.github/workflows/check-cmdstan.yaml index c02adc54e..0bcc8384e 100644 --- a/.github/workflows/check-cmdstan.yaml +++ b/.github/workflows/check-cmdstan.yaml @@ -68,7 +68,7 @@ jobs: censored = "interval", censored_obs_time = 10, ptime_daily = 1, stime_daily = 1 ) - dummy_obs <- epidist::as_latent_individual(dummy_obs) + dummy_obs <- epidist::as_latent_model(dummy_obs) stancode <- epidist::epidist( data = dummy_obs, fn = brms::make_stancode ) diff --git a/NAMESPACE b/NAMESPACE index 83164b97c..9d65c6040 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,28 +3,28 @@ S3method(add_mean_sd,default) S3method(add_mean_sd,gamma_samples) S3method(add_mean_sd,lognormal_samples) -S3method(as_latent_individual,epidist_linelist) +S3method(as_latent_model,epidist_linelist) S3method(as_naive_model,data.frame) S3method(epidist,default) S3method(epidist_family_model,default) -S3method(epidist_family_model,epidist_latent_individual) +S3method(epidist_family_model,epidist_latent_model) S3method(epidist_family_prior,default) S3method(epidist_family_prior,lognormal) S3method(epidist_family_reparam,default) S3method(epidist_family_reparam,gamma) S3method(epidist_formula_model,default) -S3method(epidist_formula_model,epidist_latent_individual) +S3method(epidist_formula_model,epidist_latent_model) S3method(epidist_model_prior,default) S3method(epidist_stancode,default) -S3method(epidist_stancode,epidist_latent_individual) +S3method(epidist_stancode,epidist_latent_model) S3method(epidist_validate_data,default) S3method(epidist_validate_data,epidist_linelist) S3method(epidist_validate_model,default) -S3method(epidist_validate_model,epidist_latent_individual) +S3method(epidist_validate_model,epidist_latent_model) S3method(epidist_validate_model,epidist_naive_model) export(add_mean_sd) export(as_epidist_linelist) -export(as_latent_individual) +export(as_latent_model) export(as_naive_model) export(epidist) export(epidist_diagnostics) @@ -46,7 +46,7 @@ export(filter_obs_by_obs_time) export(filter_obs_by_ptime) >>>>>>> 989328c5 (All other direct to naive replacements) export(is_epidist_linelist) -export(is_latent_individual) +export(is_latent_model) export(is_naive_model) export(observe_process) export(predict_delay_parameters) diff --git a/R/globals.R b/R/globals.R index 26be9028b..e38be42ef 100644 --- a/R/globals.R +++ b/R/globals.R @@ -1,8 +1,8 @@ # Generated by roxyglobals: do not edit by hand utils::globalVariables(c( - ".data", # "samples", # +<<<<<<< HEAD ".data", # "woverlap", # <<<<<<< HEAD @@ -15,9 +15,11 @@ utils::globalVariables(c( ".data", # ".data", # >>>>>>> 989328c5 (All other direct to naive replacements) +======= + "woverlap", # + ":=", # +>>>>>>> 85ee9dc4 (Latent model rather than latent individual) "rlnorm", # - ".data", # - ".data", # <.replace_prior> "prior_new", # <.replace_prior> "source_new", # <.replace_prior> NULL diff --git a/R/latent.R b/R/latent_model.R similarity index 75% rename from R/latent.R rename to R/latent_model.R index 8f0bb8140..ecdf96742 100644 --- a/R/latent.R +++ b/R/latent_model.R @@ -1,19 +1,19 @@ -#' Prepare latent individual model +#' Prepare latent model #' #' @param data A `data.frame` containing line list data -#' @family latent_individual +#' @family latent_model #' @export -as_latent_individual <- function(data) { - UseMethod("as_latent_individual") +as_latent_model <- function(data) { + UseMethod("as_latent_model") } -#' @method as_latent_individual epidist_linelist -#' @family latent_individual +#' @method as_latent_model epidist_linelist +#' @family latent_model #' @autoglobal #' @export -as_latent_individual.epidist_linelist <- function(data) { +as_latent_model.epidist_linelist <- function(data) { epidist_validate_data(data) - class(data) <- c("epidist_latent_individual", class(data)) + class(data) <- c("epidist_latent_model", class(data)) data <- data |> mutate( relative_obs_time = .data$obs_time - .data$ptime_lwr, @@ -31,11 +31,11 @@ as_latent_individual.epidist_linelist <- function(data) { return(data) } -#' @method epidist_validate_model epidist_latent_individual -#' @family latent_individual +#' @method epidist_validate_model epidist_latent_model +#' @family latent_model #' @export -epidist_validate_model.epidist_latent_individual <- function(data, ...) { - assert_true(is_latent_individual(data)) +epidist_validate_model.epidist_latent_model <- function(data, ...) { + assert_true(is_latent_model(data)) col_names <- c( "ptime_lwr", "ptime_upr", "stime_lwr", "stime_upr", "obs_time", "relative_obs_time", "pwindow", "woverlap", "swindow", "delay", ".row_id" @@ -49,24 +49,25 @@ epidist_validate_model.epidist_latent_individual <- function(data, ...) { assert_numeric(data$delay, lower = 0) } -#' Check if data has the `epidist_latent_individual` class +#' Check if data has the `epidist_latent_model` class #' #' @param data A `data.frame` containing line list data -#' @family latent_individual +#' @family latent_model #' @export -is_latent_individual <- function(data) { - inherits(data, "epidist_latent_individual") +is_latent_model <- function(data) { + inherits(data, "epidist_latent_model") } #' Create the model-specific component of an `epidist` custom family #' #' @inheritParams epidist_family_model #' @param ... Additional arguments passed to method. -#' @method epidist_family_model epidist_latent_individual -#' @family latent_individual +#' @method epidist_family_model epidist_latent_model +#' @family latent_model #' @export -epidist_family_model.epidist_latent_individual <- function( - data, family, ...) { +epidist_family_model.epidist_latent_model <- function( + data, family, ... +) { # Really the name and vars are the "model-specific" parts here custom_family <- brms::custom_family( paste0("latent_", family$family), @@ -87,11 +88,12 @@ epidist_family_model.epidist_latent_individual <- function( #' @param data A `data.frame` containing line list data #' @param formula As produced by [brms::brmsformula()] #' @param ... ... -#' @method epidist_formula_model epidist_latent_individual -#' @family latent_individual +#' @method epidist_formula_model epidist_latent_model +#' @family latent_model #' @export -epidist_formula_model.epidist_latent_individual <- function( - data, formula, ...) { +epidist_formula_model.epidist_latent_model <- function( + data, formula, ... +) { # data is only used to dispatch on formula <- stats::update( formula, delay | vreal(relative_obs_time, pwindow, swindow) ~ . @@ -99,11 +101,11 @@ epidist_formula_model.epidist_latent_individual <- function( return(formula) } -#' @method epidist_stancode epidist_latent_individual -#' @family latent_individual +#' @method epidist_stancode epidist_latent_model +#' @family latent_model #' @autoglobal #' @export -epidist_stancode.epidist_latent_individual <- function(data, +epidist_stancode.epidist_latent_model <- function(data, family = epidist_family(data), formula = @@ -115,7 +117,7 @@ epidist_stancode.epidist_latent_individual <- function(data, stanvars_functions <- brms::stanvar( block = "functions", - scode = .stan_chunk("latent_individual/functions.stan") + scode = .stan_chunk("latent_model/functions.stan") ) family_name <- gsub("latent_", "", family$name) @@ -164,17 +166,17 @@ epidist_stancode.epidist_latent_individual <- function(data, stanvars_parameters <- brms::stanvar( block = "parameters", - scode = .stan_chunk("latent_individual/parameters.stan") + scode = .stan_chunk("latent_model/parameters.stan") ) stanvars_tparameters <- brms::stanvar( block = "tparameters", - scode = .stan_chunk("latent_individual/tparameters.stan") + scode = .stan_chunk("latent_model/tparameters.stan") ) stanvars_priors <- brms::stanvar( block = "model", - scode = .stan_chunk("latent_individual/priors.stan") + scode = .stan_chunk("latent_model/priors.stan") ) stanvars_all <- stanvars_version + stanvars_functions + stanvars_data + diff --git a/R/naive_model.R b/R/naive_model.R index 47d03168d..9a09561ed 100644 --- a/R/naive_model.R +++ b/R/naive_model.R @@ -41,7 +41,7 @@ epidist_validate_model.epidist_naive_model <- function(data, ...) { #' Check if data has the `epidist_naive_model` class #' #' @param data A `data.frame` containing line list data -#' @family latent_individual +#' @family naive_model #' @export is_naive_model <- function(data) { inherits(data, "epidist_naive_model") diff --git a/_pkgdown.yml b/_pkgdown.yml index 9320b7ff4..221472cc2 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -65,10 +65,10 @@ reference: desc: Functions for fitting delay distribution models using `brms` contents: - has_concept("fit") -- title: Latent individual model - desc: Specific methods for the latent individual model +- title: Latent model + desc: Specific methods for the latent model contents: - - has_concept("latent_individual") + - has_concept("latent_model") - title: Direct model desc: Specific methods for the naive model contents: diff --git a/man/as_latent_individual.Rd b/man/as_latent_individual.Rd deleted file mode 100644 index 9dc24f333..000000000 --- a/man/as_latent_individual.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/latent_individual.R -\name{as_latent_individual} -\alias{as_latent_individual} -\title{Prepare latent individual model} -\usage{ -as_latent_individual(data) -} -\arguments{ -\item{data}{A \code{data.frame} containing line list data} -} -\description{ -Prepare latent individual model -} -\seealso{ -Other latent_individual: -\code{\link{epidist_family_model.epidist_latent_individual}()}, -\code{\link{epidist_formula_model.epidist_latent_individual}()}, -\code{\link{is_latent_individual}()}, -\code{\link{is_naive_model}()} -} -\concept{latent_individual} diff --git a/man/as_latent_model.Rd b/man/as_latent_model.Rd new file mode 100644 index 000000000..9f59447c3 --- /dev/null +++ b/man/as_latent_model.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/latent_model.R +\name{as_latent_model} +\alias{as_latent_model} +\title{Prepare latent model} +\usage{ +as_latent_model(data) +} +\arguments{ +\item{data}{A \code{data.frame} containing line list data} +} +\description{ +Prepare latent model +} +\seealso{ +Other latent_model: +\code{\link{epidist_family_model.epidist_latent_model}()}, +\code{\link{epidist_formula_model.epidist_latent_model}()}, +\code{\link{is_latent_model}()} +} +\concept{latent_model} diff --git a/man/as_naive_model.Rd b/man/as_naive_model.Rd index 118f83ec0..c6f1ca5dd 100644 --- a/man/as_naive_model.Rd +++ b/man/as_naive_model.Rd @@ -12,4 +12,8 @@ as_naive_model(data) \description{ Prepare naive model to pass through to \code{brms} } +\seealso{ +Other naive_model: +\code{\link{is_naive_model}()} +} \concept{naive_model} diff --git a/man/epidist_family_model.epidist_latent_individual.Rd b/man/epidist_family_model.epidist_latent_model.Rd similarity index 51% rename from man/epidist_family_model.epidist_latent_individual.Rd rename to man/epidist_family_model.epidist_latent_model.Rd index 3ccac8f30..d900b1037 100644 --- a/man/epidist_family_model.epidist_latent_individual.Rd +++ b/man/epidist_family_model.epidist_latent_model.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/latent_individual.R -\name{epidist_family_model.epidist_latent_individual} -\alias{epidist_family_model.epidist_latent_individual} +% Please edit documentation in R/latent_model.R +\name{epidist_family_model.epidist_latent_model} +\alias{epidist_family_model.epidist_latent_model} \title{Create the model-specific component of an \code{epidist} custom family} \usage{ -\method{epidist_family_model}{epidist_latent_individual}(data, family, ...) +\method{epidist_family_model}{epidist_latent_model}(data, family, ...) } \arguments{ \item{data}{A \code{data.frame} containing line list data.} @@ -18,10 +18,9 @@ information as provided by \code{.add_dpar_info()}} Create the model-specific component of an \code{epidist} custom family } \seealso{ -Other latent_individual: -\code{\link{as_latent_individual}()}, -\code{\link{epidist_formula_model.epidist_latent_individual}()}, -\code{\link{is_latent_individual}()}, -\code{\link{is_naive_model}()} +Other latent_model: +\code{\link{as_latent_model}()}, +\code{\link{epidist_formula_model.epidist_latent_model}()}, +\code{\link{is_latent_model}()} } -\concept{latent_individual} +\concept{latent_model} diff --git a/man/epidist_formula_model.epidist_latent_individual.Rd b/man/epidist_formula_model.epidist_latent_individual.Rd deleted file mode 100644 index db5509337..000000000 --- a/man/epidist_formula_model.epidist_latent_individual.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/latent_individual.R -\name{epidist_formula_model.epidist_latent_individual} -\alias{epidist_formula_model.epidist_latent_individual} -\title{Define the model-specific component of an \code{epidist} custom formula} -\usage{ -\method{epidist_formula_model}{epidist_latent_individual}(data, formula, ...) -} -\arguments{ -\item{data}{A \code{data.frame} containing line list data} - -\item{formula}{As produced by \code{\link[brms:brmsformula]{brms::brmsformula()}}} - -\item{...}{...} -} -\description{ -Define the model-specific component of an \code{epidist} custom formula -} -\seealso{ -Other latent_individual: -\code{\link{as_latent_individual}()}, -\code{\link{epidist_family_model.epidist_latent_individual}()}, -\code{\link{is_latent_individual}()}, -\code{\link{is_naive_model}()} -} -\concept{latent_individual} diff --git a/man/epidist_formula_model.epidist_latent_model.Rd b/man/epidist_formula_model.epidist_latent_model.Rd new file mode 100644 index 000000000..8be53d973 --- /dev/null +++ b/man/epidist_formula_model.epidist_latent_model.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/latent_model.R +\name{epidist_formula_model.epidist_latent_model} +\alias{epidist_formula_model.epidist_latent_model} +\title{Define the model-specific component of an \code{epidist} custom formula} +\usage{ +\method{epidist_formula_model}{epidist_latent_model}(data, formula, ...) +} +\arguments{ +\item{data}{A \code{data.frame} containing line list data} + +\item{formula}{As produced by \code{\link[brms:brmsformula]{brms::brmsformula()}}} + +\item{...}{...} +} +\description{ +Define the model-specific component of an \code{epidist} custom formula +} +\seealso{ +Other latent_model: +\code{\link{as_latent_model}()}, +\code{\link{epidist_family_model.epidist_latent_model}()}, +\code{\link{is_latent_model}()} +} +\concept{latent_model} diff --git a/man/is_latent_individual.Rd b/man/is_latent_individual.Rd deleted file mode 100644 index 26a01d374..000000000 --- a/man/is_latent_individual.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/latent_individual.R -\name{is_latent_individual} -\alias{is_latent_individual} -\title{Check if data has the \code{epidist_latent_individual} class} -\usage{ -is_latent_individual(data) -} -\arguments{ -\item{data}{A \code{data.frame} containing line list data} -} -\description{ -Check if data has the \code{epidist_latent_individual} class -} -\seealso{ -Other latent_individual: -\code{\link{as_latent_individual}()}, -\code{\link{epidist_family_model.epidist_latent_individual}()}, -\code{\link{epidist_formula_model.epidist_latent_individual}()}, -\code{\link{is_naive_model}()} -} -\concept{latent_individual} diff --git a/man/is_latent_model.Rd b/man/is_latent_model.Rd new file mode 100644 index 000000000..d4edc65a0 --- /dev/null +++ b/man/is_latent_model.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/latent_model.R +\name{is_latent_model} +\alias{is_latent_model} +\title{Check if data has the \code{epidist_latent_model} class} +\usage{ +is_latent_model(data) +} +\arguments{ +\item{data}{A \code{data.frame} containing line list data} +} +\description{ +Check if data has the \code{epidist_latent_model} class +} +\seealso{ +Other latent_model: +\code{\link{as_latent_model}()}, +\code{\link{epidist_family_model.epidist_latent_model}()}, +\code{\link{epidist_formula_model.epidist_latent_model}()} +} +\concept{latent_model} diff --git a/man/is_naive_model.Rd b/man/is_naive_model.Rd index 6178f0e5e..9391cb9da 100644 --- a/man/is_naive_model.Rd +++ b/man/is_naive_model.Rd @@ -13,10 +13,7 @@ is_naive_model(data) Check if data has the \code{epidist_naive_model} class } \seealso{ -Other latent_individual: -\code{\link{as_latent_individual}()}, -\code{\link{epidist_family_model.epidist_latent_individual}()}, -\code{\link{epidist_formula_model.epidist_latent_individual}()}, -\code{\link{is_latent_individual}()} +Other naive_model: +\code{\link{as_naive_model}()} } -\concept{latent_individual} +\concept{naive_model} diff --git a/tests/testthat/test-diagnostics.R b/tests/testthat/test-diagnostics.R index c1c127f07..e399a79fb 100644 --- a/tests/testthat/test-diagnostics.R +++ b/tests/testthat/test-diagnostics.R @@ -41,7 +41,7 @@ test_that("epidist_diagnostics gives the same results for cmdstanr and rstan", { test_that("epidist_diagnostics gives an error when passed model fit using the Laplace algorithm", { # nolint: line_length_linter. skip_on_cran() set.seed(1) - prep_obs <- as_latent_individual(sim_obs) + prep_obs <- as_latent_model(sim_obs) fit_laplace <- epidist( data = prep_obs, seed = 1, algorithm = "laplace", backend = "cmdstanr", refresh = 0, silent = 2, show_messages = FALSE diff --git a/tests/testthat/test-formula.R b/tests/testthat/test-formula.R index ddb1eb668..3945d67bc 100644 --- a/tests/testthat/test-formula.R +++ b/tests/testthat/test-formula.R @@ -1,4 +1,4 @@ -prep_obs_gamma <- as_latent_individual(sim_obs_gamma) +prep_obs_gamma <- as_latent_model(sim_obs_gamma) family_lognormal <- epidist_family(prep_obs, family = brms::lognormal()) diff --git a/tests/testthat/test-int-latent_individual.R b/tests/testthat/test-int-latent_individual.R index 04c249583..7408dc515 100644 --- a/tests/testthat/test-int-latent_individual.R +++ b/tests/testthat/test-int-latent_individual.R @@ -4,7 +4,7 @@ # varying the input seed. Test failure at an unusually high rate does suggest # a potential code issue. -test_that("epidist.epidist_latent_individual Stan code has no syntax errors in the default case", { # nolint: line_length_linter. +test_that("epidist.epidist_latent_model Stan code has no syntax errors in the default case", { # nolint: line_length_linter. skip_on_cran() stancode <- epidist( data = prep_obs, @@ -16,7 +16,7 @@ test_that("epidist.epidist_latent_individual Stan code has no syntax errors in t expect_true(mod$check_syntax()) }) -test_that("epidist.epidist_latent_individual samples from the prior according to marginal Kolmogorov-Smirnov tests in the default case.", { # nolint: line_length_linter. +test_that("epidist.epidist_latent_model samples from the prior according to marginal Kolmogorov-Smirnov tests in the default case.", { # nolint: line_length_linter. # Note: this test is stochastic. See note at the top of this script skip_on_cran() set.seed(1) @@ -53,7 +53,7 @@ test_that("epidist.epidist_latent_individual samples from the prior according to testthat::expect_gt(ks2$p.value, 0.01) }) -test_that("epidist.epidist_latent_individual fits and the MCMC converges in the default case", { # nolint: line_length_linter. +test_that("epidist.epidist_latent_model fits and the MCMC converges in the default case", { # nolint: line_length_linter. # Note: this test is stochastic. See note at the top of this script skip_on_cran() expect_s3_class(fit, "brmsfit") @@ -61,7 +61,7 @@ test_that("epidist.epidist_latent_individual fits and the MCMC converges in the expect_convergence(fit) }) -test_that("epidist.epidist_latent_individual fits, the MCMC converges, and the draws of sigma are indeed a constant, when setting sigma = 1 (a constant)", { # nolint: line_length_linter. +test_that("epidist.epidist_latent_model fits, the MCMC converges, and the draws of sigma are indeed a constant, when setting sigma = 1 (a constant)", { # nolint: line_length_linter. # Note: this test is stochastic. See note at the top of this script skip_on_cran() set.seed(1) @@ -80,7 +80,7 @@ test_that("epidist.epidist_latent_individual fits, the MCMC converges, and the d expect_true(all(sigma == 1)) }) -test_that("epidist.epidist_latent_individual Stan code has no syntax errors", { # nolint: line_length_linter. +test_that("epidist.epidist_latent_model Stan code has no syntax errors", { # nolint: line_length_linter. # Note: this test is stochastic. See note at the top of this script skip_on_cran() set.seed(1) @@ -97,7 +97,7 @@ test_that("epidist.epidist_latent_individual Stan code has no syntax errors", { expect_true(mod_string$check_syntax()) }) -test_that("epidist.epidist_latent_individual recovers the simulation settings for the delay distribution in the default case", { # nolint: line_length_linter. +test_that("epidist.epidist_latent_model recovers the simulation settings for the delay distribution in the default case", { # nolint: line_length_linter. # Note: this test is stochastic. See note at the top of this script skip_on_cran() set.seed(1) @@ -107,7 +107,7 @@ test_that("epidist.epidist_latent_individual recovers the simulation settings fo expect_equal(mean(pred$sigma), sdlog, tolerance = 0.1) }) -test_that("epidist.epidist_latent_individual Stan code has no syntax errors and compiles in the gamma delay case", { # nolint: line_length_linter. +test_that("epidist.epidist_latent_model Stan code has no syntax errors and compiles in the gamma delay case", { # nolint: line_length_linter. skip_on_cran() stancode_gamma <- epidist( data = prep_obs_gamma, @@ -123,7 +123,7 @@ test_that("epidist.epidist_latent_individual Stan code has no syntax errors and expect_no_error(mod_gamma$compile()) }) -test_that("epidist.epidist_latent_individual fits and the MCMC converges in the gamma delay case", { # nolint: line_length_linter. +test_that("epidist.epidist_latent_model fits and the MCMC converges in the gamma delay case", { # nolint: line_length_linter. # Note: this test is stochastic. See note at the top of this script skip_on_cran() set.seed(1) @@ -132,7 +132,7 @@ test_that("epidist.epidist_latent_individual fits and the MCMC converges in the expect_convergence(fit_gamma) }) -test_that("epidist.epidist_latent_individual recovers the simulation settings for the delay distribution in the gamma delay case", { # nolint: line_length_linter. +test_that("epidist.epidist_latent_model recovers the simulation settings for the delay distribution in the gamma delay case", { # nolint: line_length_linter. # Note: this test is stochastic. See note at the top of this script skip_on_cran() set.seed(1) @@ -149,7 +149,7 @@ test_that("epidist.epidist_latent_individual recovers the simulation settings fo expect_lte(quantile_shape, 0.975) }) -test_that("epidist.epidist_latent_individual Stan code has no syntax errors for an alternative formula", { # nolint: line_length_linter. +test_that("epidist.epidist_latent_model Stan code has no syntax errors for an alternative formula", { # nolint: line_length_linter. skip_on_cran() stancode_sex <- epidist( data = prep_obs_sex, @@ -163,14 +163,11 @@ test_that("epidist.epidist_latent_individual Stan code has no syntax errors for expect_true(mod_sex$check_syntax()) }) -test_that("epidist.epidist_latent_individual recovers a sex effect", { # nolint: line_length_linter. +test_that("epidist.epidist_latent_model recovers a sex effect", { # nolint: line_length_linter. # Note: this test is stochastic. See note at the top of this script skip_on_cran() set.seed(1) draws <- posterior::as_draws_df(fit_sex$fit) expect_equal(mean(draws$b_sex), -0.73, tolerance = 0.2) expect_equal(mean(draws$b_sigma_sex), 0.43, tolerance = 0.2) - expect_s3_class(fit_sex, "brmsfit") - expect_s3_class(fit_sex, "epidist_fit") - expect_convergence(fit_sex) }) diff --git a/tests/testthat/test-latent_individual.R b/tests/testthat/test-latent_individual.R index c0fb78186..39c162193 100644 --- a/tests/testthat/test-latent_individual.R +++ b/tests/testthat/test-latent_individual.R @@ -1,51 +1,51 @@ -test_that("as_latent_individual.epidist_linelist with default settings an object with the correct classes", { # nolint: line_length_linter. - prep_obs <- as_latent_individual(sim_obs) +test_that("as_latent_model.epidist_linelist with default settings an object with the correct classes", { # nolint: line_length_linter. + prep_obs <- as_latent_model(sim_obs) expect_s3_class(prep_obs, "data.frame") - expect_s3_class(prep_obs, "epidist_latent_individual") + expect_s3_class(prep_obs, "epidist_latent_model") }) -test_that("as_latent_individual.epidist_linelist errors when passed incorrect inputs", { # nolint: line_length_linter. - expect_error(as_latent_individual(list())) - expect_error(as_latent_individual(sim_obs[, 1])) +test_that("as_latent_model.epidist_linelist errors when passed incorrect inputs", { # nolint: line_length_linter. + expect_error(as_latent_model(list())) + expect_error(as_latent_model(sim_obs[, 1])) }) # Make this data available for other tests -prep_obs <- as_latent_individual(sim_obs) +prep_obs <- as_latent_model(sim_obs) family_lognormal <- epidist_family(prep_obs, family = brms::lognormal()) -test_that("is_latent_individual returns TRUE for correct input", { # nolint: line_length_linter. - expect_true(is_latent_individual(prep_obs)) +test_that("is_latent_model returns TRUE for correct input", { # nolint: line_length_linter. + expect_true(is_latent_model(prep_obs)) expect_true({ x <- list() - class(x) <- "epidist_latent_individual" - is_latent_individual(x) + class(x) <- "epidist_latent_model" + is_latent_model(x) }) }) -test_that("is_latent_individual returns FALSE for incorrect input", { # nolint: line_length_linter. - expect_false(is_latent_individual(list())) +test_that("is_latent_model returns FALSE for incorrect input", { # nolint: line_length_linter. + expect_false(is_latent_model(list())) expect_false({ x <- list() - class(x) <- "epidist_latent_individual_extension" - is_latent_individual(x) + class(x) <- "epidist_latent_model_extension" + is_latent_model(x) }) }) -test_that("epidist_validate_model.epidist_latent_individual doesn't produce an error for correct input", { # nolint: line_length_linter. +test_that("epidist_validate_model.epidist_latent_model doesn't produce an error for correct input", { # nolint: line_length_linter. expect_no_error(epidist_validate_model(prep_obs)) }) -test_that("epidist_validate.epidist_latent_individual returns FALSE for incorrect input", { # nolint: line_length_linter. +test_that("epidist_validate.epidist_latent_model returns FALSE for incorrect input", { # nolint: line_length_linter. expect_error(epidist_validate(list())) expect_error(epidist_validate(prep_obs[, 1])) expect_error({ x <- list() - class(x) <- "epidist_latent_individual" + class(x) <- "epidist_latent_model" epidist_validate(x) }) }) -test_that("epidist_stancode.epidist_latent_individual produces valid stanvars", { # nolint: line_length_linter. +test_that("epidist_stancode.epidist_latent_model produces valid stanvars", { # nolint: line_length_linter. epidist_family <- epidist_family(prep_obs) epidist_formula <- epidist_formula( prep_obs, epidist_family, diff --git a/tests/testthat/test-prior.R b/tests/testthat/test-prior.R index 1cb50113d..5d8fc05fa 100644 --- a/tests/testthat/test-prior.R +++ b/tests/testthat/test-prior.R @@ -1,5 +1,5 @@ test_that("epidist_prior with default settings produces an object of the right class", { # nolint: line_length_linter. - data <- as_latent_individual(sim_obs) + data <- as_latent_model(sim_obs) family <- brms::lognormal() formula <- brms::bf(mu ~ 1, sigma ~ 1) epidist_family <- epidist_family(data, family) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index a814d551d..5b9701aaf 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -39,7 +39,7 @@ test_that(".add_dpar_info works as expected for the lognormal and gamma families }) test_that(".make_intercepts_explicit creates a formula which is the same as if it had been explicitly created", { # nolint: line_length_linter. - prep_obs <- as_latent_individual(sim_obs) + prep_obs <- as_latent_model(sim_obs) epidist_family <- epidist_family(prep_obs, family = "lognormal") formula <- brms:::validate_formula( formula = brms::bf(mu ~ 1), @@ -58,7 +58,7 @@ test_that(".make_intercepts_explicit creates a formula which is the same as if i }) test_that(".make_intercepts_explicit does not add an intercept if the distributional parameter is set to be fixed", { # nolint: line_length_linter. - prep_obs <- as_latent_individual(sim_obs) + prep_obs <- as_latent_model(sim_obs) epidist_family <- epidist_family(prep_obs, family = "lognormal") formula <- brms:::validate_formula( formula = brms::bf(mu ~ 1, sigma = 1), diff --git a/vignettes/approx-inference.Rmd b/vignettes/approx-inference.Rmd index eb1eca468..84ae28e4d 100644 --- a/vignettes/approx-inference.Rmd +++ b/vignettes/approx-inference.Rmd @@ -127,7 +127,7 @@ obs_cens_trunc_samp <- simulate_gillespie(seed = 101) |> slice_sample(n = sample_size, replace = FALSE) ``` -We now prepare the data for fitting with the latent individual model, and perform inference with HMC: +We now prepare the data for fitting with the latent model, and perform inference with HMC: ```{r results='hide'} # Note: this functionality will be integrated into the package shortly @@ -138,7 +138,7 @@ as_epidist_linelist_time <- function(data) { } linelist <- as_epidist_linelist_time(obs_cens_trunc_samp) -data <- as_latent_individual(linelist) +data <- as_latent_model(linelist) t <- proc.time() fit_hmc <- epidist(data = data, algorithm = "sampling", backend = "cmdstanr") @@ -147,7 +147,7 @@ time_hmc <- proc.time() - t Note that for clarity above we specify `algorithm = "sampling"`, but if you were to call `epidist(data = data)` the result would be the same since `"sampling"` (i.e. HMC) is the default value for the `algorithm` argument. -Now, we fit^[Note that in this section, and above for the MCMC, the output of the call is hidden, but if you were to call these functions yourself they would display information about the fitting procedure as it occurs] the same latent individual model using each method in Section \@ref(other). +Now, we fit^[Note that in this section, and above for the MCMC, the output of the call is hidden, but if you were to call these functions yourself they would display information about the fitting procedure as it occurs] the same latent model using each method in Section \@ref(other). To match the four Markov chains of length 1000 in HMC above, we then draw 4000 samples from each approximate posterior. ```{r results='hide'} diff --git a/vignettes/ebola.Rmd b/vignettes/ebola.Rmd index 49977dd16..92ac200b2 100644 --- a/vignettes/ebola.Rmd +++ b/vignettes/ebola.Rmd @@ -213,7 +213,7 @@ obs_cens <- obs_cens |> ## Model fitting -To prepare the data for use with the latent individual model, we set `obs_cens` to be an `epidist_linelist` object, then use the function `as_latent_individual()`: +To prepare the data for use with the latent model, we set `obs_cens` to be an `epidist_linelist` object, then use the function `as_latent_model()`: ```{r} # Note: this functionality will be integrated into the package shortly @@ -224,11 +224,11 @@ as_epidist_linelist_time <- function(data) { } linelist <- as_epidist_linelist_time(obs_cens) -obs_prep <- as_latent_individual(linelist) +obs_prep <- as_latent_model(linelist) head(obs_prep) ``` -Now we are ready to fit the latent individual model. +Now we are ready to fit the latent model. ### Intercept-only model diff --git a/vignettes/epidist.Rmd b/vignettes/epidist.Rmd index 0e680272e..8d5ec358e 100644 --- a/vignettes/epidist.Rmd +++ b/vignettes/epidist.Rmd @@ -242,9 +242,9 @@ bind_rows( theme(legend.position = "bottom") ``` -The main function you will use for modelling is called `epidist()`^[Technically, `epidist()` is an [S3 generic](http://adv-r.had.co.nz/S3.html) which allows it to work differently for inputs of different classes. This is in part why inputs must be prepared first via `as_latent_individual()` so that they are of the appropriate class!]. -We will fit the model `"latent_individual"` which uses latent variables for the time of primary and secondary event of each individual^[In a future vignette, we will explain in more detail the structure of the model!]. -To do so, we first prepare the `data` using `as_latent_individual()`: +The main function you will use for modelling is called `epidist()`^[Technically, `epidist()` is an [S3 generic](http://adv-r.had.co.nz/S3.html) which allows it to work differently for inputs of different classes. This is in part why inputs must be prepared first via `as_latent_model()` so that they are of the appropriate class!]. +We will fit the model `"latent_model"` which uses latent variables for the time of primary and secondary event of each individual^[In a future vignette, we will explain in more detail the structure of the model!]. +To do so, we first prepare the `data` using `as_latent_model()`: ```{r} # Note: this functionality will be integrated into the package shortly @@ -255,11 +255,11 @@ as_epidist_linelist_time <- function(data) { } linelist <- as_epidist_linelist_time(obs_cens_trunc_samp) -data <- as_latent_individual(linelist) +data <- as_latent_model(linelist) class(data) ``` -The `data` object now has the class `epidist_latent_individual`. +The `data` object now has the class `epidist_latent_model`. Using this `data`, we now call `epidist()` to fit the model. The parameters of the model are inferred using Bayesian inference. In particular, we use the the No-U-Turn Sampler (NUTS) Markov chain Monte Carlo (MCMC) algorithm via the [`brms`](https://paul-buerkner.github.io/brms/) R package [@brms]. diff --git a/vignettes/faq.Rmd b/vignettes/faq.Rmd index 21ba86bba..350ca8d6d 100644 --- a/vignettes/faq.Rmd +++ b/vignettes/faq.Rmd @@ -55,7 +55,7 @@ as_epidist_linelist_time <- function(data) { } linelist <- as_epidist_linelist_time(obs_cens_trunc_samp) -data <- as_latent_individual(linelist) +data <- as_latent_model(linelist) fit <- epidist( data, @@ -110,7 +110,7 @@ For an example use of these functions, have a look at the [`epidist-paper`](http However, some of those priors do not make sense in the context of our application. Instead, we used [prior predictive checking](https://mc-stan.org/docs/stan-users-guide/posterior-predictive-checks.html) to set `epidist`-specific default priors which produce epidemiological delay distribution mean and standard deviation parameters in a reasonable range. -For example, for the `brms::lognormal()` latent individual model, we suggest the following prior distributions for the `brms` `mu` and `sigma` intercept parameters: +For example, for the `brms::lognormal()` latent model, we suggest the following prior distributions for the `brms` `mu` and `sigma` intercept parameters: ```{r} family <- "lognormal" @@ -220,7 +220,7 @@ ggplot(draws_pmf, aes(x = .prediction)) + ``` Importantly, this functionality is only available for `epidist` models using custom `brms` families that have `posterior_predict` and `posterior_epred` methods implemented. -For example, for the `latent_individual` model, currently methods are implemented for the [lognormal](https://github.com/epinowcast/epidist/blob/main/R/latent_lognormal.R) and [gamma](https://github.com/epinowcast/epidist/blob/main/R/latent_gamma.R) families. +For example, for the `latent_model` model, currently methods are implemented for the [lognormal](https://github.com/epinowcast/epidist/blob/main/R/latent_lognormal.R) and [gamma](https://github.com/epinowcast/epidist/blob/main/R/latent_gamma.R) families. If you are using another family, consider [submitting a pull request](https://github.com/epinowcast/epidist/pulls) to implement these methods! In doing so, you may find it useful to use the [`primarycensored`](https://primarycensored.epinowcast.org/) package. From 49ab3b1fbcd9e20ee6d00c6949c44e6ee6d5da25 Mon Sep 17 00:00:00 2001 From: athowes Date: Thu, 14 Nov 2024 10:18:59 +0000 Subject: [PATCH 05/13] File renames --- .../{test-int-latent_individual.R => test-int-latent_model.R} | 0 tests/testthat/{test-latent_individual.R => test-latent_model.R} | 0 tests/testthat/{test-direct_model.R => test-naive_model.R} | 0 3 files changed, 0 insertions(+), 0 deletions(-) rename tests/testthat/{test-int-latent_individual.R => test-int-latent_model.R} (100%) rename tests/testthat/{test-latent_individual.R => test-latent_model.R} (100%) rename tests/testthat/{test-direct_model.R => test-naive_model.R} (100%) diff --git a/tests/testthat/test-int-latent_individual.R b/tests/testthat/test-int-latent_model.R similarity index 100% rename from tests/testthat/test-int-latent_individual.R rename to tests/testthat/test-int-latent_model.R diff --git a/tests/testthat/test-latent_individual.R b/tests/testthat/test-latent_model.R similarity index 100% rename from tests/testthat/test-latent_individual.R rename to tests/testthat/test-latent_model.R diff --git a/tests/testthat/test-direct_model.R b/tests/testthat/test-naive_model.R similarity index 100% rename from tests/testthat/test-direct_model.R rename to tests/testthat/test-naive_model.R From 35ace782a952a13450aae3a6c7b7cd0e89ea5dec Mon Sep 17 00:00:00 2001 From: athowes Date: Thu, 14 Nov 2024 11:15:32 +0000 Subject: [PATCH 06/13] Rename stan latent model folder --- inst/stan/{latent_individual => latent_model}/functions.stan | 0 inst/stan/{latent_individual => latent_model}/parameters.stan | 0 inst/stan/{latent_individual => latent_model}/priors.stan | 0 inst/stan/{latent_individual => latent_model}/tparameters.stan | 0 4 files changed, 0 insertions(+), 0 deletions(-) rename inst/stan/{latent_individual => latent_model}/functions.stan (100%) rename inst/stan/{latent_individual => latent_model}/parameters.stan (100%) rename inst/stan/{latent_individual => latent_model}/priors.stan (100%) rename inst/stan/{latent_individual => latent_model}/tparameters.stan (100%) diff --git a/inst/stan/latent_individual/functions.stan b/inst/stan/latent_model/functions.stan similarity index 100% rename from inst/stan/latent_individual/functions.stan rename to inst/stan/latent_model/functions.stan diff --git a/inst/stan/latent_individual/parameters.stan b/inst/stan/latent_model/parameters.stan similarity index 100% rename from inst/stan/latent_individual/parameters.stan rename to inst/stan/latent_model/parameters.stan diff --git a/inst/stan/latent_individual/priors.stan b/inst/stan/latent_model/priors.stan similarity index 100% rename from inst/stan/latent_individual/priors.stan rename to inst/stan/latent_model/priors.stan diff --git a/inst/stan/latent_individual/tparameters.stan b/inst/stan/latent_model/tparameters.stan similarity index 100% rename from inst/stan/latent_individual/tparameters.stan rename to inst/stan/latent_model/tparameters.stan From 8ddb2daecd45f1ec802cb2de8ce242793af2d01e Mon Sep 17 00:00:00 2001 From: athowes Date: Thu, 14 Nov 2024 16:23:21 +0000 Subject: [PATCH 07/13] Fix linter --- R/latent_model.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/latent_model.R b/R/latent_model.R index ecdf96742..9a28ffa79 100644 --- a/R/latent_model.R +++ b/R/latent_model.R @@ -106,11 +106,11 @@ epidist_formula_model.epidist_latent_model <- function( #' @autoglobal #' @export epidist_stancode.epidist_latent_model <- function(data, - family = - epidist_family(data), - formula = - epidist_formula(data), - ...) { + family = + epidist_family(data), + formula = + epidist_formula(data), + ...) { epidist_validate_model(data) stanvars_version <- .version_stanvar() From cdb45d605abecde30703972bef0ea1e53ab05c07 Mon Sep 17 00:00:00 2001 From: athowes Date: Thu, 14 Nov 2024 14:28:04 +0000 Subject: [PATCH 08/13] Fix to check-cmdstan action --- .github/workflows/check-cmdstan.yaml | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/.github/workflows/check-cmdstan.yaml b/.github/workflows/check-cmdstan.yaml index 0bcc8384e..d5fd78cc5 100644 --- a/.github/workflows/check-cmdstan.yaml +++ b/.github/workflows/check-cmdstan.yaml @@ -62,15 +62,17 @@ jobs: - name: Compile model and check syntax run: | - dummy_obs <- dplyr::tibble(case = 1L, ptime = 1, stime = 2, - delay_daily = 1, delay_lwr = 1, delay_upr = 2, ptime_lwr = 1, - ptime_upr = 2, stime_lwr = 1, stime_upr = 2, obs_time = 100, - censored = "interval", censored_obs_time = 10, ptime_daily = 1, - stime_daily = 1 + dummy_data <- data.frame( + pdate_lwr = as.POSIXct("2024-01-01 00:00:00"), + pdate_upr = as.POSIXct("2024-01-02 00:00:00"), + sdate_lwr = as.POSIXct("2024-01-03 00:00:00"), + sdate_upr = as.POSIXct("2024-01-04 00:00:00"), + obs_date = as.POSIXct("2024-01-05 00:00:00") ) - dummy_obs <- epidist::as_latent_model(dummy_obs) + linelist <- epidist::as_epidist_linelist(dummy_data) + latent_model <- epidist::as_latent_model(linelist) stancode <- epidist::epidist( - data = dummy_obs, fn = brms::make_stancode + data = latent_model, fn = brms::make_stancode ) mod <- cmdstanr::cmdstan_model( stan_file = cmdstanr::write_stan_file(stancode), compile = FALSE From e908c77ad98667cfe19c2f9b90ef8334746377b6 Mon Sep 17 00:00:00 2001 From: athowes Date: Thu, 14 Nov 2024 14:57:18 +0000 Subject: [PATCH 09/13] Fixes to .rename_columns function required --- R/utils.R | 7 ++++++- tests/testthat/test-utils.R | 13 +++++++++++++ 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index a2cef2f8c..af2215ad5 100644 --- a/R/utils.R +++ b/R/utils.R @@ -135,7 +135,12 @@ #' @keywords internal #' @importFrom stats setNames .rename_columns <- function(df, new_names, old_names) { - are_char <- is.character(new_names) & is.character(old_names) + if (is.null(new_names) | is.null(old_names)) { + return(df) + } + new_char <- sapply(new_names, is.character) + old_char <- sapply(old_names, is.character) + are_char <- new_char & old_char valid_new_names <- new_names[are_char] valid_old_names <- old_names[are_char] if (length(are_char) > 0) { diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 5b9701aaf..e8d0fc7cd 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -70,3 +70,16 @@ test_that(".make_intercepts_explicit does not add an intercept if the distributi attr(formula_updated$pforms$sigma, ".Environment") <- NULL expect_equal(formula, formula_updated) }) + +test_that(".rename_columns works correctly", { # nolint: line_length_linter. + df <- data.frame(a = 1, b = 2) + new_df <- .rename_columns(df, new_names = c("x", "y"), old_names = c("a", "b")) + expect_named(new_df, c("x", "y")) +}) + +test_that(".rename_columns does nothing if old_names is only NULL", { # nolint: line_length_linter. + df <- data.frame(a = 1, b = 2) + new_df <- .rename_columns(df, new_names = c("a", "b"), old_names = c(NULL, NULL)) + expect_named(new_df, c("a", "b")) +}) + From ae60b0692ab9b4c9d727d2cd9130b28ac06407a1 Mon Sep 17 00:00:00 2001 From: athowes Date: Thu, 14 Nov 2024 14:57:27 +0000 Subject: [PATCH 10/13] Don't need case anymore --- R/preprocess.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/preprocess.R b/R/preprocess.R index e39c84f56..c1499a2ec 100644 --- a/R/preprocess.R +++ b/R/preprocess.R @@ -53,7 +53,7 @@ epidist_validate_data.epidist_linelist <- function(data, ...) { assert_true(is_epidist_linelist(data)) assert_data_frame(data) col_names <- c( - "case", "ptime_lwr", "ptime_upr", "stime_lwr", "stime_upr", "obs_time" + "ptime_lwr", "ptime_upr", "stime_lwr", "stime_upr", "obs_time" ) assert_names(names(data), must.include = col_names) assert_numeric(data$ptime_lwr, lower = 0) From 6f5ae795abf3bc161b6f6d54a8ffdac17521e2d1 Mon Sep 17 00:00:00 2001 From: athowes Date: Thu, 14 Nov 2024 15:33:17 +0000 Subject: [PATCH 11/13] Lint --- R/utils.R | 2 +- tests/testthat/test-utils.R | 9 ++++++--- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/R/utils.R b/R/utils.R index af2215ad5..f351cd332 100644 --- a/R/utils.R +++ b/R/utils.R @@ -135,7 +135,7 @@ #' @keywords internal #' @importFrom stats setNames .rename_columns <- function(df, new_names, old_names) { - if (is.null(new_names) | is.null(old_names)) { + if (is.null(new_names) || is.null(old_names)) { return(df) } new_char <- sapply(new_names, is.character) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index e8d0fc7cd..da6d7fc42 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -73,13 +73,16 @@ test_that(".make_intercepts_explicit does not add an intercept if the distributi test_that(".rename_columns works correctly", { # nolint: line_length_linter. df <- data.frame(a = 1, b = 2) - new_df <- .rename_columns(df, new_names = c("x", "y"), old_names = c("a", "b")) + new_df <- .rename_columns( + df, new_names = c("x", "y"), old_names = c("a", "b") + ) expect_named(new_df, c("x", "y")) }) test_that(".rename_columns does nothing if old_names is only NULL", { # nolint: line_length_linter. df <- data.frame(a = 1, b = 2) - new_df <- .rename_columns(df, new_names = c("a", "b"), old_names = c(NULL, NULL)) + new_df <- .rename_columns( + df, new_names = c("a", "b"), old_names = c(NULL, NULL) + ) expect_named(new_df, c("a", "b")) }) - From 40c39f82994fc29cb6407198b30e56f972551282 Mon Sep 17 00:00:00 2001 From: athowes Date: Thu, 14 Nov 2024 15:45:43 +0000 Subject: [PATCH 12/13] Naive and latent model names enforce --- tests/testthat/setup.R | 8 ++++---- tests/testthat/test-int-naive_model.R | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index eeca9f54b..f7a92158f 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -83,10 +83,10 @@ sim_obs_sex <- dplyr::bind_rows(sim_obs_sex_m, sim_obs_sex_f) |> # Temporary solution for classing time data sim_obs_sex <- as_epidist_linelist_time(sim_obs_sex) -prep_obs <- as_latent_individual(sim_obs) -prep_direct_obs <- as_direct_model(sim_obs) -prep_obs_gamma <- as_latent_individual(sim_obs_gamma) -prep_obs_sex <- as_latent_individual(sim_obs_sex) +prep_obs <- as_latent_model(sim_obs) +prep_naive_obs <- as_naive_model(sim_obs) +prep_obs_gamma <- as_latent_model(sim_obs_gamma) +prep_obs_sex <- as_latent_model(sim_obs_sex) if (not_on_cran()) { set.seed(1) diff --git a/tests/testthat/test-int-naive_model.R b/tests/testthat/test-int-naive_model.R index 0fbae8264..d4c189097 100644 --- a/tests/testthat/test-int-naive_model.R +++ b/tests/testthat/test-int-naive_model.R @@ -7,7 +7,7 @@ test_that("epidist.epidist_naive_model Stan code has no syntax errors in the default case", { # nolint: line_length_linter. skip_on_cran() stancode <- epidist( - data = prep_direct_obs, + data = prep_naive_obs, fn = brms::make_stancode ) mod <- cmdstanr::cmdstan_model( @@ -21,7 +21,7 @@ test_that("epidist.epidist_naive_model fits and the MCMC converges in the defaul skip_on_cran() set.seed(1) fit <- epidist( - data = prep_direct_obs, + data = prep_naive_obs, seed = 1, silent = 2, refresh = 0, cores = 2, From 40af7d13bf3090f116faee4bdad304f4bdfcef20 Mon Sep 17 00:00:00 2001 From: athowes Date: Thu, 14 Nov 2024 16:24:12 +0000 Subject: [PATCH 13/13] Redoc --- NAMESPACE | 6 ------ R/globals.R | 18 +++++------------- 2 files changed, 5 insertions(+), 19 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 9d65c6040..b5cfd86f2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -39,12 +39,6 @@ export(epidist_prior) export(epidist_stancode) export(epidist_validate_data) export(epidist_validate_model) -<<<<<<< HEAD -export(is_direct_model) -======= -export(filter_obs_by_obs_time) -export(filter_obs_by_ptime) ->>>>>>> 989328c5 (All other direct to naive replacements) export(is_epidist_linelist) export(is_latent_model) export(is_naive_model) diff --git a/R/globals.R b/R/globals.R index e38be42ef..5b6c8af71 100644 --- a/R/globals.R +++ b/R/globals.R @@ -1,25 +1,17 @@ # Generated by roxyglobals: do not edit by hand utils::globalVariables(c( + ".data", # "samples", # -<<<<<<< HEAD - ".data", # - "woverlap", # -<<<<<<< HEAD -======= + ".data", # + "woverlap", # ".data", # ".data", # - ".data", # - ".data", # - ":=", # ".data", # ".data", # ->>>>>>> 989328c5 (All other direct to naive replacements) -======= - "woverlap", # - ":=", # ->>>>>>> 85ee9dc4 (Latent model rather than latent individual) "rlnorm", # + ".data", # + ".data", # <.replace_prior> "prior_new", # <.replace_prior> "source_new", # <.replace_prior> NULL