tests/testthat/test-Mods.R

In DoseFinding: Planning and Analyzing Dose Finding Experiments

test_that("Mods function requires dose levels", {
  expect_error(Mods(linear = NULL), "Need to specify dose levels")
})

test_that("Mods function ensures dose levels include placebo and are non-negative", {
  expect_error(Mods(linear = NULL, doses = c(0.05, 0.2)), "Need to include placebo dose")
  expect_error(Mods(linear = NULL, doses = c(-0.05, 0, 0.2)), "Only dose-levels >= 0 allowed")
})

test_that("Mods function checks addArgs parameters for validity", {
  expect_error(Mods(linear = NULL, doses = c(0, 0.05, 0.2), addArgs = list(scal = 0.1, off = 0.01)), 
               "\"scal\" parameter needs to be ")
  expect_error(Mods(linear = NULL, doses = c(0, 0.05, 0.2), addArgs = list(scal = 1.2, off = -0.1)), 
               "\"off\" parameter needs to be positive")
})

test_that("Mods function generates an object of class Mods", {
  models <- Mods(linear = NULL, emax = 0.05, doses = c(0, 0.05, 0.2, 0.6, 1), addArgs = list(scal = 1.2, off = 0.1))
  expect_s3_class(models, "Mods")
  expect_true(!is.null(attr(models, "placEff")))
  expect_true(!is.null(attr(models, "maxEff")))
  expect_true(!is.null(attr(models, "direction")))
  expect_true(!is.null(attr(models, "doses")))
  expect_true(!is.null(attr(models, "scal")))
  expect_true(!is.null(attr(models, "off")))
})

test_that("Mods function calculates responses correctly", {
  doses <- c(0, 10, 25, 50, 100, 150)
  fmodels <- Mods(linear = NULL, emax = 25, 
                  logistic = c(50, 10.88111), exponential = 85, 
                  betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), 
                  linInt = rbind(c(0, 1, 1, 1, 1), c(0, 0, 1, 1, 0.8)), 
                  doses = doses, placEff = 0.5, maxEff = -0.4, 
                  addArgs = list(scal = 200))
  responses <- getResp(fmodels, doses)
  expect_equal(nrow(responses), length(doses))
})

test_that("Mods function can specify all model parameters (fullMod = TRUE)", {
  fmods <- Mods(emax = c(0, 1, 0.1), linear = cbind(c(-0.4, 0), c(0.2, 0.1)), 
                sigEmax = c(0, 1.1, 0.5, 3), 
                doses = 0:4, fullMod = TRUE)
  responses <- getResp(fmods, doses = seq(0, 4, length = 11))
  expect_equal(nrow(responses), 11)
  expect_equal(ncol(responses), length(attr(fmods, "maxEff")))
})


## test plotting functions
test_that("plotMods function basic functionality", {
  models <- Mods(linear = NULL, emax = 0.05, doses = c(0, 0.05, 0.2, 0.6, 1), 
                 addArgs = list(scal = 1.2, off = 0.1))
  p <- plotMods(models)
  
  expect_s3_class(p, "ggplot")
  expect_true("GeomLine" %in% sapply(p$layers, function(layer) class(layer$geom)[1]))
  expect_true("GeomPoint" %in% sapply(p$layers, function(layer) class(layer$geom)[1]))
  
  p_superpose <- plotMods(models, superpose = TRUE)
  expect_s3_class(p_superpose, "ggplot")
  expect_true("GeomLine" %in% sapply(p_superpose$layers, function(layer) class(layer$geom)[1]))
})

test_that("plot.Mods function basic functionality", {
  models <- Mods(linear = NULL, emax = 0.05, doses = c(0, 0.05, 0.2, 0.6, 1), 
                 addArgs = list(scal = 1.2, off = 0.1))
  
  p <- plot(models)
  
  expect_s3_class(p, "trellis")
})

test_that("plotMods handles customizations correctly", {
  models <- Mods(linear = NULL, emax = 0.05, doses = c(0, 0.05, 0.2, 0.6, 1), 
                 addArgs = list(scal = 1.2, off = 0.1))
  
  p_custom <- plotMods(models, xlab = "Custom X Label", ylab = "Custom Y Label")
  
  expect_s3_class(p_custom, "ggplot")
  expect_equal(p_custom$labels$x, "Custom X Label")
  expect_equal(p_custom$labels$y, "Custom Y Label")
})

test_that("plot.Mods handles customizations correctly", {
  models <- Mods(linear = NULL, emax = 0.05, doses = c(0, 0.05, 0.2, 0.6, 1), 
                 addArgs = list(scal = 1.2, off = 0.1))
  
  p_custom <- plot(models, lwd = 3, pch = 3, cex = 1.2, col = "red")
  
  expect_s3_class(p_custom, "trellis")
})

#########################
## tests for ED and TD
#########################
data(biom)
modlist <- Mods(emax = 0.05, linear = NULL, logistic = c(0.5, 0.1),
                linInt = c(0, 0.5, 1, 1), doses = c(0, 0.05, 0.2, 0.6, 1))
## produce first stage fit (using dose as factor)
anMod <- lm(resp~factor(dose)-1, data=biom)
drFit <- coef(anMod)
S <- vcov(anMod)
dose <- sort(unique(biom$dose))
mod_dr <- fitMod(dose, drFit, S = S, type = "general", model = "emax",  bnds = c(0.01, 4))
prior <- list(norm = c(0, 10), norm = c(0,100), beta=c(0,1.5,0.45,1.7))
mod_bfit <- bFitMod(dose, drFit, S, model = "emax", 
                    start = c(0, 1, 0.1), nSim = 1000, prior = prior)
mod_maFit <- maFitMod(dose, drFit, S, model = c("emax", "sigEmax"), nSim = 10)

test_that("TD errors with type discrete if incorrect dose-range supplied", {
  expect_error(TD(modlist, Delta=0.3, TDtype = "discrete", doses=dose[-1]), "need placebo dose for TD calculation")
  expect_error(TD(mod_dr, Delta=0.3, TDtype = "discrete", doses=dose[-1]), "need placebo dose for TD calculation")
  expect_error(TD(mod_bfit, Delta=0.3, TDtype = "discrete", doses=dose[-1]), "need placebo dose for TD calculation")
  expect_error(TD(mod_maFit, Delta=0.3, TDtype = "discrete", doses=dose[-1]), "need placebo dose for TD calculation")
  
  expect_error(TD(modlist, Delta=0.3, TDtype = "discrete", doses=c(dose, 2)), "Doses provided may not exceed the observed dose range")
  expect_error(TD(mod_dr, Delta=0.3, TDtype = "discrete", doses=c(dose, 2)), "Doses provided may not exceed the observed dose range")
  expect_error(TD(mod_bfit, Delta=0.3, TDtype = "discrete", doses=c(dose, 2)), "Doses provided may not exceed the observed dose range")
  expect_error(TD(mod_maFit, Delta=0.3, TDtype = "discrete", doses=c(dose, 2)), "Doses provided may not exceed the observed dose range")
  
  
})

test_that("TD gives consistent results for discrete and continuous type", {
  td1a <- TD(modlist, Delta=0.3, TDtype = "discrete", doses=seq(0, max(dose), 0.002))
  td1b <- TD(modlist, Delta=0.3, TDtype = "discrete", doses=seq(0, max(dose) - 0.1, 0.002))
  td2 <- TD(modlist, Delta=0.3, TDtype = "continuous")
  
  expect_equal(td1a, td2, tolerance = 0.01)
  expect_equal(td1b, td2, tolerance = 0.01)
  
  td1a <- TD(mod_dr, Delta=0.3, TDtype = "discrete", doses=seq(0, max(dose), 0.002))
  td1b <- TD(mod_dr, Delta=0.3, TDtype = "discrete", doses=seq(0, max(dose) - 0.1, 0.002))
  td2 <- TD(mod_dr, Delta=0.3, TDtype = "continuous")
  expect_equal(td1a, td2, tolerance = 0.01)
  expect_equal(td1b, td2, tolerance = 0.01)
  
  td1a <- median(TD(mod_bfit, Delta=0.3, TDtype = "discrete", doses=seq(0, max(dose), 0.002)))
  td1b <- median(TD(mod_bfit, Delta=0.3, TDtype = "discrete", doses=seq(0, max(dose) - 0.1, 0.002)))
  td2 <- median(TD(mod_bfit, Delta=0.3, TDtype = "continuous"))
  expect_equal(td1a, td2, tolerance = 0.01)
  expect_equal(td1b, td2, tolerance = 0.01)
  
  td1a <- TD(mod_maFit, Delta=0.3, TDtype = "discrete", doses=seq(0, max(dose), 0.002))
  td1b <- TD(mod_maFit, Delta=0.3, TDtype = "discrete", doses=seq(0, max(dose) - 0.1, 0.002))
  td2 <- TD(mod_maFit, Delta=0.3, TDtype = "continuous")
  expect_equal(td1a, td2, tolerance = 0.01)
  expect_equal(td1b, td2, tolerance = 0.01)
  
})


test_that("ED errors with type discrete if incorrect dose-range supplied", {
  expect_error(ED(modlist, p=0.9, EDtype = "discrete", doses=dose[-1]), "need placebo dose for ED calculation")
  expect_error(ED(mod_dr, p=0.9, EDtype = "discrete", doses=dose[-1]), "need placebo dose for ED calculation")
  expect_error(ED(mod_bfit, p=0.9, EDtype = "discrete", doses=dose[-1]), "need placebo dose for ED calculation")
  expect_error(ED(mod_maFit, p=0.9, EDtype = "discrete", doses=dose[-1]), "need placebo dose for ED calculation")
  
  expect_error(ED(modlist, p=0.9, EDtype = "discrete", doses=c(dose, 2)), "Doses provided may not exceed the observed dose range")
  expect_error(ED(mod_dr, p=0.9, EDtype = "discrete", doses=c(dose, 2)), "Doses provided may not exceed the observed dose range")
  expect_error(ED(mod_bfit, p=0.9, EDtype = "discrete", doses=c(dose, 2)), "Doses provided may not exceed the observed dose range")
  expect_error(ED(mod_maFit, p=0.9, EDtype = "discrete", doses=c(dose, 2)), "Doses provided may not exceed the observed dose range")
  
  
})

test_that("ED gives consistent results for discrete and continuous type", {
  ed1a <- ED(modlist, p=0.9, EDtype = "discrete", doses=seq(0, max(dose), 0.002))
  ed1b <- ED(modlist, p=0.9, EDtype = "discrete", doses=seq(0, max(dose) - 0.05, 0.002))
  ed2 <- ED(modlist, p=0.9, EDtype = "continuous")
  expect_equal(ed1a, ed1b)
  expect_equal(ed1a, ed2, tolerance = 0.01)
  expect_equal(ed1b, ed2, tolerance = 0.01)
  
  ed1a <- ED(mod_dr, p=0.9, EDtype = "discrete", doses=seq(0, max(dose), 0.002))
  ed1b <- ED(mod_dr, p=0.9, EDtype = "discrete", doses=seq(0, max(dose) - 0.05, 0.002))
  ed2 <- ED(mod_dr, p=0.9, EDtype = "continuous")
  expect_equal(ed1a, ed1b)
  expect_equal(ed1a, ed2, tolerance = 0.01)
  expect_equal(ed1b, ed2, tolerance = 0.01)
  
  ed1a <- median(ED(mod_bfit, p=0.9, EDtype = "discrete", doses=seq(0, max(dose), 0.002)))
  ed1b <- median(ED(mod_bfit, p=0.9, EDtype = "discrete", doses=seq(0, max(dose) - 0.05, 0.002)))
  ed2 <- median(ED(mod_bfit, p=0.9, EDtype = "continuous"))
  expect_equal(ed1a, ed1b)
  expect_equal(ed1a, ed2, tolerance = 0.01)
  expect_equal(ed1b, ed2, tolerance = 0.01)
  
  ed1a <- ED(mod_maFit, p=0.9, EDtype = "discrete", doses=seq(0, max(dose), 0.002), direction = "increasing")
  ed1b <- ED(mod_maFit, p=0.9, EDtype = "discrete", doses=seq(0, max(dose) - 0.05, 0.002), direction = "increasing")
  ed2 <- ED(mod_maFit, p=0.9, EDtype = "continuous", direction = "increasing")
  expect_equal(ed1a, ed1b)
  expect_equal(ed1a, ed2, tolerance = 0.01)
  expect_equal(ed1b, ed2, tolerance = 0.01)
  
})