tests/testthat/test-initializers.R

In pcvr: Plant Phenotyping and Bayesian Statistics

if (!interactive()) {
  pdf(NULL)
}

test_that("double sigmoid models warn about starting values", {
  df <- data.frame(y = 1, time = 1, id = 1, group = 1)
  expect_warning(
    ss <- suppressMessages(
      .nlrqSS(
        model = "double logistic", form = y ~ time | id / group,
        tau = 0.5, df = df, start = NULL
      )
    )
  )
})

test_that("init logistic works", {
  df <- growthSim("logistic",
    n = 20, t = 25,
    params = list("A" = c(180), "B" = c(10), "C" = c(3))
  )
  expect_equal(names(.initlogistic(df, "time", "y", FALSE)), c("A", "B", "C"))
  expect_equal(names(.initlogistic(df, "time", "y", TRUE)), c("I", "A", "B", "C"))
  expect_error(.initlogistic(df[1:3, ], "time", "y", FALSE))
})

test_that("init gompertz works", {
  df <- growthSim("gompertz",
    n = 20, t = 25,
    params = list("A" = c(180), "B" = c(10), "C" = c(0.25))
  )
  expect_equal(names(.initgompertz(df, "time", "y", FALSE)), c("A", "B", "C"))
  expect_equal(names(.initgompertz(df, "time", "y", TRUE)), c("I", "A", "B", "C"))
  expect_error(.initgompertz(df[1:3, ], "time", "y", FALSE))
})

test_that("init frechet works", {
  df <- growthSim("frechet",
    n = 20, t = 25,
    params = list("A" = c(180), "B" = c(3), "C" = c(3))
  )
  expect_equal(names(.initfrechet(df, "time", "y", FALSE)), c("A", "B", "C"))
  expect_equal(names(.initfrechet(df, "time", "y", TRUE)), c("I", "A", "B", "C"))
  expect_error(.initfrechet(df[1:3, ], "time", "y", FALSE))
})

test_that("init gumbel works", {
  df <- growthSim("gumbel",
    n = 20, t = 25,
    params = list("A" = c(180), "B" = c(3), "C" = c(3))
  )
  expect_equal(names(.initgumbel(df, "time", "y", FALSE)), c("A", "B", "C"))
  expect_equal(names(.initgumbel(df, "time", "y", TRUE)), c("I", "A", "B", "C"))
  expect_error(.initgumbel(df[1:3, ], "time", "y", FALSE))
})

test_that("init weibull works", {
  df <- growthSim("weibull",
    n = 20, t = 25,
    params = list("A" = c(180), "B" = c(3), "C" = c(3))
  )
  expect_equal(names(.initweibull(df, "time", "y", FALSE)), c("A", "B", "C"))
  expect_equal(names(.initweibull(df, "time", "y", TRUE)), c("I", "A", "B", "C"))
  expect_error(.initweibull(df[1:3, ], "time", "y", FALSE))
})

test_that("init monomolecular works", {
  df <- growthSim("monomolecular",
    n = 20, t = 25,
    params = list("A" = c(100), "B" = c(0.2))
  )
  expect_equal(names(.initmonomolecular(df, "time", "y", FALSE)), c("A", "B"))
  expect_equal(names(.initmonomolecular(df, "time", "y", TRUE)), c("I", "A", "B"))
  expect_error(.initmonomolecular(df[1:3, ], "time", "y", FALSE))
})

test_that("init power law works", {
  df <- growthSim("power law",
    n = 20, t = 25,
    params = list("A" = c(1), "B" = c(1))
  )
  expect_equal(names(.initpowerlaw(df, "time", "y", FALSE)), c("A", "B"))
  expect_equal(names(.initpowerlaw(df, "time", "y", TRUE)), c("I", "A", "B"))
  expect_error(.initpowerlaw(df[1:2, ], "time", "y", FALSE))
})

test_that("init exponential works", {
  df <- growthSim("exponential",
    n = 20, t = 25,
    params = list("A" = c(1), "B" = c(0.2))
  )
  expect_equal(names(.initexponential(df, "time", "y", FALSE)), c("A", "B"))
  expect_equal(names(.initexponential(df, "time", "y", TRUE)), c("I", "A", "B"))
  expect_error(.initexponential(df[1:2, ], "time", "y", FALSE))
})

test_that("init logarithmic works", {
  set.seed(123)
  df <- growthSim("logarithmic",
    n = 20, t = 25,
    params = list("A" = c(15, 15))
  )
  expect_equal(names(.initlogarithmic(df, "time", "y", FALSE)), c("A"))
  expect_equal(names(.initlogarithmic(df, "time", "y", TRUE)), c("I", "A"))
  expect_error(.initlogarithmic(df[1, ], "time", "y", FALSE))
})

test_that("init linear works", {
  set.seed(123)
  df <- growthSim("linear",
    n = 20, t = 25,
    params = list("A" = c(15, 15))
  )
  expect_equal(names(.initlinear(df, "time", "y", FALSE)), c("A"))
  expect_equal(names(.initlinear(df, "time", "y", TRUE)), c("I", "A"))
  expect_error(.initlinear(df[1, ], "time", "y", FALSE))
})

test_that("init bragg works", {
  set.seed(123)
  df <- growthSim("bragg",
    n = 20, t = 100,
    list("A" = c(10, 15), "B" = c(0.01, 0.02), "C" = c(50, 60))
  )
  expect_equal(names(.initbragg(df, "time", "y", FALSE)), c("B", "A", "C"))
  expect_equal(names(.initbragg(df, "time", "y", TRUE)), c("I", "B", "A", "C"))
})

test_that("init lorentz works", {
  set.seed(123)
  df <- growthSim("lorentz",
    n = 20, t = 25,
    params = list("A" = c(10, 15), "B" = c(0.01, 0.02), "C" = c(50, 60))
  )
  expect_equal(names(.initlorentz(df, "time", "y", FALSE)), c("B", "A", "C"))
  expect_equal(names(.initlorentz(df, "time", "y", TRUE)), c("I", "B", "A", "C"))
})

test_that("init beta works", {
  set.seed(123)
  df <- growthSim("beta",
    n = 20, t = 25,
    params = list("A" = 10, "B" = 1.2, "C" = 15, "D" = 8, "E" = 19)
  )
  expect_equal(names(.initbeta(df, "time", "y", FALSE)), c("A", "B", "C", "D", "E"))
  expect_equal(names(.initbeta(df, "time", "y", TRUE)), c("I", "A", "B", "C", "D", "E"))
})

test_that("double logistic form works", {
  out <- .nlrq_form_doublelogistic(
    x = "x", y = "y", USEGROUP = TRUE,
    group = "group", pars = "A", int = FALSE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("A"))
  out <- .nlrq_form_doublelogistic(
    x = "x", y = "y", USEGROUP = FALSE,
    group = NULL, pars = NULL, int = TRUE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("I", "A", "B", "C", "A2", "B2", "C2"))
})

test_that("double gompertz form works", {
  out <- .nlrq_form_doublegompertz(
    x = "x", y = "y", USEGROUP = TRUE,
    group = "group", pars = "A", int = FALSE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("A"))
  out <- .nlrq_form_doublegompertz(
    x = "x", y = "y", USEGROUP = FALSE,
    group = NULL, pars = NULL, int = TRUE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("I", "A", "B", "C", "A2", "B2", "C2"))
})

test_that("logistic form works", {
  out <- .nlrq_form_logistic(
    x = "x", y = "y", USEGROUP = TRUE,
    group = "group", pars = "A", int = FALSE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("A"))
  out <- .nlrq_form_logistic(
    x = "x", y = "y", USEGROUP = FALSE,
    group = NULL, pars = NULL, int = TRUE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("I", "A", "B", "C"))
})

test_that("gompertz form works", {
  out <- .nlrq_form_gompertz(
    x = "x", y = "y", USEGROUP = TRUE,
    group = "group", pars = "A", int = FALSE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("A"))
  out <- .nlrq_form_gompertz(
    x = "x", y = "y", USEGROUP = FALSE,
    group = NULL, pars = NULL, int = TRUE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("I", "A", "B", "C"))
})

test_that("weibull form works", {
  out <- .nlrq_form_weibull(
    x = "x", y = "y", USEGROUP = TRUE,
    group = "group", pars = "A", int = FALSE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("A"))
  out <- .nlrq_form_weibull(
    x = "x", y = "y", USEGROUP = FALSE,
    group = NULL, pars = NULL, int = TRUE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("I", "A", "B", "C"))
})

test_that("frechet form works", {
  out <- .nlrq_form_frechet(
    x = "x", y = "y", USEGROUP = TRUE,
    group = "group", pars = "A", int = FALSE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("A"))
  out <- .nlrq_form_frechet(
    x = "x", y = "y", USEGROUP = FALSE,
    group = NULL, pars = NULL, int = TRUE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("I", "A", "B", "C"))
})

test_that("gumbel form works", {
  out <- .nlrq_form_gumbel(
    x = "x", y = "y", USEGROUP = TRUE,
    group = "group", pars = "A", int = FALSE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("A"))
  out <- .nlrq_form_gumbel(
    x = "x", y = "y", USEGROUP = FALSE,
    group = NULL, pars = NULL, int = TRUE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("I", "A", "B", "C"))
})

test_that("monomolecular form works", {
  out <- .nlrq_form_monomolecular(
    x = "x", y = "y", USEGROUP = TRUE,
    group = "group", pars = "A", int = FALSE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("A"))
  out <- .nlrq_form_monomolecular(
    x = "x", y = "y", USEGROUP = FALSE,
    group = NULL, pars = NULL, int = TRUE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("I", "A", "B"))
})

test_that("exponential form works", {
  out <- .nlrq_form_exponential(
    x = "x", y = "y", USEGROUP = TRUE,
    group = "group", pars = "A", int = FALSE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("A"))
  out <- .nlrq_form_exponential(
    x = "x", y = "y", USEGROUP = FALSE,
    group = NULL, pars = NULL, int = TRUE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("I", "A", "B"))
})

test_that("power law form works", {
  out <- .nlrq_form_powerlaw(
    x = "x", y = "y", USEGROUP = TRUE,
    group = "group", pars = "A", int = FALSE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("A"))
  out <- .nlrq_form_powerlaw(
    x = "x", y = "y", USEGROUP = FALSE,
    group = NULL, pars = NULL, int = TRUE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("I", "A", "B"))
})

test_that("logarithmic form works", {
  out <- .nlrq_form_logarithmic(
    x = "x", y = "y", USEGROUP = TRUE,
    group = "group", pars = NULL, int = FALSE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("A"))
  out <- .nlrq_form_logarithmic(
    x = "x", y = "y", USEGROUP = TRUE,
    group = "group", pars = "I", int = TRUE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("I"))
  out <- .nlrq_form_logarithmic(
    x = "x", y = "y", USEGROUP = FALSE,
    group = NULL, pars = "I", int = TRUE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("I"))
})

test_that("linear form works", {
  out <- .nlrq_form_linear(
    x = "x", y = "y", USEGROUP = TRUE,
    group = "group", pars = NULL, int = FALSE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("A"))
  out <- .nlrq_form_linear(
    x = "x", y = "y", USEGROUP = TRUE,
    group = "group", pars = "I", int = TRUE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("I"))
  out <- .nlrq_form_linear(
    x = "x", y = "y", USEGROUP = FALSE,
    group = NULL, pars = "I", int = TRUE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("I"))
})

test_that("gam form works", {
  out <- .nlrq_form_gam(
    x = "x", y = "y", USEGROUP = TRUE,
    group = "group", pars = NULL, int = FALSE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_null(out$pars)
  out <- .nlrq_form_gam(
    x = "x", y = "y", USEGROUP = FALSE,
    group = NULL, pars = NULL, int = TRUE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_null(out$pars)
})

test_that("bragg form works", {
  out <- .nlrq_form_bragg(
    x = "x", y = "y", USEGROUP = TRUE,
    group = "group", pars = "A", int = FALSE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("A"))
  out <- .nlrq_form_bragg(
    x = "x", y = "y", USEGROUP = FALSE,
    group = NULL, pars = NULL, int = TRUE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("I", "A", "B", "C"))
})

test_that("lorentz form works", {
  out <- .nlrq_form_lorentz(
    x = "x", y = "y", USEGROUP = TRUE,
    group = "group", pars = "A", int = FALSE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("A"))
  out <- .nlrq_form_lorentz(
    x = "x", y = "y", USEGROUP = FALSE,
    group = NULL, pars = NULL, int = TRUE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("I", "A", "B", "C"))
})

test_that("beta form works", {
  out <- .nlrq_form_beta(
    x = "x", y = "y", USEGROUP = TRUE,
    group = "group", pars = "A", int = FALSE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("A"))
  out <- .nlrq_form_beta(
    x = "x", y = "y", USEGROUP = FALSE,
    group = NULL, pars = NULL, int = TRUE
  )
  expect_equal(names(out), c("formula", "pars"))
  expect_equal(out$pars, c("I", "A", "B", "C", "D", "E"))
})