Updated 'calc_concentration_response'

NIEHS · Oct 25, 2024 · 4683259 · 4683259
1 parent a54ea3f
commit 4683259
Show file tree

Hide file tree

Showing 2 changed files with 134 additions and 55 deletions.
diff --git a/R/calc_concentration_response.R b/R/calc_concentration_response.R
@@ -33,9 +33,7 @@ calc_concentration_response <- function(C_invitro,
   # Calculate response for each assay
   lapply(C_invitro, \(C_invitro_i) {
     lapply(hill_params, \(hill_params_j) {
-      if (ncol(C_invitro_i) == 1 & nrow(hill_params_j) == 1) {
-        .calc_concentration_response(C_invitro_i, hill_params_j, max_mult, fixed)
-      } else {
+      if (ncol(C_invitro_i) != 1 | nrow(hill_params_j) != 1) {
         if (!"chem" %in% names(hill_params_j)) {
           stop("'hill_params' must contain a 'chem' column", call. = FALSE)
         }
@@ -44,17 +42,17 @@ calc_concentration_response <- function(C_invitro,
           stop("'hill_params' chemicals missing in 'C_invitro'", call. = FALSE)
         }
         C_invitro_i <- C_invitro_i[, chems, drop = FALSE]
-        res <- .calc_concentration_response(C_invitro_i,
-                                            hill_params_j,
-                                            max_mult,
-                                            fixed) |> 
-          dplyr::mutate(sample = dplyr::row_number(), .before = 1)
-        if ("assay" %in% names(hill_params_j)) {
-          res <- res |> 
-            dplyr::mutate(assay = hill_params_j$assay[[1]], .before = 1)
-        }
-        res
       }
+      res <- .calc_concentration_response(C_invitro_i,
+                                          hill_params_j,
+                                          max_mult,
+                                          fixed) |> 
+        dplyr::mutate(sample = dplyr::row_number(), .before = 1)
+      if ("assay" %in% names(hill_params_j)) {
+        res <- res |> 
+          dplyr::mutate(assay = hill_params_j$assay[[1]], .before = 1)
+      }
+      res
     }) |> 
       dplyr::bind_rows()
   })
@@ -144,7 +142,6 @@ calc_concentration_response <- function(C_invitro,
 
   }
 
-
   data.frame(
     "GCA.Eff" = GCA.eff, "IA.Eff" = IA.eff,
     "GCA.HQ.10" = GCA.HQ.10, "IA.HQ.10" = IA.HQ.10

diff --git a/tests/testthat/test-calc_concentration_response.R b/tests/testthat/test-calc_concentration_response.R
@@ -1,49 +1,131 @@
-test_that("mixture calculation for errors from bad inputs", {
-  # errors from bad input
-
-  # errors from bad order
-
+test_that("C_invitro with basic hill_params", {
+
+  col_names <- c("sample", "GCA.Eff", "IA.Eff", "GCA.HQ.10", "IA.HQ.10")
+
+  hill_params <- fit_hill(data.frame(logc = c(-1, 0, 1), resp = c(10, 5, 0)))
+
+  C_invitro <- matrix(0)
+
+  expect_no_error(out <- calc_concentration_response(C_invitro, hill_params))
+  expect_true(all(col_names %in% names(out[[1]])))
+  expect_true(all(unname(out[[1]]) == c(1, NA, NA, NA, NA)))
+
+  C_invitro <- matrix(1)
+
+  expect_no_error(out <- calc_concentration_response(C_invitro, hill_params))
+  expect_true(all(col_names %in% names(out[[1]])))
+
+  C_invitro <- matrix(1:4, ncol = 1)
+
+  expect_no_error(out <- calc_concentration_response(C_invitro, hill_params))
+  expect_true(all(col_names %in% names(out[[1]])))
+
+  C_invitro <- list(matrix(1))
+
+  expect_no_error(out <- calc_concentration_response(C_invitro, hill_params))
+  expect_true(all(col_names %in% names(out[[1]])))
+
+  C_invitro <- list(matrix(1:4), matrix(5:8))
+
+  expect_no_error(out <- calc_concentration_response(C_invitro, hill_params))
+  expect_length(out, 2)
+  expect_true(all(col_names %in% names(out |> do.call(what = rbind))))
+
+  C_invitro <- matrix(1:4, ncol = 2)
+  # hill_params needs "chem" column if C_invitro has > 1 row
+  expect_error(calc_concentration_response(C_invitro, hill_params))
 })
 
-
-test_that("calc_concentration_response is valid with simulated data", {
-
-
-  # Set up a mixture concentration-response
-  conc <- seq(0,1,by = 0.1)
-
-
-
-  #
+test_that("hill_params 'chem'", {
+
+  col_names <- c("GCA.Eff", "IA.Eff", "GCA.HQ.10", "IA.HQ.10")
+
+  # Single chemical
+
+  hill_params <- fit_hill(data.frame(logc = c(-1, 0, 1),
+                                     resp = c(10, 5, 0),
+                                     chem = rep("c1", each = 3)),
+                          chem = "chem")
+
+  C_invitro <- matrix(1:4, ncol = 1)
+
+  expect_no_error(out <- calc_concentration_response(C_invitro, hill_params))
+  expect_true(all(c(col_names, "sample") %in% names(out[[1]])))
+  expect_true(nrow(out[[1]]) == 4)
+
+  # Multiple chemicals
+
+  hill_params <- fit_hill(data.frame(logc = c(-1, 0, 1, -2, -1, 0),
+                                     resp = c(10, 5, 0, 0, 1, 2),
+                                     chem = rep(c("c1", "c2"), each = 3)),
+                          chem = "chem")
+
+  C_invitro <- matrix(1:4, ncol = 2)
+  expect_error(calc_concentration_response(C_invitro, hill_params))
+
+  colnames(C_invitro) <- c("c1", "c2")
+  expect_no_error(out <- calc_concentration_response(C_invitro, hill_params))
+  expect_true(all(c(col_names, "sample") %in% names(out[[1]])))
+  expect_true(nrow(out[[1]]) == 2)
 })
 
-test_that("calc_concentration_response is valid with ICE data", {
-
-  # Set up a mixture concentration-response from ICE
-  ice_data <- geo_tox_data$ice
-
-  conc <- seq(0,1,by = 0.1)
-
-
-
-  #
+test_that("hill_params 'assay'", {
+
+  col_names <- c("GCA.Eff", "IA.Eff", "GCA.HQ.10", "IA.HQ.10")
+
+  # Single assay
+
+  hill_params <- fit_hill(data.frame(logc = c(-1, 0, 1),
+                                     resp = c(10, 5, 0),
+                                     assay = rep("a1", each = 3)),
+                          assay = "assay")
+
+  C_invitro <- matrix(1:4, ncol = 1)
+
+  expect_no_error(out <- calc_concentration_response(C_invitro, hill_params))
+  expect_true(all(c(col_names, "assay") %in% names(out[[1]])))
+  expect_true(nrow(out[[1]]) == 4)
+
+  # Multiple assays
+
+  hill_params <- fit_hill(data.frame(logc = c(-1, 0, 1, -2, -1, 0),
+                                     resp = c(10, 5, 0, 0, 1, 2),
+                                     assay = rep(c("a1", "a2"), each = 3)),
+                          assay = "assay")
+
+  C_invitro <- matrix(1:4, ncol = 1)
+
+  expect_no_error(out <- calc_concentration_response(C_invitro, hill_params))
+  expect_true(all(c(col_names, "assay") %in% names(out[[1]])))
+  expect_true(nrow(out[[1]]) == 8)
 })
 
+test_that("hill_params 'assay' and 'chem'", {
+
+  col_names <- c("GCA.Eff", "IA.Eff", "GCA.HQ.10", "IA.HQ.10")
+
+  df <- data.frame(logc = rep(c(-1, 0, 1, -2, -1, 0), times = 2),
+                   resp = rep(c(10, 5, 0, 0, 1, 2), times = 2),
+                   chem = rep(rep(c("c1", "c2"), each = 3), times = 2),
+                   assay = rep(rep(c("a1", "a2"), each = 6)))
+  hill_params <- fit_hill(df, chem = "chem", assay = "assay")
+
+  C_invitro <- matrix(1:4, ncol = 2, dimnames = list(NULL, c("c1", "c2")))
+
+  expect_no_error(out <- calc_concentration_response(C_invitro, hill_params))
+  expect_true(all(c(col_names, "assay", "sample") %in% names(out[[1]])))
+  expect_true(nrow(out[[1]]) == 4)
+})
 
-
-test_that("calc_independent_action scales to Emax", {
-
-
-  x <- data.frame(AGEGRP = 0:18, TOT_POP = c(sum(1:18), 1:18))
-  ages_test <- simulate_age(x, 10)[[1]]
-
-
-  # age sample is of size "n"
-  expect_vector(ages_test,size = 10)
-
-  # age samples are within allowed age range [0,90] t
-  expect_true(all(ages_test < 90 & ages_test >= 0))
-
-
-  #
+test_that("other inputs", {
+
+  hill_params <- fit_hill(data.frame(logc = c(-1, 0, 1), resp = c(10, 5, 0)))
+  C_invitro <- matrix(1)
+
+  expect_no_error(calc_concentration_response(C_invitro,
+                                              hill_params,
+                                              max_mult = 1.1))
+  expect_no_error(calc_concentration_response(C_invitro,
+                                              hill_params,
+                                              fixed = TRUE))
 })