diff --git a/R/latent_individual.R b/R/latent_individual.R index 614025f99..7928e9bab 100644 --- a/R/latent_individual.R +++ b/R/latent_individual.R @@ -142,7 +142,7 @@ epidist_formula.epidist_latent_individual <- function(data, family, formula, ...) { epidist_validate(data) formula <- brms:::validate_formula(formula, data = data, family = family) - + formula <- .make_intercepts_explicit(formula) formula <- stats::update( formula, delay | vreal(relative_obs_time, pwindow, swindow) ~ . ) diff --git a/R/prior.R b/R/prior.R index 85ee15086..c4ff2175b 100644 --- a/R/prior.R +++ b/R/prior.R @@ -90,18 +90,13 @@ epidist_family_prior.default <- function(family, formula, ...) { #' @export epidist_family_prior.lognormal <- function(family, formula, ...) { prior <- prior("normal(1, 1)", class = "Intercept") - if ("sigma" %in% names(formula$pforms)) { - # Case with a model on sigma - sigma_prior <- prior( - "normal(-0.7, 0.4)", class = "Intercept", dpar = "sigma" - ) - } else if ("sigma" %in% names(formula$pfix)) { + if ("sigma" %in% names(formula$pfix)) { # Case with sigma fixed to a constant sigma_prior <- NULL } else { - # Case with no model on sigma + # Case with a model on sigma sigma_prior <- prior( - "lognormal(-0.7, 0.4)", class = "sigma", lb = 0, ub = "NA" + "normal(-0.7, 0.4)", class = "Intercept", dpar = "sigma" ) } prior <- prior + sigma_prior diff --git a/R/utils.R b/R/utils.R index 7e1787029..05dd76ce8 100644 --- a/R/utils.R +++ b/R/utils.R @@ -102,3 +102,23 @@ family$other_bounds <- other_bounds return(family) } + +#' Include implicit intercepts in `brms` formula as explicit +#' +#' This function detects the distributional parameters in a `brms` formula +#' object, and alters to formula to include explicit intercept parameters for +#' them i.e. `~ 1`. +#' +#' @param formula ... +#' @keywords internal +.make_intercepts_explicit <- function(formula) { + other_dpars <- setdiff(formula$family$dpars, "mu") + fixed_dpars <- names(formula$pfix) + formula_dpars <- names(formula$pforms) + replace_dpars <- setdiff(other_dpars, c(fixed_dpars, formula_dpars)) + for (dpar in replace_dpars) { + new_formula <- as.formula(paste0(dpar, " ~ 1")) + formula$pforms[[dpar]] <- new_formula + } + return(formula) +} diff --git a/man/dot-make_intercepts_explicit.Rd b/man/dot-make_intercepts_explicit.Rd new file mode 100644 index 000000000..aff519a70 --- /dev/null +++ b/man/dot-make_intercepts_explicit.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{.make_intercepts_explicit} +\alias{.make_intercepts_explicit} +\title{Include implicit intercepts in \code{brms} formula as explicit} +\usage{ +.make_intercepts_explicit(formula) +} +\arguments{ +\item{formula}{...} +} +\description{ +This function detects the distributional parameters in a \code{brms} formula +object, and alters to formula to include explicit intercept parameters for +them i.e. \code{~ 1}. +} +\keyword{internal} diff --git a/tests/testthat/test-int-latent_individual.R b/tests/testthat/test-int-latent_individual.R index d1d533ccd..e33ccbd4a 100644 --- a/tests/testthat/test-int-latent_individual.R +++ b/tests/testthat/test-int-latent_individual.R @@ -58,7 +58,7 @@ test_that("epidist.epidist_latent_individual samples from the prior according to param1 <- extract_normal_parameters_brms(epidist_prior[1, ]) param2 <- extract_normal_parameters_brms(epidist_prior[2, ]) samples1 <- rnorm(1000, mean = param1$mean, sd = param1$sd) - samples2 <- exp(rnorm(1000, mean = param2$mean, sd = param2$sd)) + samples2 <- rnorm(1000, mean = param2$mean, sd = param2$sd) # suppressWarnings here used to prevent warnings about ties ks1 <- suppressWarnings(stats::ks.test(pred$mu, samples1)) ks2 <- suppressWarnings(stats::ks.test(pred$sigma, samples2)) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index c8591c5a4..c39a3c38b 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -34,3 +34,36 @@ test_that(".add_dpar_info works as expected for the lognormal and gamma families expect_equal(gamma_extra$other_links, NULL) expect_equal(gamma_extra$other_bounds, list(list("lb" = "0", ub = ""))) }) + +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) + epidist_family <- epidist_family(prep_obs, family = "lognormal") + formula <- brms:::validate_formula( + formula = brms::bf(mu ~ 1), + data = prep_obs, + family = epidist_family + ) + formula <- .make_intercepts_explicit(formula) + formula_explicit <- brms:::validate_formula( + formula = brms::bf(mu ~ 1, sigma ~ 1), + data = prep_obs, + family = epidist_family + ) + attr(formula$pforms$sigma, ".Environment") <- NULL + attr(formula_explicit$pforms$sigma, ".Environment") <- NULL + expect_equal(formula, formula_explicit) +}) + +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) + epidist_family <- epidist_family(prep_obs, family = "lognormal") + formula <- brms:::validate_formula( + formula = brms::bf(mu ~ 1, sigma = 1), + data = prep_obs, + family = epidist_family + ) + formula_updated <- .make_intercepts_explicit(formula) + attr(formula$pforms$sigma, ".Environment") <- NULL + attr(formula_updated$pforms$sigma, ".Environment") <- NULL + expect_equal(formula, formula_updated) +})