diff --git a/NAMESPACE b/NAMESPACE index fc849511c..2500b26bb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,10 +5,12 @@ S3method(add_mean_sd,gamma_samples) S3method(add_mean_sd,lognormal_samples) S3method(as_latent_individual,data.frame) S3method(epidist,default) -S3method(epidist_family,default) -S3method(epidist_family,epidist_latent_individual) +S3method(epidist_family_model,default) +S3method(epidist_family_model,epidist_latent_individual) S3method(epidist_family_prior,default) S3method(epidist_family_prior,lognormal) +S3method(epidist_family_reparam,default) +S3method(epidist_family_reparam,gamma) S3method(epidist_formula,default) S3method(epidist_formula,epidist_latent_individual) S3method(epidist_model_prior,default) @@ -21,7 +23,9 @@ export(as_latent_individual) export(epidist) export(epidist_diagnostics) export(epidist_family) +export(epidist_family_model) export(epidist_family_prior) +export(epidist_family_reparam) export(epidist_formula) export(epidist_model_prior) export(epidist_prior) diff --git a/R/defaults.R b/R/defaults.R index 5b866c408..35bd89b4e 100644 --- a/R/defaults.R +++ b/R/defaults.R @@ -24,19 +24,6 @@ epidist_formula.default <- function(data, ...) { ) } -#' Default method for defining a model specific family -#' -#' @inheritParams epidist_family -#' @param ... Additional arguments passed to method. -#' @family defaults -#' @export -epidist_family.default <- function(data, ...) { - cli_abort( - "No epidist_family method implemented for the class ", class(data), "\n", - "See methods(epidist_family) for available methods" - ) -} - #' Default method for defining model specific Stan code #' #' @inheritParams epidist_stancode diff --git a/R/family.R b/R/family.R new file mode 100644 index 000000000..33b423ac4 --- /dev/null +++ b/R/family.R @@ -0,0 +1,82 @@ +#' Define `epidist` family +#' +#' This function is used within [epidist()] to create a model specific custom +#' `brms` family object. This custom family is passed to `brms`. It is unlikely +#' that as a user you will need this function, but we export it nonetheless to +#' be transparent about what happens inside of a call to [epidist()]. +#' +#' @param data A `data.frame` containing line list data +#' @param family Output of a call to `brms::brmsfamily()` +#' @param ... ... +#' +#' @family family +#' @export +epidist_family <- function(data, family = "lognormal", ...) { + epidist_validate(data) + family <- brms:::validate_family(family) + class(family) <- c(family$family, class(family)) + family <- .add_dpar_info(family) + custom_family <- epidist_family_model(data, family, ...) + class(custom_family) <- c(family$family, class(custom_family)) + custom_family <- epidist_family_reparam(custom_family) + return(custom_family) +} + +#' The model-specific parts of an `epidist_family()` call +#' +#' @inheritParams epidist_family +#' @param family Output of a call to `brms::brmsfamily()` with additional +#' information as provided by `.add_dpar_info()` +#' @param ... Additional arguments passed to method. +#' @rdname epidist_family_model +#' @family family +#' @export +epidist_family_model <- function(data, family, ...) { + UseMethod("epidist_family_model") +} + +#' Default method for defining a model specific family +#' +#' @inheritParams epidist_family_model +#' @param ... Additional arguments passed to method. +#' @family family +#' @export +epidist_family_model.default <- function(data, ...) { + cli_abort( + "No epidist_family_model method implemented for the class ", class(data), + "\n", "See methods(epidist_family_model) for available methods" + ) +} + +#' Reparameterise an `epidist` family to align `brms` and Stan +#' +#' @inheritParams epidist_family +#' @param ... Additional arguments passed to method. +#' @rdname epidist_family_reparam +#' @family family +#' @export +epidist_family_reparam <- function(family, ...) { + UseMethod("epidist_family_reparam") +} + +#' Default method for families which do not require a reparameterisation +#' +#' @inheritParams epidist_family_reparam +#' @param ... Additional arguments passed to method. +#' @family family +#' @export +epidist_family_reparam.default <- function(family, ...) { + family$reparam <- family$dpars + return(family) +} + +#' Reparameterisation for the gamma family +#' +#' @inheritParams epidist_family_reparam +#' @param ... Additional arguments passed to method. +#' @family family +#' @export +epidist_family_reparam.gamma <- function(family, ...) { + family$reparam <- c("shape", "shape ./ mu") + return(family) +} diff --git a/R/generics.R b/R/generics.R index 08787b7c4..92326df58 100644 --- a/R/generics.R +++ b/R/generics.R @@ -4,7 +4,7 @@ #' particular `epidist` model. This may include checking the class of `data`, #' and that it contains suitable columns. #' -#' @param data A `data.frame` to be used for modelling. +#' @param data A `data.frame` containing line list data. #' @family generics #' @export epidist_validate <- function(data) { @@ -26,21 +26,6 @@ epidist_formula <- function(data, ...) { UseMethod("epidist_formula") } -#' Define model specific family -#' -#' This function is used within [epidist()] to create a model specific custom -#' `brms` family object. This object is passed to `brms`. It is unlikely that -#' as a user you will need this function, but we export it nonetheless to be -#' transparent about what exactly is happening inside of a call to [epidist()]. -#' -#' @inheritParams epidist_validate -#' @param ... Additional arguments passed to method. -#' @family generics -#' @export -epidist_family <- function(data, ...) { - UseMethod("epidist_family") -} - #' Define model specific Stan code #' #' This function is used within [epidist()] to create any custom Stan code which diff --git a/R/latent_individual.R b/R/latent_individual.R index 9a4a2341e..614025f99 100644 --- a/R/latent_individual.R +++ b/R/latent_individual.R @@ -1,6 +1,6 @@ #' Prepare latent individual model #' -#' @param data Input data to be used for modelling. +#' @param data A `data.frame` containing line list data #' @family latent_individual #' @export as_latent_individual <- function(data) { @@ -104,46 +104,34 @@ is_latent_individual <- function(data) { inherits(data, "epidist_latent_individual") } -#' Check if data has the `epidist_latent_individual` class -#' -#' @param data A `data.frame` containing line list data -#' @param family Output of a call to `brms::brmsfamily()` -#' @param ... ... +#' Create the model-specific component of an `epidist` custom family #' -#' @method epidist_family epidist_latent_individual +#' @inheritParams epidist_family_model +#' @param ... Additional arguments passed to method. +#' @method epidist_family_model epidist_latent_individual #' @family latent_individual #' @export -epidist_family.epidist_latent_individual <- function(data, - family = "lognormal", - ...) { - epidist_validate(data) - # allows use of stats::family and strings - family <- brms:::validate_family(family) - non_mu_links <- family[[paste0("link_", setdiff(family$dpars, "mu"))]] - non_mu_bounds <- lapply( - family$dpars[-1], brms:::dpar_bounds, family = family$family - ) +epidist_family_model.epidist_latent_individual <- function( + data, family, ... +) { + # Really the name and vars are the "model-specific" parts here custom_family <- brms::custom_family( paste0("latent_", family$family), dpars = family$dpars, - links = c(family$link, non_mu_links), - lb = c(NA, as.numeric(lapply(non_mu_bounds, "[[", "lb"))), - ub = c(NA, as.numeric(lapply(non_mu_bounds, "[[", "ub"))), + links = c(family$link, family$other_links), + lb = c(NA, as.numeric(lapply(family$other_bounds, "[[", "lb"))), + ub = c(NA, as.numeric(lapply(family$other_bounds, "[[", "ub"))), type = family$type, vars = c("pwindow", "swindow", "vreal1"), loop = FALSE ) - reparam <- family$dpars - if (family$family == "gamma") { - reparam <- c("shape", "shape ./ mu") - } - custom_family$reparam <- reparam + custom_family$reparm <- family$reparm return(custom_family) } #' Define a formula for the latent_individual model #' -#' @param data ... +#' @param data A `data.frame` containing line list data #' @param family The output of [epidist_family()] #' @param formula As produced by [brms::brmsformula()] #' @param ... ... diff --git a/R/utils.R b/R/utils.R index df1b08f87..7e1787029 100644 --- a/R/utils.R +++ b/R/utils.R @@ -84,3 +84,21 @@ return(prior) } + +#' Additional distributional parameter information for `brms` families +#' +#' Includes additional information (link functions and parameter bound) about +#' the distributional parameters of a `brms` family which are not the +#' conditional mean `mu`. +#' +#' @inheritParams epidist_family +#' @keywords internal +.add_dpar_info <- function(family) { + other_links <- family[[paste0("link_", setdiff(family$dpars, "mu"))]] + other_bounds <- lapply( + family$dpars[-1], brms:::dpar_bounds, family = family$family + ) + family$other_links <- other_links + family$other_bounds <- other_bounds + return(family) +} diff --git a/_pkgdown.yml b/_pkgdown.yml index 9b22d1587..88bbede74 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -45,6 +45,10 @@ reference: desc: Default methods for S3 generics contents: - has_concept("defaults") +- title: Family + desc: Functions related to specifying custom `brms` families + contents: + - has_concept("family") - title: Priors desc: Functions for specifying prior distributions contents: diff --git a/man/as_latent_individual.Rd b/man/as_latent_individual.Rd index 1c4d097d0..390d531fb 100644 --- a/man/as_latent_individual.Rd +++ b/man/as_latent_individual.Rd @@ -24,13 +24,13 @@ model. } \seealso{ Other latent_individual: -\code{\link{epidist_family.epidist_latent_individual}()}, +\code{\link{epidist_family_model.epidist_latent_individual}()}, \code{\link{epidist_formula.epidist_latent_individual}()}, \code{\link{epidist_validate.epidist_latent_individual}()}, \code{\link{is_latent_individual}()} Other latent_individual: -\code{\link{epidist_family.epidist_latent_individual}()}, +\code{\link{epidist_family_model.epidist_latent_individual}()}, \code{\link{epidist_formula.epidist_latent_individual}()}, \code{\link{epidist_validate.epidist_latent_individual}()}, \code{\link{is_latent_individual}()} diff --git a/man/dot-add_dpar_info.Rd b/man/dot-add_dpar_info.Rd new file mode 100644 index 000000000..67e55077c --- /dev/null +++ b/man/dot-add_dpar_info.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{.add_dpar_info} +\alias{.add_dpar_info} +\title{Additional distributional parameter information for \code{brms} families} +\usage{ +.add_dpar_info(family) +} +\arguments{ +\item{family}{Output of a call to \code{brms::brmsfamily()}} +} +\description{ +Includes additional information (link functions and parameter bound) about +the distributional parameters of a \code{brms} family which are not the +conditional mean \code{mu}. +} +\keyword{internal} diff --git a/man/epidist.Rd b/man/epidist.Rd index 36660f726..2091924ef 100644 --- a/man/epidist.Rd +++ b/man/epidist.Rd @@ -7,7 +7,7 @@ epidist(data, formula, family, prior, backend, fn, ...) } \arguments{ -\item{data}{A \code{data.frame} to be used for modelling.} +\item{data}{A \code{data.frame} containing line list data.} \item{formula}{A formula object created using \code{brms::bf}. A formula must be provided for the distributional parameter \code{mu} common to all \code{brms} families. @@ -42,7 +42,6 @@ Fit epidemiological delay distributions using a \code{brms} interface } \seealso{ Other generics: -\code{\link{epidist_family}()}, \code{\link{epidist_formula}()}, \code{\link{epidist_stancode}()}, \code{\link{epidist_validate}()} diff --git a/man/epidist.default.Rd b/man/epidist.default.Rd index 2490d3e90..b154e4bb0 100644 --- a/man/epidist.default.Rd +++ b/man/epidist.default.Rd @@ -15,7 +15,7 @@ ) } \arguments{ -\item{data}{A \code{data.frame} to be used for modelling.} +\item{data}{A \code{data.frame} containing line list data.} \item{formula}{A formula object created using \code{brms::bf}. A formula must be provided for the distributional parameter \code{mu} common to all \code{brms} families. @@ -50,7 +50,6 @@ Default method used for interface using \code{brms} } \seealso{ Other defaults: -\code{\link{epidist_family.default}()}, \code{\link{epidist_formula.default}()}, \code{\link{epidist_stancode.default}()}, \code{\link{epidist_validate.default}()} diff --git a/man/epidist_family.Rd b/man/epidist_family.Rd index a0b25ad0d..8a1b177a4 100644 --- a/man/epidist_family.Rd +++ b/man/epidist_family.Rd @@ -1,27 +1,30 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/generics.R +% Please edit documentation in R/family.R \name{epidist_family} \alias{epidist_family} -\title{Define model specific family} +\title{Define \code{epidist} family} \usage{ -epidist_family(data, ...) +epidist_family(data, family = "lognormal", ...) } \arguments{ -\item{data}{A \code{data.frame} to be used for modelling.} +\item{data}{A \code{data.frame} containing line list data} -\item{...}{Additional arguments passed to method.} +\item{family}{Output of a call to \code{brms::brmsfamily()}} + +\item{...}{...} } \description{ This function is used within \code{\link[=epidist]{epidist()}} to create a model specific custom -\code{brms} family object. This object is passed to \code{brms}. It is unlikely that -as a user you will need this function, but we export it nonetheless to be -transparent about what exactly is happening inside of a call to \code{\link[=epidist]{epidist()}}. +\code{brms} family object. This custom family is passed to \code{brms}. It is unlikely +that as a user you will need this function, but we export it nonetheless to +be transparent about what happens inside of a call to \code{\link[=epidist]{epidist()}}. } \seealso{ -Other generics: -\code{\link{epidist}()}, -\code{\link{epidist_formula}()}, -\code{\link{epidist_stancode}()}, -\code{\link{epidist_validate}()} +Other family: +\code{\link{epidist_family_model}()}, +\code{\link{epidist_family_model.default}()}, +\code{\link{epidist_family_reparam}()}, +\code{\link{epidist_family_reparam.default}()}, +\code{\link{epidist_family_reparam.gamma}()} } -\concept{generics} +\concept{family} diff --git a/man/epidist_family.default.Rd b/man/epidist_family.default.Rd deleted file mode 100644 index 3e26190fb..000000000 --- a/man/epidist_family.default.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/defaults.R -\name{epidist_family.default} -\alias{epidist_family.default} -\title{Default method for defining a model specific family} -\usage{ -\method{epidist_family}{default}(data, ...) -} -\arguments{ -\item{data}{A \code{data.frame} to be used for modelling.} - -\item{...}{Additional arguments passed to method.} -} -\description{ -Default method for defining a model specific family -} -\seealso{ -Other defaults: -\code{\link{epidist.default}()}, -\code{\link{epidist_formula.default}()}, -\code{\link{epidist_stancode.default}()}, -\code{\link{epidist_validate.default}()} -} -\concept{defaults} diff --git a/man/epidist_family.epidist_latent_individual.Rd b/man/epidist_family.epidist_latent_individual.Rd deleted file mode 100644 index 61b49a7a1..000000000 --- a/man/epidist_family.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_family.epidist_latent_individual} -\alias{epidist_family.epidist_latent_individual} -\title{Check if data has the \code{epidist_latent_individual} class} -\usage{ -\method{epidist_family}{epidist_latent_individual}(data, family = "lognormal", ...) -} -\arguments{ -\item{data}{A \code{data.frame} containing line list data} - -\item{family}{Output of a call to \code{brms::brmsfamily()}} - -\item{...}{...} -} -\description{ -Check if data has the \code{epidist_latent_individual} class -} -\seealso{ -Other latent_individual: -\code{\link{as_latent_individual}()}, -\code{\link{epidist_formula.epidist_latent_individual}()}, -\code{\link{epidist_validate.epidist_latent_individual}()}, -\code{\link{is_latent_individual}()} -} -\concept{latent_individual} diff --git a/man/epidist_family_model.Rd b/man/epidist_family_model.Rd new file mode 100644 index 000000000..7547122be --- /dev/null +++ b/man/epidist_family_model.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/family.R +\name{epidist_family_model} +\alias{epidist_family_model} +\title{The model-specific parts of an \code{epidist_family()} call} +\usage{ +epidist_family_model(data, family, ...) +} +\arguments{ +\item{data}{A \code{data.frame} containing line list data} + +\item{family}{Output of a call to \code{brms::brmsfamily()} with additional +information as provided by \code{.add_dpar_info()}} + +\item{...}{Additional arguments passed to method.} +} +\description{ +The model-specific parts of an \code{epidist_family()} call +} +\seealso{ +Other family: +\code{\link{epidist_family}()}, +\code{\link{epidist_family_model.default}()}, +\code{\link{epidist_family_reparam}()}, +\code{\link{epidist_family_reparam.default}()}, +\code{\link{epidist_family_reparam.gamma}()} +} +\concept{family} diff --git a/man/epidist_family_model.default.Rd b/man/epidist_family_model.default.Rd new file mode 100644 index 000000000..2e341b84b --- /dev/null +++ b/man/epidist_family_model.default.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/family.R +\name{epidist_family_model.default} +\alias{epidist_family_model.default} +\title{Default method for defining a model specific family} +\usage{ +\method{epidist_family_model}{default}(data, ...) +} +\arguments{ +\item{data}{A \code{data.frame} containing line list data} + +\item{...}{Additional arguments passed to method.} +} +\description{ +Default method for defining a model specific family +} +\seealso{ +Other family: +\code{\link{epidist_family}()}, +\code{\link{epidist_family_model}()}, +\code{\link{epidist_family_reparam}()}, +\code{\link{epidist_family_reparam.default}()}, +\code{\link{epidist_family_reparam.gamma}()} +} +\concept{family} diff --git a/man/epidist_family_model.epidist_latent_individual.Rd b/man/epidist_family_model.epidist_latent_individual.Rd new file mode 100644 index 000000000..90463e47b --- /dev/null +++ b/man/epidist_family_model.epidist_latent_individual.Rd @@ -0,0 +1,27 @@ +% 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} +\title{Create the model-specific component of an \code{epidist} custom family} +\usage{ +\method{epidist_family_model}{epidist_latent_individual}(data, family, ...) +} +\arguments{ +\item{data}{A \code{data.frame} containing line list data} + +\item{family}{Output of a call to \code{brms::brmsfamily()} with additional +information as provided by \code{.add_dpar_info()}} + +\item{...}{Additional arguments passed to method.} +} +\description{ +Create the model-specific component of an \code{epidist} custom family +} +\seealso{ +Other latent_individual: +\code{\link{as_latent_individual}()}, +\code{\link{epidist_formula.epidist_latent_individual}()}, +\code{\link{epidist_validate.epidist_latent_individual}()}, +\code{\link{is_latent_individual}()} +} +\concept{latent_individual} diff --git a/man/epidist_family_reparam.Rd b/man/epidist_family_reparam.Rd new file mode 100644 index 000000000..2323f4d3d --- /dev/null +++ b/man/epidist_family_reparam.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/family.R +\name{epidist_family_reparam} +\alias{epidist_family_reparam} +\title{Reparameterise an \code{epidist} family to align \code{brms} and Stan} +\usage{ +epidist_family_reparam(family, ...) +} +\arguments{ +\item{family}{Output of a call to \code{brms::brmsfamily()}} + +\item{...}{Additional arguments passed to method.} +} +\description{ +Reparameterise an \code{epidist} family to align \code{brms} and Stan +} +\seealso{ +Other family: +\code{\link{epidist_family}()}, +\code{\link{epidist_family_model}()}, +\code{\link{epidist_family_model.default}()}, +\code{\link{epidist_family_reparam.default}()}, +\code{\link{epidist_family_reparam.gamma}()} +} +\concept{family} diff --git a/man/epidist_family_reparam.default.Rd b/man/epidist_family_reparam.default.Rd new file mode 100644 index 000000000..6791473dc --- /dev/null +++ b/man/epidist_family_reparam.default.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/family.R +\name{epidist_family_reparam.default} +\alias{epidist_family_reparam.default} +\title{Default method for families which do not require a reparameterisation} +\usage{ +\method{epidist_family_reparam}{default}(family, ...) +} +\arguments{ +\item{family}{Output of a call to \code{brms::brmsfamily()}} + +\item{...}{Additional arguments passed to method.} +} +\description{ +Default method for families which do not require a reparameterisation +} +\seealso{ +Other family: +\code{\link{epidist_family}()}, +\code{\link{epidist_family_model}()}, +\code{\link{epidist_family_model.default}()}, +\code{\link{epidist_family_reparam}()}, +\code{\link{epidist_family_reparam.gamma}()} +} +\concept{family} diff --git a/man/epidist_family_reparam.gamma.Rd b/man/epidist_family_reparam.gamma.Rd new file mode 100644 index 000000000..7d5fdc3d5 --- /dev/null +++ b/man/epidist_family_reparam.gamma.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/family.R +\name{epidist_family_reparam.gamma} +\alias{epidist_family_reparam.gamma} +\title{Reparameterisation for the gamma family} +\usage{ +\method{epidist_family_reparam}{gamma}(family, ...) +} +\arguments{ +\item{family}{Output of a call to \code{brms::brmsfamily()}} + +\item{...}{Additional arguments passed to method.} +} +\description{ +Reparameterisation for the gamma family +} +\seealso{ +Other family: +\code{\link{epidist_family}()}, +\code{\link{epidist_family_model}()}, +\code{\link{epidist_family_model.default}()}, +\code{\link{epidist_family_reparam}()}, +\code{\link{epidist_family_reparam.default}()} +} +\concept{family} diff --git a/man/epidist_formula.Rd b/man/epidist_formula.Rd index 19cadd60e..9b48ed1de 100644 --- a/man/epidist_formula.Rd +++ b/man/epidist_formula.Rd @@ -7,7 +7,7 @@ epidist_formula(data, ...) } \arguments{ -\item{data}{A \code{data.frame} to be used for modelling.} +\item{data}{A \code{data.frame} containing line list data.} \item{...}{Additional arguments passed to method.} } @@ -20,7 +20,6 @@ inside of a call to \code{\link[=epidist]{epidist()}}. \seealso{ Other generics: \code{\link{epidist}()}, -\code{\link{epidist_family}()}, \code{\link{epidist_stancode}()}, \code{\link{epidist_validate}()} } diff --git a/man/epidist_formula.default.Rd b/man/epidist_formula.default.Rd index 80f835c11..2bfc1847f 100644 --- a/man/epidist_formula.default.Rd +++ b/man/epidist_formula.default.Rd @@ -7,7 +7,7 @@ \method{epidist_formula}{default}(data, ...) } \arguments{ -\item{data}{A \code{data.frame} to be used for modelling.} +\item{data}{A \code{data.frame} containing line list data.} \item{...}{Additional arguments passed to method.} } @@ -17,7 +17,6 @@ Default method for defining a model specific formula \seealso{ Other defaults: \code{\link{epidist.default}()}, -\code{\link{epidist_family.default}()}, \code{\link{epidist_stancode.default}()}, \code{\link{epidist_validate.default}()} } diff --git a/man/epidist_formula.epidist_latent_individual.Rd b/man/epidist_formula.epidist_latent_individual.Rd index 818052280..657f56281 100644 --- a/man/epidist_formula.epidist_latent_individual.Rd +++ b/man/epidist_formula.epidist_latent_individual.Rd @@ -7,7 +7,7 @@ \method{epidist_formula}{epidist_latent_individual}(data, family, formula, ...) } \arguments{ -\item{data}{...} +\item{data}{A \code{data.frame} containing line list data} \item{family}{The output of \code{\link[=epidist_family]{epidist_family()}}} @@ -21,7 +21,7 @@ Define a formula for the latent_individual model \seealso{ Other latent_individual: \code{\link{as_latent_individual}()}, -\code{\link{epidist_family.epidist_latent_individual}()}, +\code{\link{epidist_family_model.epidist_latent_individual}()}, \code{\link{epidist_validate.epidist_latent_individual}()}, \code{\link{is_latent_individual}()} } diff --git a/man/epidist_stancode.Rd b/man/epidist_stancode.Rd index c6933d8fd..99ba71bfb 100644 --- a/man/epidist_stancode.Rd +++ b/man/epidist_stancode.Rd @@ -7,7 +7,7 @@ epidist_stancode(data, ...) } \arguments{ -\item{data}{A \code{data.frame} to be used for modelling.} +\item{data}{A \code{data.frame} containing line list data.} \item{...}{Additional arguments passed to method.} } @@ -20,7 +20,6 @@ transparent about what exactly is happening inside of a call to \code{\link[=epi \seealso{ Other generics: \code{\link{epidist}()}, -\code{\link{epidist_family}()}, \code{\link{epidist_formula}()}, \code{\link{epidist_validate}()} } diff --git a/man/epidist_stancode.default.Rd b/man/epidist_stancode.default.Rd index 26b64ba94..7ab658cce 100644 --- a/man/epidist_stancode.default.Rd +++ b/man/epidist_stancode.default.Rd @@ -7,7 +7,7 @@ \method{epidist_stancode}{default}(data, ...) } \arguments{ -\item{data}{A \code{data.frame} to be used for modelling.} +\item{data}{A \code{data.frame} containing line list data.} \item{...}{Additional arguments passed to method.} } @@ -17,7 +17,6 @@ Default method for defining model specific Stan code \seealso{ Other defaults: \code{\link{epidist.default}()}, -\code{\link{epidist_family.default}()}, \code{\link{epidist_formula.default}()}, \code{\link{epidist_validate.default}()} } diff --git a/man/epidist_validate.Rd b/man/epidist_validate.Rd index 6f4697bd6..0fae88662 100644 --- a/man/epidist_validate.Rd +++ b/man/epidist_validate.Rd @@ -7,7 +7,7 @@ epidist_validate(data) } \arguments{ -\item{data}{A \code{data.frame} to be used for modelling.} +\item{data}{A \code{data.frame} containing line list data.} } \description{ This function validates that the provided \code{data} is suitable to run a @@ -17,7 +17,6 @@ and that it contains suitable columns. \seealso{ Other generics: \code{\link{epidist}()}, -\code{\link{epidist_family}()}, \code{\link{epidist_formula}()}, \code{\link{epidist_stancode}()} } diff --git a/man/epidist_validate.default.Rd b/man/epidist_validate.default.Rd index 7149135bf..4eb615f97 100644 --- a/man/epidist_validate.default.Rd +++ b/man/epidist_validate.default.Rd @@ -7,7 +7,7 @@ \method{epidist_validate}{default}(data, ...) } \arguments{ -\item{data}{A \code{data.frame} to be used for modelling.} +\item{data}{A \code{data.frame} containing line list data.} \item{...}{Additional arguments passed to method.} } @@ -17,7 +17,6 @@ Default method for data validation \seealso{ Other defaults: \code{\link{epidist.default}()}, -\code{\link{epidist_family.default}()}, \code{\link{epidist_formula.default}()}, \code{\link{epidist_stancode.default}()} } diff --git a/man/epidist_validate.epidist_latent_individual.Rd b/man/epidist_validate.epidist_latent_individual.Rd index e29b63a74..d9cc9b4c4 100644 --- a/man/epidist_validate.epidist_latent_individual.Rd +++ b/man/epidist_validate.epidist_latent_individual.Rd @@ -18,7 +18,7 @@ running the latent individual model. As well as making sure that \seealso{ Other latent_individual: \code{\link{as_latent_individual}()}, -\code{\link{epidist_family.epidist_latent_individual}()}, +\code{\link{epidist_family_model.epidist_latent_individual}()}, \code{\link{epidist_formula.epidist_latent_individual}()}, \code{\link{is_latent_individual}()} } diff --git a/man/is_latent_individual.Rd b/man/is_latent_individual.Rd index 0240eadb5..968da890a 100644 --- a/man/is_latent_individual.Rd +++ b/man/is_latent_individual.Rd @@ -15,7 +15,7 @@ Check if data has the \code{epidist_latent_individual} class \seealso{ Other latent_individual: \code{\link{as_latent_individual}()}, -\code{\link{epidist_family.epidist_latent_individual}()}, +\code{\link{epidist_family_model.epidist_latent_individual}()}, \code{\link{epidist_formula.epidist_latent_individual}()}, \code{\link{epidist_validate.epidist_latent_individual}()} } diff --git a/tests/testthat/test-family.R b/tests/testthat/test-family.R new file mode 100644 index 000000000..0da6ae838 --- /dev/null +++ b/tests/testthat/test-family.R @@ -0,0 +1,30 @@ +prep_obs <- as_latent_individual(sim_obs) +prep_obs_gamma <- as_latent_individual(sim_obs_gamma) + +test_that("epidist_family with default settings produces an object of the right class", { # nolint: line_length_linter. + family <- epidist_family(prep_obs) + expect_s3_class(family, "customfamily") + expect_s3_class(family, "brmsfamily") + expect_s3_class(family, "family") +}) + +test_that("epidist_family gives an error when passed inappropriate family input", { # nolint: line_length_linter. + expect_error(epidist_family(prep_obs, family = 1)) + expect_error(epidist_family(prep_obs, family = list())) +}) + +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()) + expect_equal(family_lognormal$name, "latent_lognormal") + family_gamma <- epidist_family(prep_obs, family = Gamma(link = "log")) + expect_equal(family_gamma$name, "latent_gamma") + string_lognormal <- epidist_family(prep_obs, family = "lognormal") + expect_equal(string_lognormal$name, "latent_lognormal") +}) + +test_that("epidist_family contains the correct reparameterisations for lognormal (no change) and gamma (a change)", { # nolint: line_length_linter. + family_lognormal <- epidist_family(prep_obs, family = "lognormal") + expect_equal(family_lognormal$reparam, c("mu", "sigma")) + family_gamma <- epidist_family(prep_obs, family = Gamma(link = "log")) + expect_equal(family_gamma$reparam, c("shape", "shape ./ mu")) +}) diff --git a/tests/testthat/test-latent_individual.R b/tests/testthat/test-latent_individual.R index 59e7991e0..aafa4494b 100644 --- a/tests/testthat/test-latent_individual.R +++ b/tests/testthat/test-latent_individual.R @@ -55,27 +55,6 @@ test_that("epidist_validate.epidist_latent_individual returns FALSE for incorrec }) }) -test_that("epidist_family.epidist_latent_individual with default settings produces an object of the right class", { # nolint: line_length_linter. - family <- epidist_family(prep_obs) - expect_s3_class(family, "customfamily") - expect_s3_class(family, "brmsfamily") - expect_s3_class(family, "family") -}) - -test_that("epidist_family.epidist_latent_individual gives an error when passed inappropriate family input", { # nolint: line_length_linter. - expect_error(epidist_family(prep_obs, family = 1)) - expect_error(epidist_family(prep_obs, family = list())) -}) - -test_that("the family argument in epidist_family.epidist_latent_individual 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()) - expect_equal(family_lognormal$name, "latent_lognormal") - family_gamma <- epidist_family(prep_obs, family = Gamma(link = "log")) - expect_equal(family_gamma$name, "latent_gamma") - string_lognormal <- epidist_family(prep_obs, family = "lognormal") - expect_equal(string_lognormal$name, "latent_lognormal") -}) - test_that("epidist_formula.epidist_latent_individual with default settings produces a brmsformula with the correct intercept only formula", { # nolint: line_length_linter. form <- epidist_formula( prep_obs, family = family_lognormal, formula = brms::bf(mu ~ 1, sigma ~ 1) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 88fdee43b..c8591c5a4 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -25,3 +25,12 @@ test_that(".replace_prior errors when passed a new prior without a match in old_ brms::prior("normal(0, 5)", class = "Intercept", dpar = "shape") expect_error(.replace_prior(old_prior, new_prior)) }) + +test_that(".add_dpar_info works as expected for the lognormal and gamma families", { # nolint: line_length_linter. + lognormal_extra <- .add_dpar_info(brms::lognormal()) + expect_equal(lognormal_extra$other_links, "log") + expect_equal(lognormal_extra$other_bounds, list(list("lb" = "0", ub = ""))) + gamma_extra <- .add_dpar_info(brms:::validate_family(stats::Gamma())) + expect_equal(gamma_extra$other_links, NULL) + expect_equal(gamma_extra$other_bounds, list(list("lb" = "0", ub = ""))) +})