#30 Create Unit Tests with Example Data

DESCRIPTION

@@ -34,20 +34,21 @@ Imports:
     graphics,
     grDevices,
     sqldf,
-	dplyr,
-	tidyr,
-	plotly,
-	tcplfit2,
-	ggplot2,
-	gridExtra,
-	stringr
+    dplyr,
+    tidyr,
+    plotly,
+    tcplfit2,
+    ggplot2,
+    gridExtra,
+    stringr,
+    vdiffr
 Suggests:
     roxygen2,
     knitr,
     prettydoc,
     rmarkdown,
     htmlTable,
-    testthat (>= 2.1.0),
+    testthat (>= 3.0.0),
     reshape2,
     viridis,
     kableExtra,
@@ -58,3 +59,4 @@ LazyData: true
 RoxygenNote: 7.2.3
 VignetteBuilder: knitr
 Encoding: UTF-8
+Config/testthat/edition: 3

R/tcplLoadData.R

@@ -101,12 +101,20 @@ tcplLoadData <- function(lvl, fld = NULL, val = NULL, type = "mc", add.fld = TRU
         sc1 <- sc1[,c("s0id","s1id","spid","acid","aeid","apid","rowi","coli","wllt","logc","resp")]
         return(sc1)
       }
+
       else if (lvl == 2L) {
         sc2 <- sc_vignette[["sc2"]]
         sc2 <- sc2[,c("s2id", "spid", "aeid", "bmad", "max_med", "hitc", "coff")]
         return(sc2)
-      } 
-      else stop("example tables for sc0, sc1, sc2 available.")
+        }
+      else if (lvl == "agg") {
+        sc1 <- sc_vignette[["sc1"]]
+        sc2 <- sc_vignette[["sc2"]]
+        agg <- sc1[sc2, on = c("spid","aeid")]
+        agg <- agg[,c("aeid","s2id","s1id","s0id","logc","resp")]
+        return(agg)
+      }
+      else stop("example tables for sc0, sc1, sc2, agg available.")
     }
 
     if (type == "mc" ) {
@@ -152,8 +160,18 @@ tcplLoadData <- function(lvl, fld = NULL, val = NULL, type = "mc", add.fld = TRU
         }
         return(mc5)
       }
-      else stop("example tables for mc0, mc1, mc2, mc3, mc4, mc5 available.")
+      else if (lvl == "agg") {
+        mc3 <- mc_vignette[["mc3"]]
+        mc4 <- mc_vignette[["mc4"]]
+        agg <- mc3[mc4, on = c("spid","aeid")]
+        agg <- agg[, c("aeid", "m4id", "m3id", "m2id", "m1id", "m0id", "spid", "logc", "resp")]
+        return(agg)
+
+      }
+      else stop("example tables for mc0, mc1, mc2, mc3, mc4, mc5, agg available.")
     }
+
+    else stop("Invalid 'lvl' and 'type' combination.")
   }
 
   if (drvr != "example"){

R/tcplPlot.R

@@ -622,7 +622,7 @@ tcplggplot <- function(dat, lvl = 5, verbose = FALSE) {
     geom_vline(aes(xintercept = dat$ac50, color = "AC50", linetype = "AC50")) +
     geom_segment(aes(x=dat$bmd, xend=dat$bmd, y=-Inf, yend=dat$bmr, color = "BMD", linetype = "BMD")) +
     geom_hline(aes(yintercept = dat$coff, color = "Cutoff", linetype = "Cutoff")) +
-    geom_segment(aes(x=0, xend=dat$bmd, y = dat$bmr, yend=dat$bmr, color = "BMD", linetype = "BMD")) +
+    geom_segment(x=-Inf, aes(xend=dat$bmd, y = dat$bmr, yend=dat$bmr, color = "BMD", linetype = "BMD")) +
     geom_point() +
     scale_x_continuous(limits = l3_range, trans = "log10") +
     scale_color_viridis_d("", direction = -1, guide = guide_legend(reverse = TRUE, order = 2), end = 0.9) +

tests/testthat.R

@@ -1,3 +1,11 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/tests.html
+# * https://testthat.r-lib.org/reference/test_package.html#special-files
+
 library(testthat)
 library(tcpl)
 

tests/testthat/helper-functions.R

@@ -0,0 +1,15 @@
+#helper-functions.R
+#round_n
+round_n <- function(x, n=3) {
+  if (!is.na(x)) {
+    if (x >= 1000 | x<=0.0005) {
+      # if x>=1000, convert value to scientific notation
+      formatC(x, format = "e", digits = 1)
+    } else { # else, round the value to 3 decimal places
+      format(round(x, n), nsmall = 3)
+    }
+  } else {
+    return(NA)
+  }
+}
+round_n <- Vectorize(round_n)

tests/testthat/test-tcplConf.R

@@ -0,0 +1,13 @@
+test_that("example=driver updates option TCPL_DRVR", {
+  tcplConf(drvr = "example")
+  expect_equal("example",
+                    getOption("TCPL_DRVR"))
+})
+
+test_that("unsupported driver error message", {
+  drvr  <-  "test"
+  expect_error(
+    tcplConf(drvr),
+    paste0(drvr," is not a supported database driver. Must be 'MySQL', 'tcplLite', or 'example'.")
+)
+})

tests/testthat/test-tcplLoadData.R

@@ -0,0 +1,161 @@
+tcplConf(drvr = "example")
+
+test_that("sc0 loads sc0 data table", {
+  sc0 <- tcplLoadData(lvl = 0, type = "sc")
+  expect_true(
+    is.data.table(sc0)
+  )
+  sc0 <- tcplLoadData(lvl = 0L, type = "sc")
+  expect_true(
+    is.data.table(sc0)
+  )
+})
+
+test_that("sc1 loads sc1 data table", {
+  sc1 <- tcplLoadData(lvl = 1, type = "sc")
+  expect_true(
+    is.data.table(sc1)
+  )
+  sc1 <- tcplLoadData(lvl = 1L, type = "sc")
+  expect_true(
+    is.data.table(sc1)
+  )
+})
+
+test_that("sc2 loads sc2 data table", {
+  sc2 <- tcplLoadData(lvl = 2, type = "sc")
+  expect_true(
+    is.data.table(sc2)
+  )
+  sc2 <- tcplLoadData(lvl = 2L, type = "sc")
+  expect_true(
+    is.data.table(sc2)
+  )
+})
+
+test_that("lvl = 'agg' loads sc agg data table", {
+  agg <- tcplLoadData(lvl = "agg", type = "sc")
+  expect_true(
+    is.data.table(agg)
+  )
+})
+
+test_that("mc0 loads mc0 data table", {
+  mc0 <- tcplLoadData(lvl = 0, type = "mc")
+  expect_true(
+    is.data.table(mc0)
+  )
+  mc0 <- tcplLoadData(lvl = 0L, type = "mc")
+  expect_true(
+    is.data.table(mc0)
+  )
+})
+
+test_that("mc1 loads mc1 data table", {
+  mc1 <- tcplLoadData(lvl = 1, type = "mc")
+  expect_true(
+    is.data.table(mc1)
+  )
+  mc1 <- tcplLoadData(lvl = 1L, type = "mc")
+  expect_true(
+    is.data.table(mc1)
+  )
+})
+
+test_that("mc2 loads mc2 data table", {
+  mc2 <- tcplLoadData(lvl = 2, type = "mc")
+  expect_true(
+    is.data.table(mc2)
+  )
+  mc2 <- tcplLoadData(lvl = 2L, type = "mc")
+  expect_true(
+    is.data.table(mc2)
+  )
+})
+
+test_that("mc3 loads mc3 data table", {
+  mc3 <- tcplLoadData(lvl = 3, type = "mc")
+  expect_true(
+    is.data.table(mc3)
+  )
+  mc3 <- tcplLoadData(lvl = 3L, type = "mc")
+  expect_true(
+    is.data.table(mc3)
+  )
+})
+
+test_that("mc4 loads mc4 data table", {
+  mc4 <- tcplLoadData(lvl = 4, type = "mc")
+  expect_true(
+    is.data.table(mc4)
+  )
+  mc4 <- tcplLoadData(lvl = 4L, type = "mc")
+  expect_true(
+    is.data.table(mc4)
+  )
+})
+
+test_that("mc4 !add.fld loads mc4 data table", {
+  mc4 <- tcplLoadData(lvl = 4, type = "mc", add.fld=FALSE)
+  expect_true(
+    is.data.table(mc4)
+  )
+  mc4 <- tcplLoadData(lvl = 4L, type = "mc", add.fld=FALSE)
+  expect_true(
+    is.data.table(mc4)
+  )
+})
+
+test_that("mc5 loads mc5 data table", {
+  mc5 <- tcplLoadData(lvl = 5, type = "mc")
+  expect_true(
+    is.data.table(mc5)
+  )
+  mc5 <- tcplLoadData(lvl = 5L, type = "mc")
+  expect_true(
+    is.data.table(mc5)
+  )
+})
+
+test_that("mc5 !add.fld loads mc5 data table", {
+  mc5 <- tcplLoadData(lvl = 5, type = "mc", add.fld=FALSE)
+  expect_true(
+    is.data.table(mc5)
+  )
+  mc5 <- tcplLoadData(lvl = 5L, type = "mc", add.fld=FALSE)
+  expect_true(
+    is.data.table(mc5)
+  )
+})
+
+test_that("lvl = 'agg' loads mc agg data table", {
+  agg <- tcplLoadData(lvl = "agg", type = "mc")
+  expect_true(
+    is.data.table(agg)
+  )
+})
+
+test_that("invalid input error message", {
+  expect_error(
+    tcplLoadData(lvl = "sc", type = 0),
+    "Invalid 'lvl' and 'type' combination."
+  )
+})
+
+test_that("sc example error message appears", {
+  expect_error(
+    tcplLoadData(lvl = 4, type = "sc"),
+    "example tables for sc0, sc1, sc2, agg available."
+  )
+})
+
+test_that("mc example error message appears", {
+  expect_error(
+    tcplLoadData(lvl = 6, type = "mc"),
+    "example tables for mc0, mc1, mc2, mc3, mc4, mc5, agg available."
+  )
+})
+
+# test_that("description", {
+#   expect_*(code)
+# })