tests/testthat/dummy.R

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

# Dummy scenario class used for unit testing without the need to do actual
# time-consuming simulations
setClass("DummyScenario", contains=c("EffectScenario","Transferable"),
  slots=list(
    fx="ANY",
    simulate="ANY",
    solver="ANY"
  ),
  prototype=list(
    fx=NULL,
    simulate=NULL,
    solver=data.frame(time=0:10, A=1, B=2),

    name="DummyScenario",
    param=list(baz=42),
    param.req=c("baz"),
    param.bounds=list(baz=c(0, 1)),
    init=c(A=1, B=2),
    times=0:10,
    endpoints=c("foo"),
    exposure=ExposureSeries(data.frame(t=0, c=1)),
    control.req=FALSE
  )
)

# Mock results from [solver()]
setMethod("solver", "DummyScenario", function(scenario, ...) solver_dummy(scenario, ...))
solver_dummy <- function(scenario, ...) {
  x <- scenario@solver
  if(is.function(x))
    return(x(scenario, ...))
  if(is.data.frame(x))
    return(x)
  stop("invalid return type for dummy solver")
}

# Mock results from [simulate()]
setMethod("simulate", "DummyScenario", function(x, ...) simulate_dummy(scenario=x, ...))
simulate_dummy <- function(scenario, ...) {
  x <- scenario@simulate
  if(is.null(x))
    return(simulate_scenario(scenario, ...))
  if(is.function(x))
    return(x(scenario, ...))
  if(is.data.frame(x))
    return(x)
  stop("invalid return type for dummy simulation")
}

# Mock results from [fx()]
setMethod("fx", "DummyScenario", function(scenario, ...) fx_dummy(scenario, ...))
fx_dummy <- function(scenario, ...) {
  x <- scenario@fx
  if(is.function(x))
    return(x(scenario, ...))
  if(is.numeric(x))
    return(x)
  stop("invalid return type for dummy fx")
}