Testing for set_* and obj_* (#55)

* make hill_conc value visible

* Added tests for set_*

* Updated/added tests/params for obj_*

* Updated documentation

* Increment version number to 0.0.0.9003

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: GeoTox
 Title: Spatiotemporal mixture risk assessment
-Version: 0.0.0.9002
+Version: 0.0.0.9003
 Authors@R: c(
     person("Skylar", "Marvel", , "[email protected]", role = c("aut", "ctb")),
     person("David", "Reif", , "[email protected]", role = c("aut", "ctb")),

R/calc_concentration_response.R

@@ -110,24 +110,31 @@ calc_concentration_response <- function(C_invitro,
       AC50_i <- AC50_i[idx]
     }
 
-    mixture.result <- stats::optimize(
-      obj_GCA, interval = interval, Ci = C_i, tp = tp_i, AC50 = AC50_i
-    )
+    mixture.result <- stats::optimize(obj_GCA,
+                                      interval = interval,
+                                      conc = C_i,
+                                      max = tp_i,
+                                      AC50 = AC50_i)
     GCA.eff[i] <- exp(mixture.result$minimum)
 
     # TODO replace with positive control value if given
-    Emax_resp <- stats::optimize(
-      obj_GCA, interval = interval, Ci = C_i * 10^14, tp = tp_i, AC50 = AC50_i
-    )
+    Emax_resp <- stats::optimize(obj_GCA,
+                                 interval = interval,
+                                 conc = C_i * 10^14,
+                                 max= tp_i,
+                                 AC50 = AC50_i)
     Emax <- exp(Emax_resp$minimum)
 
     IA.eff[i] <- calc_independent_action(C_i, tp_i, AC50_i, Emax)
 
     E10 <- Emax * 0.1
 
-    EC10.result <- stats::optimize(
-      obj_ECx, interval = c(-1000,1000), E = E10, Ci = C_i, tp = tp_i, AC50 = AC50_i
-    )
+    EC10.result <- stats::optimize(obj_ECx,
+                                   interval = c(-1000,1000),
+                                   resp = E10,
+                                   conc = C_i,
+                                   max = tp_i,
+                                   AC50 = AC50_i)
 
     EC10.GCA <- EC10.result$minimum
     E10.by.chem <- tp_i * 0.1

R/hill_conc.R

@@ -28,6 +28,6 @@ hill_conc <- function(resp, max, AC50, n) {
     stop("'resp' and 'max' must have the same sign.", call. = FALSE)
   }
 
-  conc <- AC50 * (max / resp - 1)^(-1 / n)
+  AC50 * (max / resp - 1)^(-1 / n)
 
 }

R/obj_ECx.R

@@ -5,16 +5,16 @@
 #' given the concentrations and inverse, based on a regular space AC50 and
 #' concentrations.
 #'
-#' @param ECmix effective concentration of the mixture
-#' @param E individual chemical responses
-#' @param Ci individual chemical concentrations in regular space
-#' @param tp top asymptotes
-#' @param AC50 AC50s
+#' @param conc_mix effective concentration of the mixture in regular space
+#' @param resp individual chemical responses
+#' @param conc individual chemical concentrations in regular space
+#' @param max maximal (asymtotic) response
+#' @param AC50 concentrations of half-maximal response
 #'
 #' @return objective value
-obj_ECx <- function(ECmix, E, Ci, tp, AC50) {
-  ECi <- hill_conc(E, tp, AC50, rep(1, length(tp)))
-  Pi <- Ci / sum(Ci)
-  ECx.val <- sum(Pi * ECmix / ECi, na.rm = FALSE)
+obj_ECx <- function(conc_mix, resp, conc, max, AC50) {
+  x <- hill_conc(resp, max, AC50, 1)
+  p <- conc / sum(conc)
+  ECx.val <- sum(p * conc_mix / x, na.rm = FALSE)
   (ECx.val - 1)^2
 }

R/obj_GCA.R

@@ -1,20 +1,19 @@
 #' Generalized concentration addition objective function
 #'
 #' @description
-#' Use to find the optimal efficacy value, E, based on a regular space AC50 and
+#' Use to find the optimal efficacy value based on a regular space AC50 and
 #' concentrations.
 #'
-#' @param effic natural log of individual chemical responses
-#' @param Ci individual chemical concentrations in regular space
-#' @param tp top asymptote
-#' @param AC50 AC50
+#' @param ln_resp natural log of individual chemical responses
+#' @param conc individual chemical concentrations in regular space
+#' @param max maximal (asymtotic) responses
+#' @param AC50 concentrations of half-maximal response
 #'
 #' @return objective value
-obj_GCA <- function(effic, Ci, tp, AC50) {
+obj_GCA <- function(ln_resp, conc, max, AC50) {
   # Solving for the efficacy on the natural log-scale. This allows for
   # better precision in the low values, e.g. 1 x 10-5
-  E <- exp(effic)
-  ECi <- hill_conc(E, tp, AC50, rep(1,length(tp)))
-  gca.val <- sum(Ci / ECi, na.rm = FALSE)
+  x <- hill_conc(exp(ln_resp), max, AC50, 1)
+  gca.val <- sum(conc / x, na.rm = FALSE)
   (gca.val - 1)^2
 }

tests/testthat/test-obj_ECx.R

@@ -0,0 +1,19 @@
+test_that("spot check", {
+
+  conc_mix <- 2
+  resp <- 1
+  conc <- c(1, 3)
+  max <- resp * 2
+  AC50 <- conc
+
+  expect_equal(obj_ECx(conc_mix, resp, conc, max, AC50), 0)
+
+  conc_mix <- 2
+  resp <- c(1, 2)
+  conc <- c(1, 3)
+  max <- c(3, 4)
+  AC50 <- 1
+
+  expect_equal(obj_ECx(conc_mix, resp, conc, max, AC50), 2.25)
+
+})

tests/testthat/test-obj_GCA.R

@@ -0,0 +1,19 @@
+test_that("spot check", {
+
+  resp <- 1
+  ln_resp <- log(resp)
+  conc <- c(1, 3)
+  max <- resp * 2
+  AC50 <- conc
+
+  expect_equal(obj_GCA(ln_resp, conc, max, AC50), 1)
+
+  resp <- c(1, 2)
+  ln_resp <- log(resp)
+  conc <- c(1, 3)
+  max <- c(3, 4)
+  AC50 <- 1
+
+  expect_equal(obj_GCA(ln_resp, conc, max, AC50), 16)
+
+})

tests/testthat/test-obj_hill.R

@@ -1,3 +1,19 @@
+test_that("spot check", {
+
+  par <- c(2, 3, dt(0, df = 3, log = TRUE))
+  log10_conc <- par[2]
+  resp <- rep(par[1] / 2, 5)
+
+  expect_equal(obj_hill(par, log10_conc, resp), 0)
+
+  par <- c(2, 3, 4, dt(0, df = 4, log = TRUE))
+  log10_conc <- par[2]
+  resp <- rep(par[1] / 2, 7)
+
+  expect_equal(obj_hill(par, log10_conc, resp), 0)
+
+})
+
 # Testing the obj-hill functions
 test_that("2 and 3 parameter models give accurate likelihood", {
 

tests/testthat/test-set_boundaries.R

@@ -0,0 +1,31 @@
+test_that("region", {
+
+  x <- list(boundaries = NULL)
+  region <- data.frame(geometry = "test")
+
+  expect_error(set_boundaries(x, region = region))
+
+  class(region) <- c("sf")
+
+  expect_no_error(x <- set_boundaries(x, region = region))
+
+  expect_equal(x$boundaries$region, region)
+  expect_null(x$boundaries$group)
+
+})
+
+test_that("group", {
+
+  x <- list(boundaries = NULL)
+  group <- data.frame(geometry = "test")
+
+  expect_error(set_boundaries(x, group = group))
+
+  class(group) <- c("sf")
+
+  expect_no_error(x <- set_boundaries(x, group = group))
+
+  expect_null(x$boundaries$region)
+  expect_equal(x$boundaries$group, group)
+
+})

tests/testthat/test-set_hill_params.R

@@ -0,0 +1,26 @@
+test_that("setting", {
+
+  hill_params <- "test"
+
+  x <- list()
+
+  expect_no_warning(x <- set_hill_params(x, hill_params))
+  expect_equal(x, list(hill_params = hill_params))
+
+})
+
+test_that("clear downstream", {
+
+  hill_params <- "test"
+
+  x <- list(resp = "test")
+
+  expect_warning(x <- set_hill_params(x, hill_params))
+  expect_equal(x, list(hill_params = hill_params))
+
+  x <- list(sensitivity = "test")
+
+  expect_warning(x <- set_hill_params(x, hill_params))
+  expect_equal(x, list(hill_params = hill_params))
+
+})