Issues 82 and 83: Use term generics and add generic defaults with sto…

…p message (#91)

* Rename methods to generics, add more defaults, add family tags

* Update stop message to be more informative

NAMESPACE

@@ -1,11 +1,15 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(epidist,default)
+S3method(epidist_family,default)
 S3method(epidist_family,epidist_ltcad)
+S3method(epidist_formula,default)
 S3method(epidist_formula,epidist_ltcad)
 S3method(epidist_prepare,default)
 S3method(epidist_prepare,epidist_ltcad)
+S3method(epidist_priors,default)
 S3method(epidist_priors,epidist_ltcad)
+S3method(epidist_stancode,default)
 S3method(epidist_stancode,epidist_ltcad)
 export(add_natural_scale_mean_sd)
 export(calculate_censor_delay)

R/defaults.R

@@ -0,0 +1,90 @@
+#' Default method used when preparing data
+#'
+#' @param model Character string, model type to prepare to use.
+#' Supported options are "ltcad".
+#' @param ... Additional arguments passed to model specific `epidist_prepare`
+#' functions
+#' @rdname epidist_prepare
+#' @method epidist_prepare default
+#' @family defaults
+#' @export
+epidist_prepare.default <- function(data, model, ...) {
+  model <- match.arg(model, choices = c("ltcad"))
+  class(data) <- c(class(data), paste0("epidist_", model))
+  epidist_prepare(data, ...)
+}
+
+#' Default method for defining a model specific formula
+#' 
+#' @inheritParams epidist_formula
+#' @param ... Additional arguments for method.
+#' @family defaults
+#' @export
+epidist_formula.default <- function(data, ...) {
+  stop(
+    "No epidist_formula method implemented for the class ", class(x), "\n",
+    "See methods(epidist_formula) for available methods"
+  )
+}
+
+#' Default method for defining a model specific family
+#' 
+#' @inheritParams epidist_family
+#' @param ... Additional arguments for method.
+#' @family defaults
+#' @export
+epidist_family.default <- function(data, ...) {
+  stop(
+    "No epidist_family method implemented for the class ", class(x), "\n",
+    "See methods(epidist_family) for available methods"
+  )
+}
+
+#' Default method for defining model specific priors
+#' 
+#' @inheritParams epidist_priors
+#' @param ... Additional arguments for method.
+#' @family defaults
+#' @export
+epidist_priors.default <- function(data, ...) {
+  stop(
+    "No epidist_priors method implemented for the class ", class(x), "\n",
+    "See methods(epidist_priors) for available methods"
+  )
+}
+
+#' Default method for defining model specific Stan code
+#' 
+#' @inheritParams epidist_stancode
+#' @param ... Additional arguments for method.
+#' @family defaults
+#' @export
+epidist_stancode.default <- function(data, ...) {
+  stop(
+    "No epidist_stancode method implemented for the class ", class(x), "\n",
+    "See methods(epidist_stancode) for available methods"
+  )
+}
+
+#' Default method used for interface using `brms`
+#'
+#' @inheritParams epidist
+#' @rdname epidist.default
+#' @method epidist default
+#' @family defaults
+#' @export
+epidist.default <- function(data, formula = epidist_formula(data),
+                            family = epidist_family(data),
+                            priors = epidist_priors(data),
+                            stancode = epidist_stancode(data), fn = brms::brm,
+                            ...) {
+
+  fit <- fn(
+    formula = formula, family = family, stanvars = stancode,
+    backend = "cmdstanr", data = data, ...
+  )
+
+  class(fit) <- c(class(fit), "epidist_fit")
+
+  return(fit)
+}

R/methods.R → R/generics.R

@@ -2,33 +2,17 @@
 #'
 #' @param data A dataframe to be used for modelling.
 #' @rdname epidist_prepare
-#' @family methods
+#' @family generics
 #' @export
 epidist_prepare <- function(data, ...) {
   UseMethod("epidist_prepare")
 }
 
-#' Default method used when preparing data
-#'
-#' @param model Character string, model type to prepare to use.
-#' Supported options are "ltcad".
-#' @param ... Additional arguments passed to model specific `epidist_prepare`
-#' functions
-#' @rdname epidist_prepare
-#' @method epidist_prepare default
-#' @family methods
-#' @export
-epidist_prepare.default <- function(data, model, ...) {
-  model <- match.arg(model, choices = c("ltcad"))
-  class(data) <- c(class(data), paste0("epidist_", model))
-  epidist_prepare(data, ...)
-}
-
 #' Define a model specific formula
 #' 
 #' @inheritParams epidist_prepare
 #' @param ... Additional arguments for method.
-#' @family methods
+#' @family generics
 #' @export
 epidist_formula <- function(data, ...) {
   UseMethod("epidist_formula")
@@ -38,7 +22,7 @@ epidist_formula <- function(data, ...) {
 #' 
 #' @inheritParams epidist_prepare
 #' @param ... Additional arguments for method.
-#' @family methods
+#' @family generics
 #' @export
 epidist_family <- function(data, ...) {
   UseMethod("epidist_family")
@@ -49,7 +33,7 @@ epidist_family <- function(data, ...) {
 #' @inheritParams epidist_prepare
 #' @param ... Additional arguments for method.
 #' @rdname epidist_priors
-#' @family methods
+#' @family generics
 #' @export
 epidist_priors <- function(data, ...) {
   UseMethod("epidist_priors")
@@ -60,7 +44,7 @@ epidist_priors <- function(data, ...) {
 #' @inheritParams epidist_prepare
 #' @param ... Additional arguments for method.
 #' @rdname epidist_stancode
-#' @family methods
+#' @family generics
 #' @export
 epidist_stancode <- function(data, ...) {
   UseMethod("epidist_stancode")
@@ -76,31 +60,8 @@ epidist_stancode <- function(data, ...) {
 #' `brms::make_standata`.
 #' @inheritParams epidist_prepare
 #' @param ... Additional arguments for method.
-#' @family methods
+#' @family generics
 #' @export
 epidist <- function(data, formula, family, priors, custom_stancode, fn, ...) {
   UseMethod("epidist")
 }
-
-#' Default method used for interface using `brms`
-#'
-#' @inheritParams epidist
-#' @rdname epidist
-#' @method epidist default
-#' @family methods
-#' @export
-epidist.default <- function(data, formula = epidist_formula(data),
-                            family = epidist_family(data),
-                            priors = epidist_priors(data),
-                            stancode = epidist_stancode(data), fn = brms::brm,
-                            ...) {
-
-  fit <- fn(
-    formula = formula, family = family, stanvars = stancode,
-    backend = "cmdstanr", data = data, ...
-  )
-
-  class(fit) <- c(class(fit), "epidist_fit")
-
-  return(fit)
-}

_pkgdown.yml

@@ -24,12 +24,16 @@ reference:
   desc: Functions for observing data
   contents:
   - has_concept("observe")
-- title: Methods
-  desc: Functions for estimating epidemiological delays
+- title: S3 generics
+  desc: S3 generics for delay modelling
   contents:
-  - has_concept("methods")
+  - has_concept("generics")
+- title: Method default
+  desc: Default methods for S3 generics
+  contents:
+  - has_concept("defaults")
 - title: Latent truncation censoring adjusted delay model
-  desc: Model-specific functions
+  desc: Model-specific methods
   contents:
   - has_concept("ltcad")
 - title: Postprocess

inst/s3-testing.R

@@ -53,3 +53,12 @@ fit_gamma <- epidist(
     family = epidist_family(prep_obs, family = "gamma")
   )
 )
+
+# Test the defaults
+
+x <- list()
+epidist_prepare(x)
+epidist_family(x)
+epidist_formula(x)
+epidist_priors(x)
+epidist_stancode(x)