tests/testthat/test-solver.R

In cvasi: Calibration, Validation, and Simulation of TKTD Models

test_that("GUTS-RED solver", {
  # IT model
  expect_equal(solver(minnow_it)$time, minnow_it@times)
  expect_equal(solver(minnow_it, times=0:2)$time, 0:2)
  # SD model
  expect_equal(solver(minnow_it)$time, minnow_it@times)
  expect_equal(solver(minnow_it, times=0:2)$time, 0:2)
})

test_that("Lemna solver", {
  # Schmitt model
  expect_equal(solver(metsulfuron)$time, metsulfuron@times)
  expect_equal(solver(metsulfuron, times=0:2)$time, 0:2)

  # Schmitt Threshold model
  Lemna_SchmittThold() %>%
    set_init(metsulfuron@init) %>%
    set_param(metsulfuron@param) %>%
    set_param(c("threshold"=2)) %>%
    set_forcings(metsulfuron@forcings) %>%
    set_exposure(metsulfuron@exposure@series) -> sc
  expect_equal(solver(sc)$time, sc@times)
  expect_equal(solver(sc, times=0:2)$time, 0:2)

  # SETAC model
  focusd1 %>% set_times(0:10) -> sc
  expect_equal(solver(sc)$time, sc@times)
  expect_equal(solver(sc, times=0:2)$time, 0:2)
})

test_that("Myrio simulation", {
  nms <- intersect(Myrio()@param.req, names(focusd1@param))

  # set up a Myriophyllum scenario with Lemna parameters for testing purposes
  Myrio() %>%
    set_init(focusd1@init) %>%
    set_param(focusd1@param[nms]) %>%
    set_param(c("r_DW_TSL"=focusd1@param$r_DW_FN)) %>%
    set_exposure(focusd1@exposure@series) %>%
    set_times(0:20) -> sc

  focusd1 %>%
    set_param(c("k_photo_fixed"=1,"k_loss"=0)) %>%
    set_times(0:20) -> orig

  # equal results if all else is identical
  expect_equal(solver(sc)$TSL, solver(orig)$FrondNo)
  # check that TSL scales with r_DW_TSL
  r_DW_TSL <- focusd1@param$r_DW_FN * 10
  set_param(sc, c("r_DW_TSL"=r_DW_TSL)) -> sc
  expect_equal(solver(sc)$TSL, solver(orig)$FrondNo/10)

  # Myriophyllum  with logistic growth
  Myrio_log() %>%
    set_all(sc) %>%
    set_param(c("BM_L"=focusd1@param$BM_L,"r_DW_TSL"=focusd1@param$r_DW_FN)) %>%
    solver(nout=7) -> out_log
  # we should have almost reached the density limit
  expect_equal(tail(out_log$BM, 1), focusd1@param$BM_L, tolerance=0.1)
  # dBM should decrease continuously because initial state is above 50% of BM_L
  expect_true(all(out_log$dBM > 0))
  expect_true(all(out_log$BM == sort(out_log$BM)))

  # error if r_DW_TSL is missing
  sc@param$r_DW_TSL <- NULL
  expect_error(solver(sc), regexp="missing.*r_DW_TSL")
})


test_that("Custom solver", {
  my_ode <- function(t, state, params) {
    list(c(1)) # dummy ODE, constant derivative == linear growth
  }
  my_solver <- function(scenario, times, ...) {
    deSolve::ode(y=scenario@init, times=scenario@times, func=my_ode, ...)
  }

  setClass("test_model", contains="EffectScenario")
  setMethod("solver", "test_model", function(scenario, times, ...) my_solver(scenario, times, ...))
  on.exit(removeMethod("solver", "test_model"))
  on.exit(removeClass("test_model"))

  rs1 <- deSolve::ode(y=c(X=3), times=0:10, func=my_ode)
  rs2 <- new("test_model") %>%
    set_init(c(X=3)) %>%
    set_times(0:10) %>%
    simulate()

  expect_equal(rs2, rs2, tolerance=1e-6)
})

# TODO DEB* models