Issue #438: Use class as default for family and reexport common families and formula function

NAMESPACE

@@ -23,11 +23,13 @@ S3method(epidist_formula_model,epidist_latent_model)
 S3method(epidist_model_prior,default)
 S3method(epidist_stancode,default)
 S3method(epidist_stancode,epidist_latent_model)
+export(Gamma)
 export(add_mean_sd)
 export(as_epidist_latent_model)
 export(as_epidist_linelist_data)
 export(as_epidist_naive_model)
 export(assert_epidist)
+export(bf)
 export(epidist)
 export(epidist_diagnostics)
 export(epidist_family)
@@ -42,6 +44,7 @@ export(epidist_stancode)
 export(is_epidist_latent_model)
 export(is_epidist_linelist_data)
 export(is_epidist_naive_model)
+export(lognormal)
 export(new_epidist_latent_model)
 export(new_epidist_linelist_data)
 export(new_epidist_naive_model)
@@ -52,10 +55,13 @@ export(simulate_exponential_cases)
 export(simulate_gillespie)
 export(simulate_secondary)
 export(simulate_uniform_cases)
+export(weibull)
 import(ggplot2)
 importFrom(brms,bf)
+importFrom(brms,lognormal)
 importFrom(brms,prior)
 importFrom(brms,stanvar)
+importFrom(brms,weibull)
 importFrom(checkmate,assert_class)
 importFrom(checkmate,assert_data_frame)
 importFrom(checkmate,assert_date)
@@ -75,6 +81,7 @@ importFrom(dplyr,mutate)
 importFrom(dplyr,select)
 importFrom(lubridate,days)
 importFrom(lubridate,is.timepoint)
+importFrom(stats,Gamma)
 importFrom(stats,as.formula)
 importFrom(stats,setNames)
 importFrom(tibble,tibble)

R/epidist.R

@@ -9,8 +9,9 @@
 #' @param family A description of the response distribution and link function to
 #' be used in the model. Every family function has a link argument allowing
 #' users to specify the link function to be applied on the response variable.
-#' If not specified, default links are used. For details of supported families
-#' see [brmsfamily()].
+#' If not specified, default links are used. For details of all supported
+#' families see [brmsfamily()]. Commonly used, such as [lognormal()], are also
+#' reexported as part of `epidist`.
 #' @param prior One or more `brmsprior` objects created by [brms::set_prior()]
 #' or related functions. These priors are passed to [epidist_prior()] in the
 #' `prior` argument.
@@ -34,7 +35,7 @@ epidist <- function(data, formula, family, prior, fn, ...) {
 #' @family fit
 #' @export
 epidist.default <- function(data, formula = mu ~ 1,
-                            family = "lognormal", prior = NULL,
+                            family = lognormal(), prior = NULL,
                             fn = brms::brm, ...) {
   assert_epidist(data)
   epidist_family <- epidist_family(data, family)

R/family.R

@@ -8,7 +8,7 @@
 #' @inheritParams epidist
 #' @family family
 #' @export
-epidist_family <- function(data, family = "lognormal", ...) {
+epidist_family <- function(data, family = lognormal(), ...) {
   assert_epidist(data)
   family <- brms:::validate_family(family) # nolint
   class(family) <- c(family$family, class(family))

R/reexports.R

@@ -0,0 +1,15 @@
+#' @importFrom brms lognormal
+#' @export
+brms::lognormal
+
+#' @importFrom brms weibull
+#' @export
+brms::weibull
+
+#' @importFrom stats Gamma
+#' @export
+stats::Gamma
+
+#' @importFrom brms bf
+#' @export
+brms::bf

_pkgdown.yml

@@ -84,3 +84,6 @@ reference:
 - title: Diagnostic functions
   contents:
   - has_concept("diagnostics")
+- title: Reexported functions
+  contents:
+  - reexports

tests/testthat/setup.R

@@ -112,14 +112,14 @@ if (not_on_cran()) {
   )
 
   fit_gamma <- epidist(
-    data = prep_obs_gamma, family = stats::Gamma(link = "log"),
+    data = prep_obs_gamma, family = Gamma(link = "log"),
     seed = 1, chains = 2, cores = 2, silent = 2, refresh = 0,
     backend = "cmdstanr"
   )
 
   fit_sex <- epidist(
     data = prep_obs_sex,
-    formula = brms::bf(mu ~ 1 + sex, sigma ~ 1 + sex),
+    formula = bf(mu ~ 1 + sex, sigma ~ 1 + sex),
     seed = 1, silent = 2, refresh = 0,
     cores = 2, chains = 2, backend = "cmdstanr"
   )

tests/testthat/test-family.R

@@ -11,7 +11,7 @@ test_that("epidist_family gives an error when passed inappropriate family input"
 })
 
 test_that("the family argument in epidist_family passes as expected for brms and stats family objects, as well as strings", { # nolint: line_length_linter.
-  family_lognormal <- epidist_family(prep_obs, family = brms::lognormal())
+  family_lognormal <- epidist_family(prep_obs, family = lognormal())
   expect_identical(family_lognormal$name, "latent_lognormal")
   family_gamma <- epidist_family(prep_obs, family = Gamma(link = "log"))
   expect_identical(family_gamma$name, "latent_gamma")

tests/testthat/test-formula.R

@@ -1,6 +1,6 @@
 prep_obs_gamma <- as_epidist_latent_model(sim_obs_gamma)
 
-family_lognormal <- epidist_family(prep_obs, family = brms::lognormal())
+family_lognormal <- epidist_family(prep_obs, family = lognormal())
 
 test_that("epidist_formula with default settings produces a brmsformula with the correct intercept only formula", { # nolint: line_length_linter.
   form <- epidist_formula(
@@ -18,7 +18,7 @@ test_that("epidist_formula with default settings produces a brmsformula with the
   )
   form_explicit <- epidist_formula(
     prep_obs,
-    family = family_lognormal, formula = brms::bf(mu ~ 1, sigma ~ 1)
+    family = family_lognormal, formula = bf(mu ~ 1, sigma ~ 1)
   )
   attr(form$pforms$sigma, ".Environment") <- NULL
   attr(form_explicit$pforms$sigma, ".Environment") <- NULL
@@ -30,7 +30,7 @@ test_that("epidist_formula with custom formulas produces a brmsformula with corr
   form_sex <- epidist_formula(
     prep_obs,
     family = family_lognormal,
-    formula = brms::bf(mu ~ 1 + sex, sigma ~ 1 + sex)
+    formula = bf(mu ~ 1 + sex, sigma ~ 1 + sex)
   )
   expect_s3_class(form_sex, "brmsformula")
   expect_identical(
@@ -48,28 +48,28 @@ test_that("epidist_formula with custom formulas errors for incorrect custom form
     epidist_formula(
       prep_obs,
       family = family_lognormal,
-      formula = brms::bf(mu ~ 1 + age, sigma ~ 1)
+      formula = bf(mu ~ 1 + age, sigma ~ 1)
     )
   )
   expect_error(
     epidist_formula(
       prep_obs,
       family = family_lognormal,
-      formula = brms::bf(mu ~ 1, sigma ~ 1 + age)
+      formula = bf(mu ~ 1, sigma ~ 1 + age)
     )
   )
   expect_error(
     epidist_formula(
       prep_obs,
       family = family_lognormal,
-      formula = brms::bf(list(), sigma ~ 1)
+      formula = bf(list(), sigma ~ 1)
     )
   )
   expect_error(
     epidist_formula(
       prep_obs,
       family = family_lognormal,
-      formula = brms::bf(mu ~ 1, shape ~ 1)
+      formula = bf(mu ~ 1, shape ~ 1)
     )
   )
 })