Merge pull request #15 from openpharma/13-increase-test-coverage

13 increase test coverage

NAMESPACE

@@ -49,6 +49,7 @@ S3method(gAIC, DRMod)
 S3method(predict, bFitMod)
 S3method(plot, bFitMod)
 S3method(print, bFitMod)
+S3method(coef, bFitMod)
 
 S3method(plot, targN)
 

tests/testthat/test-DesignMCPModApp.R

@@ -0,0 +1,4 @@
+
+test_that("DesignMCPModApp works", {
+  expect_no_error(DesignMCPModApp())
+})

tests/testthat/test-MCPMod.R

@@ -0,0 +1,38 @@
+
+# Generating test data
+data(biom)
+models <- Mods(linear = NULL, emax=c(0.05,0.2), linInt=c(1, 1, 1, 1), doses=c(0,0.05,0.2,0.6,1))
+MM <- MCPMod(dose, resp, biom, models, Delta=0.5)
+
+test_that("MCPMod object can be printed", {
+  expect_output(print(MM), "MCPMod\\n")
+  expect_output(print(MM), "Multiple Contrast Test:\\n")
+  expect_output(print(MM), "Estimated Dose Response Models:")
+})
+
+test_that("summary.MCPMod summarizes and prints an MCPMod object", {
+  expect_output( summary(MM), "MCP part \\n")
+  expect_output( summary(MM), "Mod part \\n")
+  expect_output( summary(MM), "Model selection criteria \\(AIC\\):")
+  expect_output( summary(MM), "Estimated TD\\, Delta=0\\.5\\n")
+})
+
+test_that("plot.MCPMod plots the fitted dose-response model", {
+  expect_silent(plot(MM, plotData = "meansCI"))
+  expect_silent(plot(MM, plotData = "means"))
+  expect_silent(plot(MM, plotData = "raw"))
+  expect_silent(plot(MM, plotData = "none"))
+})
+
+test_that("predict.MCPMod provides predictions from the fitted dose-response model", {
+  pred <- predict(MM, se.fit = TRUE, doseSeq = c(0,0.2,0.4, 0.9, 1), predType="ls-means")
+  expect_true(is.list(pred))
+  expect_true(is.list(pred[[1]]))  # Ensure each model provides a list
+})
+
+test_that("plot.MCPMod stops with appropriate error when no models significant", {
+  # Create a scenario where no models are significant
+  models_no_sig <- Mods(linear = NULL, doses=c(0,0.05,0.2,0.6,1))
+  MM_no_sig <- MCPMod(dose, resp, biom, models_no_sig, Delta=0.5, critV = 9999)
+  expect_error(plot(MM_no_sig))
+})

tests/testthat/test-Mods.R

@@ -0,0 +1,92 @@
+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/testthat/test-bFitMod.R

@@ -0,0 +1,109 @@
+# Setting up some test data
+doses <- c(0, 0.5, 1, 2, 4)
+drFit <- c(1, 2, 3, 4, 5)  # Example response
+S <- diag(5)  # Covariance matrix for simplicity
+
+test_that("bFitMod errors with invalid inputs", {
+  expect_error(bFitMod(dose = doses, resp = drFit, model = "invalidModel", S = S), 
+               "invalid model selected")
+  expect_error(bFitMod(dose = doses, resp = drFit[1:4], model = "linear", S = S), 
+               "dose and resp need to be of the same size")
+  expect_error(bFitMod(dose = doses, resp = drFit, model = "linear", S = diag(4)), 
+               "S and dose have non-conforming size")
+})
+
+
+test_that("bFitMod correctly fits a 'linear' model with Bayes", {
+  prior <- list(norm = c(0, 10), norm = c(0, 100))
+  fit <- bFitMod(dose = doses, resp = drFit, model = "linear", S = S, 
+                 type = "Bayes", nSim = 100, prior = prior)
+  expect_s3_class(fit, "bFitMod")
+  expect_equal(attr(fit, "model"), "linear")
+  expect_equal(attr(fit, "type"), "Bayes")
+  expect_true(!is.null(fit$samples))
+})
+
+test_that("bFitMod correctly fits a 'linear' model with bootstrap", {
+  fit <- bFitMod(dose = doses, resp = drFit, model = "linear", S = S, 
+                 type = "bootstrap", nSim = 100)
+  expect_s3_class(fit, "bFitMod")
+  expect_equal(attr(fit, "model"), "linear")
+  expect_equal(attr(fit, "type"), "bootstrap")
+  expect_true(!is.null(fit$samples))
+})
+
+test_that("print.bFitMod does not throw an error", {
+  prior <- list(norm = c(0, 10), norm = c(0, 100))
+  fit <- bFitMod(dose = doses, resp = drFit, model = "linear", S = S, 
+                 type = "Bayes", nSim = 100, prior = prior)
+
+  expect_output(print(fit), regexp = "Dose Response Model")
+  expect_output(print(fit), regexp = "Summary of posterior draws")
+})
+
+test_that("bFitMod handles placebo adjustment appropriately", {
+  prior <- list(norm = c(0, 10), norm = c(0, 100))
+  expect_error(bFitMod(dose = doses, resp = drFit, model = "linlog", S = S, 
+                       placAdj = TRUE, type = "Bayes", nSim = 100, prior = prior),
+               "logistic and linlog models can only be fitted with placAdj")
+})
+
+test_that("bFitMod correctly handles 'linInt' model", {
+  fit <- bFitMod(dose = doses, resp = drFit, model = "linInt", S = S, 
+                 type = "bootstrap", nSim = 100)
+  expect_s3_class(fit, "bFitMod")
+  expect_equal(attr(fit, "model"), "linInt")
+  expect_true(!is.null(attr(fit, "nodes")))
+  expect_true(!is.null(fit$samples))
+})
+
+test_that("bFitMod correctly handles additional arguments", {
+  prior <- list(norm = c(0, 10), norm = c(0, 100), beta=c(0, 1.5, 0.45, 1.7), beta=c(0, 1.5, 0.45, 1.7))
+  fit <- bFitMod(dose = doses, resp = drFit, model = "betaMod", S = S, 
+                 type = "Bayes", nSim = 100, prior = prior, 
+                 addArgs = list(scal = 1.2*max(doses)))
+  expect_s3_class(fit, "bFitMod")
+  expect_equal(attr(fit, "model"), "betaMod")
+  expect_equal(attr(fit, "scal"), 1.2 * max(doses))
+  expect_true(!is.null(fit$samples))
+})
+
+# Assuming the `biom` dataset is available in the environment for examples
+data(biom)
+anMod <- lm(resp ~ factor(dose) - 1, data = biom)
+drFit <- coef(anMod)
+S <- vcov(anMod)
+dose <- sort(unique(biom$dose))
+
+# Assuming normal priors for test example
+prior <- list(norm = c(0, 10), norm = c(0, 100), beta = c(0, 1.5, 0.45, 1.7))
+
+# Fit a model
+gsample <- bFitMod(dose, drFit, S, model = "emax", start = c(0, 1, 0.1), nSim = 1000, prior = prior)
+
+test_that("predict.bFitMod returns correct quantiles", {
+  doseSeq <- c(0, 0.5, 1)
+  pred <- predict(gsample, doseSeq = doseSeq)
+  expect_true(is.matrix(pred))
+  expect_equal(nrow(pred), 5)  # Expecting rows for different quantiles
+  expect_equal(length(unique(doseSeq)), ncol(pred))  # One column per dose in doseSeq
+})
+
+test_that("plot.bFitMod generates a plot", {
+  expect_error(plot(gsample), NA)
+  # Check for plotting is a little tricky, one way to check if some plot is generated
+  expect_true(is.null(dev.list()) || length(dev.list()) > 0)
+})
+
+test_that("coef.bFitMod returns model coefficients", {
+  coefs <- coef(gsample)
+  expect_true(is.numeric(coefs))
+  expect_equal(length(coefs), length(gsample$samples))
+})
+
+# To ensure the appropriate methods are defined, use methods(...) to list them:
+test_that("appropriate methods for bFitMod are defined", {
+  expect_true("predict.bFitMod" %in% methods("predict"))
+  expect_true("plot.bFitMod" %in% methods("plot"))
+  expect_true("coef.bFitMod" %in% methods("coef"))
+})

tests/testthat/test-guesst.R

@@ -70,3 +70,32 @@ test_that("sigEmax local", {
                tolerance = 0.001)
 })
 
+
+## test error conditions
+
+
+test_that("Error conditions for guesst function", {
+
+  # Test for invalid percentage values (negative or greater than 1)
+  expect_error(guesst(d = 0.5, p = -0.2, model = "emax"), "must have 0 < p <= 1")
+  expect_error(guesst(d = 0.5, p = 1.2, model = "emax"), "must have 0 < p <= 1")
+
+  # Test for logistic model needing at least two pairs
+  expect_error(guesst(d = 0.2, p = 0.5, model = "logistic"), "logistic model needs at least two pairs")
+
+  # Test for local version of emax with p <= d/Maxd
+  expect_error(guesst(d = 0.3, p = 0.2, model = "emax", local = TRUE, Maxd = 1), "must have p > d/Maxd, for local version")
+
+  # Test for exponential model needing p < d/Maxd
+  expect_error(guesst(d = 0.8, p = 0.9, model = "exponential", Maxd = 1), "must have p < d/Maxd")
+
+  # Test for betaMod model needing scal > dMax
+  expect_error(guesst(d = 0.4, p = 0.8, model = "betaMod", dMax = 0.8, scal = 0.8, Maxd = 1), "scal needs to be larger than dMax to calculate guesstimate")
+
+  # Test for betaMod model needing dMax <= Maxd
+  expect_error(guesst(d = 0.4, p = 0.8, model = "betaMod", dMax = 1.2, scal = 1.5, Maxd = 1), "dose with maximum effect \\(dMax\\) needs to be smaller than maximum dose \\(Maxd\\)")
+
+  # Test for sigmoid Emax model needing at least two pairs
+  expect_error(guesst(d = 0.2, p = 0.5, model = "sigEmax"), "sigmoid Emax model needs at least two pairs")
+
+})

tests/testthat/test-optContr.R

@@ -135,3 +135,88 @@ calculate optimal contrasts for this shape.")
   expect_message(optContr(modlist2, w=1, doses=c(0, 0.05, 0.5), placAdj=FALSE, type = "c"), "The linInt2 model has a constant shape, cannot
 calculate optimal contrasts for this shape.")
 })
+
+test_that("optContr errors when invalid inputs are provided", {
+  expect_error(optContr(models = list(), doses = c(0, 10), w = c(1, 1)),
+               "models needs to be of class Mods")
+  models <- Mods(linear = NULL, emax = 25, direction = c("increasing", "decreasing"), doses = c(0, 10))
+  models <- Mods(linear = NULL, doses = c(0, 10))
+  expect_error(optContr(models, doses = c(0, 10)),
+               "Need to specify exactly one of \"w\" or \"S\"")
+  expect_error(optContr(models, doses = c(0, 10), w = c(1, 1), S = diag(2)),
+               "Need to specify exactly one of \"w\" or \"S\"")
+  expect_error(optContr(models, doses = c(0, 10), w = c(1, 1), placAdj = TRUE),
+               "If placAdj == TRUE there should be no placebo group in \"doses\"")
+  expect_error(optContr(models, doses = c(0, 10), w = c(1, 1, 1)),
+               "w needs to be of length 1 or of the same length as doses")
+  expect_error(optContr(models, doses = c(0, 10), S = c(1, 1)),
+               "S needs to be a matrix")
+})
+
+models <- Mods(linear = NULL, doses = c(0, 10))
+
+test_that("print.optContr prints contrast matrix", {
+  contMat <- optContr(models, doses = c(0, 10), w = c(1, 1))
+  expect_output(print(contMat), "Optimal contrasts\n.*")
+})
+
+test_that("summary.optContr summarizes and prints an optContr object", {
+  contMat <- optContr(models, doses = c(0, 10), w = c(1, 1))
+  expect_output(summary(contMat), "Optimal contrasts\n.*")
+  expect_output(summary(contMat), "Contrast Correlation Matrix:.*")
+})
+
+test_that("plot.optContr plots contrast coefficients", {
+  contMat <- optContr(models, doses = c(0, 10), w = c(1, 1))
+  expect_silent(plot(contMat, plotType = "contrasts"))
+  expect_silent(plot(contMat, plotType = "means"))
+})
+
+test_that("plotContr creates a ggplot object for the contrast coefficients", {
+  contMat <- optContr(models, doses = c(0, 10), w = c(1, 1))
+  expect_s3_class(plotContr(contMat), "ggplot")
+})
+
+test_that("plotContr creates a ggplot object with the correct data", {
+  contMat <- optContr(models, doses = c(0, 10), w = c(1, 1))
+  plot <- plotContr(contMat)
+
+  # Ensure all dose levels are present in the plot
+  expect_true(all(levels(as.factor(plot$data$dose)) %in% c(0, 10)))
+  # Ensure all models are present in the plot
+  expect_true(all(levels(as.factor(plot$data$model)) %in% c("linear")))
+  # Check y-axis label
+  expect_equal(plot$labels$y, "Contrast coefficients")
+  # Check x-axis label
+  expect_equal(plot$labels$x, "Dose")
+})
+
+test_that("lattice plot for optContr with superpose options works correctly", {
+  contMat <- optContr(models, doses = c(0, 10), w = c(1, 1))
+  expect_no_error(plot(contMat, plotType = "contrasts", superpose = TRUE))
+})
+
+test_that("lattice plot for optContr without superpose options works correctly", {
+  contMat <- optContr(models, doses = c(0, 10), w = c(1, 1))
+  expect_no_error(plot(contMat, plotType = "contrasts", superpose = FALSE))
+})
+
+# Additional test to ensure plotContr produces the correct ggplot2 plot
+test_that("plotContr returns a ggplot2 plot with correct elements", {
+  models <- Mods(linear = NULL, doses = c(0, 10, 25, 50, 100, 150))
+  contMat <- optContr(models, doses = c(0, 10, 25, 50, 100, 150), w = rep(50, 6))
+  p <- plotContr(contMat)
+  expect_s3_class(p, "ggplot")
+  expect_equal(p$theme$legend.position, "top")
+})
+
+# Additional test to ensure plot.optContr correctly sets y-axis labels
+test_that("plot.optContr sets correct y-axis labels", {
+  contMat <- optContr(models, doses = c(0, 10), w = c(1, 1))
+
+  p1 <- plot(contMat, plotType = "contrasts", ylab = "Contrast coefficients")
+  expect_equal(p1$ylab, "Contrast coefficients")
+
+  p2 <- plot(contMat, plotType = "means", ylab = "Normalized model means")
+  expect_equal(p2$ylab, "Normalized model means")
+})