Allow empty inputs to business calculations (fix #559)

NEWS.md

@@ -6,13 +6,17 @@ the dosing including dose amount and route.
 
 # Development version
 
+* Business functions (used for calculations of means, etc.) now return NA_real_
+  for empty inputs rather than giving an error (#559).
+
 * `PKNCAconc()` gains an `lloq` argument (a column name or a numeric scalar) that
   is passed through to `pk.calc.half.life()`.  This wires the lower limit of
   quantification through a full `pk.nca()` run so the Tobit half-life method
   (`hl_method = "tobit"`, set via `PKNCAdata(options = list(hl_method = "tobit"))`)
   works end-to-end instead of failing because no `lloq` was available.
 
-* Added sparse AUMC function and five sparse AUC parameters (cl.sparse.last, kel.sparse.last, mrt.ivint.last, vss.sparse.last, vz.sparse.last)
+* Added sparse AUMC function and five sparse AUC parameters (cl.sparse.last,
+  kel.sparse.last, mrt.ivint.last, vss.sparse.last, vz.sparse.last)
 
 * New IV dosing AUMC parameters with C0 back-extrapolation (`aumciv*`)
 
@@ -52,8 +56,8 @@ the dosing including dose amount and route.
   row when used with ungrouped data, giving a clear error message instead of
   silently producing incorrect results.
 
-* `normalize.data.frame()` now uses `dplyr::inner_join()` instead of `merge()` 
-  for grouped joins, preserving left-table row order. Missing group validation 
+* `normalize.data.frame()` now uses `dplyr::inner_join()` instead of `merge()`
+  for grouped joins, preserving left-table row order. Missing group validation
   ensures no rows are silently dropped.
 
 

R/002-pk.business.rules.R

@@ -30,8 +30,10 @@ pk.business <- function(FUN,
     # to use PKNCA.Options("max.missing")
     max.missing <- PKNCA.options("max.missing")
     mask.missing <- is.na(x) | (zero.missing & (x %in% 0))
+    if (length(x) == 0)
+      return(NA_real_)
     if (sum(mask.missing)/length(x) > max.missing)
-      return(NA)
+      return(NA_real_)
     ret <- FUN(x[!mask.missing], ...)
     attr(ret, "n") <- sum(!mask.missing)
     ret
@@ -52,7 +54,7 @@ geomean <- function(x, na.rm=FALSE) {
   if (na.rm)
     x <- stats::na.omit(x)
   if (any(is.na(x))) {
-    as.numeric(NA)
+    NA_real_
   } else if (any(x == 0)) {
     0
   } else if (any(x < 0)) {

tests/testthat/test-auc.R

@@ -54,7 +54,7 @@ test_that("pk.calc.auxc", {
 
 test_that("pk.calc.auc: Linear AUC when the conc at the end of the interval is above LOQ", {
   # lambda.z is unused
-  tests <- list(AUCinf=structure(as.numeric(NA), method="AUC: linear"),
+  tests <- list(AUCinf=structure(NA_real_, method="AUC: linear"),
                 AUClast=structure(1.5, method="AUC: linear"),
                 AUCall=structure(1.5, method="AUC: linear"))
   for (t in names(tests)) {
@@ -78,7 +78,7 @@ test_that("pk.calc.auc: Linear AUC when the conc at the end of the interval is a
 test_that("pk.calc.auc: Linear AUC when the conc at the end of the interval is BLQ, lambda.z missing", {
   # lambda.z is used to extrapolate to the end of the interval.
   # Since lambda.z is NA, the result is NA.
-  tests <- list(AUCinf=structure(as.numeric(NA), method="AUC: linear"),
+  tests <- list(AUCinf=structure(NA_real_, method="AUC: linear"),
                 AUClast=structure(0.5, method="AUC: linear"),
                 AUCall=structure(1, method="AUC: linear"))
   for (t in names(tests)) {
@@ -248,11 +248,11 @@ test_that("pk.calc.auc: Confirm BLQ in the middle or end are calculated correctl
 test_that("pk.calc.auc: When AUCinf is requested with NA for lambda.z, the result is NA", {
   tests <- list(
     "linear"=list(
-      AUCinf=structure(as.numeric(NA), method="AUC: linear"),
+      AUCinf=structure(NA_real_, method="AUC: linear"),
       AUClast=structure(1+3+1.5+1.5, method="AUC: linear"),
       AUCall=structure(1+3+1.5+1.5+0.5, method="AUC: linear")),
     "lin up/log down"=list(
-      AUCinf=structure(as.numeric(NA), method="AUC: lin up/log down"),
+      AUCinf=structure(NA_real_, method="AUC: lin up/log down"),
       AUClast=structure(1+2/log(2)+1.5+1/log(2), method="AUC: lin up/log down"),
       AUCall=structure(1+2/log(2)+1.5+1/log(2)+0.5, method="AUC: lin up/log down")))
   for (t in names(tests)) {
@@ -288,11 +288,11 @@ test_that("pk.calc.auc: Test NA at the end", {
   # Test NA at the end
   tests <- list(
     "linear"=list(
-      AUCinf=structure(as.numeric(NA), method="AUC: linear"),
+      AUCinf=structure(NA_real_, method="AUC: linear"),
       AUClast=structure(1+3+1.5+1.5, method="AUC: linear"),
       AUCall=structure(1+3+1.5+1.5+1, method="AUC: linear")),
     "lin up/log down"=list(
-      AUCinf=structure(as.numeric(NA), method="AUC: lin up/log down"),
+      AUCinf=structure(NA_real_, method="AUC: lin up/log down"),
       AUClast=structure(1+2/log(2)+1.5+1/log(2), method="AUC: lin up/log down"),
       AUCall=structure(1+2/log(2)+1.5+1/log(2)+1, method="AUC: lin up/log down")))
   for (t in names(tests))

tests/testthat/test-check.intervals.R

@@ -61,13 +61,13 @@ test_that("check.interval.specification", {
   )
 
   # Confirm specific column values required
-  d7 <- data.frame(start=as.numeric(NA), end=1)
+  d7 <- data.frame(start=NA_real_, end=1)
   expect_error(
     check.interval.specification(d7),
     regexp="Interval specification may not have NA for the starting time",
     info="Interval specification may not have NA for the starting time"
   )
-  d8 <- data.frame(start=0, end=as.numeric(NA))
+  d8 <- data.frame(start=0, end = NA_real_)
   expect_error(
     check.interval.specification(d8),
     regexp="Interval specification may not have NA for the end time",

tests/testthat/test-cleaners.R

@@ -5,7 +5,7 @@ test_that("clean.conc.na", {
 
   # It drops NA values if requested (even if they are the only value)
   expect_warning(v1 <-
-    clean.conc.na(conc=as.numeric(NA), time=1, conc.na="drop"))
+    clean.conc.na(conc = NA_real_, time=1, conc.na="drop"))
   expect_equal(v1,
                data.frame(conc=numeric(), time=numeric()))
   expect_warning(v2 <-
@@ -21,7 +21,7 @@ test_that("clean.conc.na", {
 
   # It also works with a number as the conc.na value
   expect_warning(v3 <-
-    clean.conc.na(conc=as.numeric(NA), time=1, conc.na=5))
+    clean.conc.na(conc = NA_real_, time = 1, conc.na = 5))
   expect_equal(v3,
                data.frame(conc=5, time=1))
   expect_warning(v4 <-

tests/testthat/test-interpolate.conc.R

@@ -629,7 +629,7 @@ test_that("extrapolate.conc", {
       lambda.z=NA,
       auc.type="AUCinf"
     ),
-    as.numeric(NA)
+    NA_real_
   )
 
   # Extrapolating with all NA is NA.
@@ -1058,4 +1058,3 @@ test_that("interp.extrap.conc.dose", {
     info="Outputs are in the same order as inputs (reverse sorted time.out)"
   )
 })
-

tests/testthat/test-pk.business.rules.R

@@ -9,21 +9,25 @@ test_that("geomean", {
   # Test negative numbers
   expect_equal(geomean(c(-1, 2)), -geomean(c(1, 2)))
   # Test NAs
-  expect_equal(geomean(NA), as.numeric(NA))
-  expect_equal(geomean(c(NA, 0)), as.numeric(NA))
+  expect_equal(geomean(NA), NA_real_)
+  expect_equal(geomean(c(NA, 0)), NA_real_)
   expect_equal(geomean(c(NA, 5), na.rm=TRUE), 5)
   expect_equal(geomean(c(NA, NA), na.rm=TRUE), NaN)
 })
 
+test_that("empty inputs give NA_real_", {
+  expect_equal(business.geomean(c()), NA_real_)
+})
+
 test_that("geosd", {
   expect_equal(geosd(c(1, 2)), exp(sd(log(c(1, 2)))))
-  expect_equal(geosd(c(NA, 1, 2)), as.numeric(NA))
+  expect_equal(geosd(c(NA, 1, 2)), NA_real_)
 })
 
 test_that("geocv", {
   expect_equal(geocv(c(1, 2)),
                sqrt(exp(sd(log(c(1, 2)))^2)-1)*100)
-  expect_equal(geocv(c(NA, 1, 2)), as.numeric(NA))
+  expect_equal(geocv(c(NA, 1, 2)), NA_real_)
 })
 
 test_that("business.mean", {
@@ -35,11 +39,11 @@ test_that("business.mean", {
   # Ensure that at the max.missing fraction a value is reported and
   # above that, NA is returned.
   expect_equal(business.mean(c(NA, NA, 1, 2)), structure(1.5, n = 2))
-  expect_equal(business.mean(c(NA, NA, NA, 2)), NA)
+  expect_equal(business.mean(c(NA, NA, NA, 2)), NA_real_)
   # Ensure that it uses the current value of max.missing
   PKNCA.options(max.missing=0.3)
   expect_equal(business.mean(c(NA, 1, 2, 3)), structure(2, n = 3))
-  expect_equal(business.mean(c(NA, NA, 1, 2)), NA)
+  expect_equal(business.mean(c(NA, NA, 1, 2)), NA_real_)
 })
 
 test_that("pk.business", {
@@ -50,7 +54,7 @@ test_that("pk.business", {
   # Right at the border, it still reports
   expect_equal(b.mean(c(1, NA)), structure(1, n = 1))
   # When too much data is missing, NA is returned
-  expect_equal(b.mean(c(1, NA, NA)), NA)
+  expect_equal(b.mean(c(1, NA, NA)), NA_real_)
   # It respects zero.missing
   b.mean.2 <- pk.business(mean, zero.missing=TRUE)
   expect_equal(b.mean(c(0, 1)), structure(0.5, n = 2))

tests/testthat/test-pk.calc.simple.R

@@ -203,8 +203,10 @@ test_that("pk.calc.thalf.eff", {
   )
 
   # NA input gives equivalent NA output
-  expect_equal(pk.calc.thalf.eff(NA),
-               as.numeric(NA))
+  expect_equal(
+    pk.calc.thalf.eff(NA),
+    NA_real_
+  )
 
   # Numbers mixed with NA give appropriate output
   d1 <- c(0, 1, NA, 3)
@@ -223,7 +225,7 @@ test_that("pk.calc.kel", {
   # NA input gives equivalent NA output
   expect_equal(
     pk.calc.kel(NA),
-    as.numeric(NA)
+    NA_real_
   )
 
   # Numbers mixed with NA give appropriate output