Added some unit tests (#66)

R/calc_invitro_concentration.R

@@ -30,5 +30,5 @@ calc_invitro_concentration <- function(D_int, C_ss = NULL) {
 }
 
 .calc_invitro_concentration <- function(D_int, C_ss) {
-  D_int * C_ss
+  as.matrix(D_int * C_ss)
 }

R/compute_sensitivity.R

@@ -23,9 +23,16 @@ compute_sensitivity <- function(x,
     tp_b_mult <- x$par$resp$tp_b_mult
   }
 
+  if (is.null(x$age)) {
+    stop("GeoTox 'age' field is not set.", call. = FALSE)
+  }
+
   if (vary == "age") {
     age <- x$age
     IR <- x$IR
+    if (is.null(IR)) {
+      stop("GeoTox 'IR' field is not set.", call. = FALSE)
+    }
   } else {
     age <- lapply(x$age, function(x) rep(stats::median(x),
                                          length.out = length(x)))
@@ -34,6 +41,9 @@ compute_sensitivity <- function(x,
 
   if (vary == "C_ext") {
     C_ext <- x$C_ext
+    if (is.null(C_ext)) {
+      stop("GeoTox 'C_ext' field is not set.", call. = FALSE)
+    }
   } else {
     # Set exposure sd = NA (or 0)
     exposure <- lapply(x$exposure, \(x) x |> dplyr::mutate(sd = NA))

R/sample_Css.R

@@ -28,8 +28,8 @@ sample_Css <- function(simulated_css, age, obesity) {
     stop("Names and lengths of 'age' and 'obesity' fields must be equal",
          call. = FALSE)
   }
-  if (length(age) == 0) {
-    stop("'age' and 'obesity' data has not been simulated", call. = FALSE)
+  if (length(age[[1]]) == 0) {
+    stop("'age' and 'obesity' data have not been simulated", call. = FALSE)
   }
 
   mapply(

R/sensitivity_analysis.R

@@ -27,8 +27,7 @@ sensitivity_analysis <- function(x,
     stop("Input 'x' must be a GeoTox object.", call. = FALSE)
   }
   if (length(tp_b_mult) != 5) {
-    stop("Input 'tp_b_mult' must be a numeric vector of length 5.",
-         call. = FALSE)
+    stop("Input 'tp_b_mult' must have a length of 5.", call. = FALSE)
   }
 
   x$sensitivity <- list(

R/simulate_exposure.R

@@ -36,14 +36,14 @@ simulate_exposure <- function(x,
                               n = 1e3) {
 
   if (!any(c("data.frame", "list") %in% class(x))) {
-    stop("x must be a data.frame or list")
+    stop("'x' must be a data.frame or list", call. = FALSE)
   }
 
   if (is.data.frame(x)) x <- list(x)
 
   if (.check_names(x, c(expos_mean, expos_sd))) {
-    stop("x data frames must contain columns named by 'expos_mean' and ",
-         "'expos_sd'")
+    stop("'x' data frames must contain columns named by 'expos_mean' and ",
+         "'expos_sd'", call. = FALSE)
   }
 
   lapply(x, function(df) {
@@ -53,7 +53,7 @@ simulate_exposure <- function(x,
       # Have consistent output order
       out <- out[, order(colnames(out)), drop = FALSE]
     } else if (nrow(df) > 1) {
-      stop("x data frames must contain a column named by 'expos_label'",
+      stop("'x' data frames must contain a column named by 'expos_label'",
            call. = FALSE)
     }
     out

tests/testthat/test-check_lengths.R

@@ -0,0 +1,7 @@
+test_that("results", {
+  # TRUE means different lengths
+  expect_true(.check_lengths(list(1:5),
+                             list(6:9)))
+  expect_false(.check_lengths(list(1:5),
+                              list(6:10)))
+})

tests/testthat/test-check_names.R

@@ -0,0 +1,10 @@
+test_that("results", {
+  # TRUE means names not found
+  names <- "a"
+  expect_true(.check_names(c(), names = names))
+  expect_true(.check_names(list(c()), names = names))
+  expect_true(.check_names(list(c("a" = 1),
+                                c()), names = names))
+  expect_false(.check_names(c("a" = 1), names = names))
+  expect_false(.check_names(list(c("a" = 1)), names = names))
+})

tests/testthat/test-compute_sensitivity.R

@@ -0,0 +1,67 @@
+test_that("bad inputs", {
+
+  # Age field not set
+  expect_error(compute_sensitivity(GeoTox()))
+
+  # IR field not set
+  geoTox <- GeoTox()
+  geoTox$age <- list(1)
+  expect_error(compute_sensitivity(geoTox))
+
+  # C_ext field not set
+  geoTox <- GeoTox()
+  geoTox$age <- list(1)
+  expect_error(compute_sensitivity(geoTox, vary = "C_ext"))
+})
+
+test_that("results", {
+
+  # Similar to "test-sensitivity_analysis.R"
+
+  geoTox <- GeoTox()
+
+  expect_null(geoTox$sensitivity)
+
+  geoTox$par$n <- 1
+  geoTox$hill_params <- data.frame(resp_max = 5,
+                                   tp = 5,
+                                   tp.sd = 1,
+                                   logc_min = -1,
+                                   logc_max = 1,
+                                   logAC50 = 0,
+                                   logAC50.sd = 1)
+  geoTox$age <- list(2)
+  geoTox$IR <- list(0.5)
+  geoTox$obesity <- list("Normal")
+  geoTox$exposure <- list(data.frame(mean = 1, sd = 0))
+  geoTox$C_ext <- list(1)
+  geoTox$css_sensitivity <- list(age = list(matrix(5)),
+                                 obesity = list(matrix(10)),
+                                 params = list(matrix(15)),
+                                 other = list(7))
+
+  out <- compute_sensitivity(geoTox, "age", NULL)
+
+  expect_type(out, "list")
+  expect_length(out, 1)
+
+  out <- compute_sensitivity(geoTox, "obesity", 1.1)
+
+  expect_type(out, "list")
+  expect_length(out, 1)
+
+  out <- compute_sensitivity(geoTox, "css_params", 1.2)
+
+  expect_type(out, "list")
+  expect_length(out, 1)
+
+  out <- compute_sensitivity(geoTox, "fit_params", 1.3)
+
+  expect_type(out, "list")
+  expect_length(out, 1)
+
+  out <- compute_sensitivity(geoTox, "C_ext", 1.4)
+
+  expect_type(out, "list")
+  expect_length(out, 1)
+})

tests/testthat/test-fit_hill.R

@@ -1,3 +1,17 @@
+test_that("bad inputs", {
+  # Input should be a data frame
+  expect_error(fit_hill(c()))
+  # Expected required column names
+  expect_error(fit_hill(data.frame(x = 0, y = 0)))
+  # Expected optional column names
+  expect_error(fit_hill(data.frame(logc = c(-1, 1),
+                                   resp = c(100, 0)),
+                        chem = "missing"))
+  expect_error(fit_hill(data.frame(logc = c(-1, 1),
+                                   resp = c(100, 0)),
+                        assay = "missing"))
+})
+
 test_that("output column names", {
   df <- data.frame(
     logc = -3:3,
@@ -22,3 +36,26 @@ test_that("output column names", {
   expect_equal(names(fit_hill(df, chem = "chem_col", assay = "assay_col")),
                c("assay", "chem", colnames))
 })
+
+test_that("internal", {
+
+  x <- data.frame(logc = c(-1, 0, 1), resp = c(10, 5, 0))
+
+  out <- .fit_hill(x)
+
+  expect_equal(as.numeric(out$par["slope"]),
+               1)
+
+  out <- .fit_hill(x, fixed_slope = FALSE)
+
+  expect_true(as.numeric(out$par["slope"]) > 1)
+
+  res <- .extract_hill_params(out)
+
+  colnames <- c("tp", "tp.sd", "logAC50", "logAC50.sd", "slope", "slope.sd",
+                "logc_min", "logc_max", "resp_min", "resp_max",
+                "AIC", "tp.sd.imputed", "logAC50.sd.imputed")
+
+  expect_equal(names(res),
+               colnames)
+})

tests/testthat/test-get_fixed_css.R

@@ -0,0 +1,25 @@
+test_that("errors", {
+  expect_error(get_fixed_css(age = c(1, 2), obesity = c("Normal")))
+})
+
+test_that("results", {
+  simulated_css <- list(tibble::tibble(age_min = 1,
+                                       age_median_css = 5,
+                                       weight = "Normal",
+                                       weight_median_css = 10,
+                                       css = list(c(15, 15))))
+  C_ss <- list(matrix(7))
+  age <- 2
+  obesity <- "Normal"
+
+  out <- get_fixed_css(simulated_css = simulated_css,
+                       C_ss = C_ss,
+                       age = age,
+                       obesity = obesity)
+
+  expect_equal(out,
+               list(age = list(matrix(5)),
+                    params = list(matrix(15)),
+                    obesity = list(matrix(10)),
+                    other = list(7)))
+})

tests/testthat/test-get_fixed_params.R

@@ -9,13 +9,22 @@ test_that("expected results", {
   })
   simulated_css <- list("chem1" = x, "chem2" = y)
 
-  expect_equal(
-    get_fixed_params(simulated_css, list(c(1, 27, 30), c(15, 60))),
-    list(matrix(c(4, 4, 4, 2, 2, 2),
-                ncol = 2,
-                dimnames = list(NULL, c("chem1", "chem2"))),
-         matrix(c(6, 6, 3, 3),
-                ncol = 2,
-                dimnames = list(NULL, c("chem1", "chem2"))))
-  )
+  # Age list
+  out <- get_fixed_params(simulated_css, list(c(1, 27, 30), c(15, 60)))
+
+  expect_equal(out,
+               list(matrix(c(4, 4, 4, 2, 2, 2),
+                           ncol = 2,
+                           dimnames = list(NULL, c("chem1", "chem2"))),
+                    matrix(c(6, 6, 3, 3),
+                           ncol = 2,
+                           dimnames = list(NULL, c("chem1", "chem2")))))
+
+  # Age vector
+  out <- get_fixed_params(simulated_css, c(1, 27, 30))
+
+  expect_equal(out,
+               list(matrix(c(4, 4, 4, 2, 2, 2),
+                           ncol = 2,
+                           dimnames = list(NULL, c("chem1", "chem2")))))
 })

tests/testthat/test-sample_Css.R

@@ -1,6 +1,7 @@
 test_that("bad inputs", {
   # Missing age/obesity data
   expect_error(sample_Css(age = c(), obesity = c()))
+  expect_error(sample_Css(age = NULL, obesity = NULL))
   # Age/obesity data do not match lengths
   expect_error(sample_Css(age = 1:3, obesity = c("Normal", "Obese")))
   # Age/obesity data do not match names

tests/testthat/test-sensitivity_analysis.R

@@ -0,0 +1,41 @@
+test_that("bad inputs", {
+  expect_error(sensitivity_analysis(list()))
+  expect_error(sensitivity_analysis(GeoTox(), 1:3))
+})
+
+test_that("results", {
+
+  # Similar to "test-compute_sensitivity.R"
+
+  geoTox <- GeoTox()
+
+  expect_null(geoTox$sensitivity)
+
+  geoTox$par$n <- 1
+  geoTox$hill_params <- data.frame(resp_max = 5,
+                                   tp = 5,
+                                   tp.sd = 1,
+                                   logc_min = -1,
+                                   logc_max = 1,
+                                   logAC50 = 0,
+                                   logAC50.sd = 1)
+  geoTox$age <- list(2)
+  geoTox$IR <- list(0.5)
+  geoTox$obesity <- list("Normal")
+  geoTox$exposure <- list(data.frame(mean = 1, sd = 0))
+  geoTox$C_ext <- list(1)
+  geoTox$css_sensitivity <- list(age = list(matrix(5)),
+                                 obesity = list(matrix(10)),
+                                 params = list(matrix(15)),
+                                 other = list(7))
+
+  geoTox <- sensitivity_analysis(geoTox, list(NULL, 1.1, 1.2, 1.3, 1.4))
+
+  geoTox$sensitivity
+
+  expect_false(is.null(geoTox$sensitivity$age))
+  expect_false(is.null(geoTox$sensitivity$obesity))
+  expect_false(is.null(geoTox$sensitivity$css_params))
+  expect_false(is.null(geoTox$sensitivity$fit_params))
+  expect_false(is.null(geoTox$sensitivity$C_ext))
+})