tests/testthat/test-brmSSHelpers.R

In pcvr: Plant Phenotyping and Bayesian Statistics

library(testthat)
library(pcvr)

test_that("prior specification in brmSSHelpers works for all inputs", {
  set.seed(123)
  simdf <- growthSim(
    "logistic",
    n = 20, t = 25,
    params = list("A" = c(200, 160), "B" = c(13, 11), "C" = c(3, 3.5))
  )
  ss <- growthSS(
    model = "logistic", form = y ~ time | id / group, sigma = "gam",
    start = NULL,
    df = simdf, type = "brms"
  )
  expect_s3_class(ss$prior, "brmsprior")
  ss <- growthSS(
    model = "logistic", form = y ~ time | id / group, sigma = "gam",
    start = brms::set_prior("normal(0, 10)"),
    df = simdf, type = "brms"
  )
  expect_s3_class(ss$prior, "brmsprior")
  expect_warning(
    ss <- growthSS(
      model = "logistic", form = y ~ time | id / group, sigma = "gam",
      start = c(200, 10, 3),
      df = simdf, type = "brms"
    )
  )
  expect_s3_class(ss$prior, "brmsprior")
  expect_error(
    ss <- growthSS(
      model = "logistic", form = y ~ time | id / group, sigma = "gam",
      start = c(200, 10),
      df = simdf, type = "brms"
    )
  )
  ss <- growthSS(
    model = "logistic", form = y ~ time | id / group, sigma = "gam",
    list("A" = c(130, 120), "B" = c(11, 10), "C" = c(3, 5)),
    df = simdf, type = "brms"
  )
  expect_s3_class(ss$prior, "brmsprior")
  expect_warning(
    ss <- growthSS(
      model = "logistic", form = y ~ time | id / group, sigma = "gam",
      list(c(130, 120), c(11, 10), c(3, 5)),
      df = simdf, type = "brms"
    )
  )
  expect_s3_class(ss$prior, "brmsprior")
  expect_warning(
    out <- .makePriors(
      priors = list("A" = 100, "B" = 1),
      pars = c("A", "B", "C"), df = data.frame(group = "a"), group = "group", USEGROUP = TRUE,
      sigma = NULL, family = "student", formula = y ~ x
    )
  )
  expect_s3_class(out, "brmsprior")
})

test_that("sigma helper works", {
  test1 <- .sigmaHelper(
    sigma = y ~ x,
    dpars = c("sigma", "nu"),
    family = "student",
    models = NULL
  )
  expect_equal(names(test1), c("sigma", "nu"))
  expect_error(
    .sigmaHelper(
      sigma = c("linear", "linear", "linear"),
      dpars = c("sigma", "nu"),
      family = "student"
    )
  )
})

test_that("brms form logistic works", {
  out <- .brms_form_logistic(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out), c("form", "pars"))
  out <- .brms_form_logistic(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out), c("form", "pars"))
  out2 <- .brms_form_logistic(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out2), c("form", "pars"))
  out2 <- .brms_form_logistic(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out2), c("form", "pars"))
})

test_that("brms form gompertz works", {
  out <- .brms_form_gompertz(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out), c("form", "pars"))
  out <- .brms_form_gompertz(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out), c("form", "pars"))
  out2 <- .brms_form_gompertz(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out2), c("form", "pars"))
  out2 <- .brms_form_gompertz(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out2), c("form", "pars"))
})

test_that("brms form gumbel works", {
  out <- .brms_form_gumbel(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out), c("form", "pars"))
  out <- .brms_form_gumbel(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out), c("form", "pars"))
  out2 <- .brms_form_gumbel(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out2), c("form", "pars"))
  out2 <- .brms_form_gumbel(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out2), c("form", "pars"))
})

test_that("brms form frechet works", {
  out <- .brms_form_frechet(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out), c("form", "pars"))
  out <- .brms_form_frechet(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out), c("form", "pars"))
  out2 <- .brms_form_frechet(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out2), c("form", "pars"))
  out2 <- .brms_form_frechet(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out2), c("form", "pars"))
})

test_that("brms form weibull works", {
  out <- .brms_form_weibull(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out), c("form", "pars"))
  out <- .brms_form_weibull(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out), c("form", "pars"))
  out2 <- .brms_form_weibull(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out2), c("form", "pars"))
  out2 <- .brms_form_weibull(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out2), c("form", "pars"))
})

test_that("brms form double logistic works", {
  out <- .brms_form_doublelogistic(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out), c("form", "pars"))
  out <- .brms_form_doublelogistic(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out), c("form", "pars"))
  out2 <- .brms_form_doublelogistic(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out2), c("form", "pars"))
  out2 <- .brms_form_doublelogistic(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out2), c("form", "pars"))
})

test_that("brms form double gompertz works", {
  out <- .brms_form_doublegompertz(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out), c("form", "pars"))
  out <- .brms_form_doublegompertz(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out), c("form", "pars"))
  out2 <- .brms_form_doublegompertz(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out2), c("form", "pars"))
  out2 <- .brms_form_doublegompertz(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out2), c("form", "pars"))
})

test_that("brms form monomolecular works", {
  out <- .brms_form_monomolecular(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out), c("form", "pars"))
  out <- .brms_form_monomolecular(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out), c("form", "pars"))
  out2 <- .brms_form_monomolecular(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out2), c("form", "pars"))
  out2 <- .brms_form_monomolecular(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out2), c("form", "pars"))
})

test_that("brms form exponential works", {
  out <- .brms_form_exponential(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out), c("form", "pars"))
  out <- .brms_form_exponential(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out), c("form", "pars"))
  out2 <- .brms_form_exponential(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out2), c("form", "pars"))
  out2 <- .brms_form_exponential(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out2), c("form", "pars"))
})

test_that("brms form power law works", {
  out <- .brms_form_powerlaw(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out), c("form", "pars"))
  out <- .brms_form_powerlaw(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out), c("form", "pars"))
  out2 <- .brms_form_powerlaw(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out2), c("form", "pars"))
  out2 <- .brms_form_powerlaw(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out2), c("form", "pars"))
})

test_that("brms form linear works", {
  out <- .brms_form_linear(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out), c("form", "pars"))
  out <- .brms_form_linear(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out), c("form", "pars"))
  out2 <- .brms_form_linear(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out2), c("form", "pars"))
  out2 <- .brms_form_linear(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out2), c("form", "pars"))
  out3 <- .brms_form_linear(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = list("sigmaA" = 1), int = FALSE
  )
  expect_equal(names(out3), c("form", "pars"))
})

test_that("brms form logarithmic works", {
  out <- .brms_form_logarithmic(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out), c("form", "pars"))
  out <- .brms_form_logarithmic(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out), c("form", "pars"))
  out2 <- .brms_form_logarithmic(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out2), c("form", "pars"))
  out2 <- .brms_form_logarithmic(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out2), c("form", "pars"))
})

test_that("brms form gam works", {
  out <- .brms_form_gam(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = 25, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out), c("form", "pars"))
  out <- .brms_form_gam(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = 5, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out), c("form", "pars"))
  out2 <- .brms_form_gam(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = 25, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out2), c("form", "pars"))
  out2 <- .brms_form_gam(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = 5, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out2), c("form", "pars"))
})

test_that("brms form bragg works", {
  out <- .brms_form_bragg(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out), c("form", "pars"))
  out <- .brms_form_bragg(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out), c("form", "pars"))
  out2 <- .brms_form_bragg(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out2), c("form", "pars"))
  out2 <- .brms_form_bragg(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out2), c("form", "pars"))
})

test_that("brms form lorentz works", {
  out <- .brms_form_lorentz(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out), c("form", "pars"))
  out <- .brms_form_lorentz(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out), c("form", "pars"))
  out2 <- .brms_form_lorentz(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out2), c("form", "pars"))
  out2 <- .brms_form_lorentz(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out2), c("form", "pars"))
})

test_that("brms form beta works", {
  out <- .brms_form_beta(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out), c("form", "pars"))
  out <- .brms_form_beta(
    x = "x", y = "y", group = "group",
    dpar = FALSE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out), c("form", "pars"))
  out2 <- .brms_form_beta(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = FALSE
  )
  expect_equal(names(out2), c("form", "pars"))
  out2 <- .brms_form_beta(
    x = "x", y = "sigma", group = "group",
    dpar = TRUE, nTimes = NULL, useGroup = TRUE,
    prior = NULL, int = TRUE
  )
  expect_equal(names(out2), c("form", "pars"))
})

test_that("decay works with intercept model", {
  formList <- list("form" = y ~ I + A * x)
  out <- .brms_form_decay(formList, int = TRUE)
  expect_equal(as.character(out$form), as.character(y ~ I - (A * x)))
})