fix: fail loud on non-logical half-life point columns and annotate unreportable half-life

NEWS.md

@@ -6,6 +6,20 @@ the dosing including dose amount and route.
 
 # Development version
 
+* Breaking change: The `exclude_half.life` and `include_half.life` columns must
+  now be logical (`TRUE`/`FALSE`/`NA`).  A non-logical column (e.g. character
+  `"yes"`) previously was accepted silently and excluded or included nothing; it
+  is now an error.  Likewise, an `exclude_half.life` or `include_half.life`
+  column name that does not exist in the data previously created an all-`NA`
+  column silently (so a typo deactivated the point selection); it is now an
+  error naming the missing column (#583).
+
+* Bug fix: `pk.calc.half.life()` now attaches an exclusion reason ("No valid
+  terminal phase...") when no candidate window survives point selection (for
+  example, when a well-fitting window with `lambda.z <= 0` anchors the adjusted
+  r-squared tolerance), instead of returning `NA` with no reason.  The reason
+  appears in the `exclude` column of `pk.nca()` results (#583).
+
 * Bug fix: `update()` on a `PKNCAresults` object now works when group columns
   are factors whose levels differ between the old and new data (for example,
   ordered factors like `datasets::Theoph$Subject` after re-leveling); group

R/assertions.R

@@ -212,6 +212,7 @@ assert_PKNCAdata <- function(object) {
   if (nrow(object$intervals) == 0) {
     rlang::warn("No intervals given; no calculations will be done.", class = "pknca_warning_no_intervals")
   }
+  assert_PKNCAconc(object$conc)
   object
 }
 
@@ -232,6 +233,25 @@ assert_PKNCAconc <- function(object) {
   if (!inherits(object, "PKNCAconc")) {
     rlang::abort("Must be a PKNCAconc object", class = "pknca_error_not_concdata")
   }
+  # A half-life point selection column of any other type selects nothing
+  # rather than erroring, so require logical here.  PKNCAconc() validates at
+  # construction and pk.nca() re-checks, catching a column replaced after.
+  data_name <- getDataName(object)
+  for (attr_name in c("exclude_half.life", "include_half.life")) {
+    col_name <- object$columns[[attr_name]]
+    if (!is.null(col_name) && all(col_name %in% names(object[[data_name]]))) {
+      current_col <- object[[data_name]][[col_name]]
+      if (!is.logical(current_col)) {
+        rlang::abort(
+          sprintf(
+            "The %s column ('%s') must be a logical (TRUE/FALSE/NA) column, not %s",
+            attr_name, col_name, class(current_col)[1]
+          ),
+          class = "pknca_error_half_life_column_not_logical"
+        )
+      }
+    }
+  }
   object
 }
 

R/class-PKNCAconc.R

@@ -43,9 +43,11 @@
 #'   (undefined); the column/vector is treated as "in use" for an interval
 #'   unless it is entirely `NA` (so an all-`FALSE` column still counts as in
 #'   use), so leave it `NA` (rather than `FALSE`) where the mechanism should not
-#'   apply.  Only one of `exclude_half.life` and `include_half.life` may be in
-#'   use for a given interval.  See the "Half-Life Calculation" vignette for
-#'   more details on the use of these arguments.
+#'   apply.  The column must be logical and must exist in the data; anything
+#'   else is an error.  Only one of `exclude_half.life` and
+#'   `include_half.life` may be in use for a given interval.  See the
+#'   "Half-Life Calculation" vignette for more details on the use of these
+#'   arguments.
 #' @param lloq (optional) The lower limit of quantification used by the Tobit
 #'   half-life method (`hl_method = "tobit"`).  Either the name of a column in
 #'   `data` giving the per-observation LLOQ or a numeric scalar applied to all
@@ -197,13 +199,21 @@ PKNCAconc.data.frame <- function(data, formula, subject,
     ret <-
       setAttributeColumn(object=ret,
                          attr_name="exclude_half.life",
-                         col_name=exclude_half.life)
+                         col_name=exclude_half.life,
+                         stop_if_default=paste0(
+                           "The exclude_half.life column ('", exclude_half.life,
+                           "') does not exist in the data"
+                         ))
   }
   if (!missing(include_half.life)) {
     ret <-
       setAttributeColumn(object=ret,
                          attr_name="include_half.life",
-                         col_name=include_half.life)
+                         col_name=include_half.life,
+                         stop_if_default=paste0(
+                           "The include_half.life column ('", include_half.life,
+                           "') does not exist in the data"
+                         ))
   }
   if (!missing(lloq)) {
     ret <- setAttributeColumn(object=ret, attr_name="lloq", col_or_value=lloq)
@@ -219,7 +229,7 @@ PKNCAconc.data.frame <- function(data, formula, subject,
       units_orig = list(concu = concu, amountu = amountu, timeu = timeu),
       units_pref = list(concu_pref = concu_pref, amountu_pref = amountu_pref, timeu_pref = timeu_pref)
     )
-  ret
+  assert_PKNCAconc(ret)
 }
 
 #' Extract the formula from a PKNCAconc object.

R/half.life.R

@@ -334,6 +334,11 @@ pk.calc.half.life <- function(conc, time, tmax, tlast,
       }
       if (any(mask_best)) {
         ret[, ret_replacements] <- half_lives_for_selection[mask_best, ret_replacements]
+      } else {
+        # A well-fitting span with lambda.z <= 0 can anchor the adjusted
+        # r-squared tolerance so that no span with lambda.z > 0 is within it.
+        attr(ret, "exclude") <-
+          "No valid terminal phase: no span with lambda.z > 0 within the adjusted r-squared tolerance of the best fit"
       }
     } else {
       attr(ret, "exclude") <-
@@ -418,6 +423,10 @@ pk.calc.half.life <- function(conc, time, tmax, tlast,
           common_cols <- intersect(ret_replacements, names(all_tobit))
           ret[, common_cols] <- all_tobit[mask_best, common_cols]
         }
+      } else {
+        # No span with a positive elimination rate (or no converged fit)
+        attr(ret, "exclude") <-
+          "No valid terminal phase: no Tobit span with lambda.z > 0"
       }
     } else {
       attr(ret, "exclude") <-

tests/testthat/test-class-PKNCAconc.R

@@ -672,3 +672,66 @@ test_that("PKNCAconc lloq argument is stored and validated (scalar and column)",
   expect_null(o_none$columns$lloq)
   expect_false("lloq" %in% names(o_none$data))
 })
+
+test_that("exclude_half.life and include_half.life columns must be logical (#583)", {
+  d_conc <-
+    data.frame(
+      conc = c(1, 0.5, 0.25, 0.125),
+      time = 0:3,
+      excl_chr = c(NA, NA, "yes", NA),
+      incl_chr = c(NA, "yes", "yes", "yes"),
+      excl_num = c(0, 0, 1, 0),
+      excl_lgl = c(NA, NA, TRUE, NA),
+      incl_lgl = c(FALSE, TRUE, TRUE, TRUE),
+      subject = 1
+    )
+  # A non-logical column is an error that names the column
+  expect_error(
+    PKNCAconc(d_conc, conc ~ time | subject, exclude_half.life = "excl_chr"),
+    regexp = "The exclude_half.life column ('excl_chr') must be a logical (TRUE/FALSE/NA) column, not character",
+    fixed = TRUE
+  )
+  expect_error(
+    PKNCAconc(d_conc, conc ~ time | subject, include_half.life = "incl_chr"),
+    regexp = "The include_half.life column ('incl_chr') must be a logical (TRUE/FALSE/NA) column, not character",
+    fixed = TRUE
+  )
+  # Numeric 0/1 columns are also rejected
+  expect_error(
+    PKNCAconc(d_conc, conc ~ time | subject, exclude_half.life = "excl_num"),
+    regexp = "The exclude_half.life column ('excl_num') must be a logical (TRUE/FALSE/NA) column, not numeric",
+    fixed = TRUE
+  )
+  # Logical columns (including NA values) continue to work
+  o_excl <- PKNCAconc(d_conc, conc ~ time | subject, exclude_half.life = "excl_lgl")
+  expect_s3_class(o_excl, "PKNCAconc")
+  expect_equal(o_excl$columns$exclude_half.life, "excl_lgl")
+  o_incl <- PKNCAconc(d_conc, conc ~ time | subject, include_half.life = "incl_lgl")
+  expect_s3_class(o_incl, "PKNCAconc")
+  expect_equal(o_incl$columns$include_half.life, "incl_lgl")
+})
+
+test_that("exclude_half.life and include_half.life column names must exist in the data (#583)", {
+  d_conc <-
+    data.frame(
+      conc = c(1, 0.5, 0.25, 0.125),
+      time = 0:3,
+      excl_lgl = c(NA, NA, TRUE, NA),
+      subject = 1
+    )
+  # A column name not in the data is an error that names the missing column,
+  # so a typo cannot quietly deactivate the selection
+  expect_error(
+    PKNCAconc(d_conc, conc ~ time | subject, exclude_half.life = "excl_typo"),
+    regexp = "The exclude_half.life column ('excl_typo') does not exist in the data",
+    fixed = TRUE
+  )
+  expect_error(
+    PKNCAconc(d_conc, conc ~ time | subject, include_half.life = "incl_typo"),
+    regexp = "The include_half.life column ('incl_typo') does not exist in the data",
+    fixed = TRUE
+  )
+  # An existing logical column is unaffected by the existence check
+  o_excl <- PKNCAconc(d_conc, conc ~ time | subject, exclude_half.life = "excl_lgl")
+  expect_equal(o_excl$columns$exclude_half.life, "excl_lgl")
+})

tests/testthat/test-half.life.R

@@ -525,6 +525,57 @@ test_that("half-life has a exclude message when it cannot be calculated for flat
   )
 })
 
+test_that("half-life has an exclude message when no span survives selection (#583)", {
+  # The rising tail (2, 2.2, 2.42) fits perfectly with lambda.z < 0 and anchors
+  # the adjusted r-squared tolerance, so no span with lambda.z > 0 survives.
+  result <- pk.calc.half.life(conc = c(0, 20, 10, 5, 2, 2.2, 2.42), time = 0:6)
+  expect_equal(result$half.life, NA_real_)
+  expect_equal(result$lambda.z, NA_real_)
+  expect_equal(
+    attr(result, "exclude"),
+    "No valid terminal phase: no span with lambda.z > 0 within the adjusted r-squared tolerance of the best fit"
+  )
+})
+
+test_that("the no-surviving-span exclude reason lands in the pk.nca() exclude column (#583)", {
+  d_conc <- data.frame(conc = c(0, 20, 10, 5, 2, 2.2, 2.42), time = 0:6, subject = 1)
+  o_conc <- PKNCAconc(d_conc, conc ~ time | subject)
+  o_data <- PKNCAdata(o_conc, intervals = data.frame(start = 0, end = Inf, half.life = TRUE))
+  o_nca <- suppressMessages(pk.nca(o_data))
+  res <- as.data.frame(o_nca)
+  expect_equal(res$PPORRES[res$PPTESTCD %in% "half.life"], NA_real_)
+  expect_equal(
+    res$exclude[res$PPTESTCD %in% "half.life"],
+    "No valid terminal phase: no span with lambda.z > 0 within the adjusted r-squared tolerance of the best fit"
+  )
+
+  # A normal successful fit carries no exclusion reason
+  d_theoph <- as.data.frame(datasets::Theoph[datasets::Theoph$Subject %in% 1, ])
+  o_conc_norm <- PKNCAconc(d_theoph, conc ~ Time | Subject)
+  o_data_norm <- PKNCAdata(o_conc_norm, intervals = data.frame(start = 0, end = Inf, half.life = TRUE))
+  o_nca_norm <- suppressMessages(pk.nca(o_data_norm))
+  res_norm <- as.data.frame(o_nca_norm)
+  expect_equal(res_norm$PPORRES[res_norm$PPTESTCD %in% "half.life"], 14.30438, tolerance = 0.0001)
+  expect_equal(res_norm$exclude[res_norm$PPTESTCD %in% "half.life"], NA_character_)
+})
+
+test_that("tobit half-life has an exclude message when no span has lambda.z > 0 (#583)", {
+  # Concentrations rise after tmax, so every Tobit span fits lambda.z < 0
+  result <- pk.calc.half.life(
+    conc = c(10, 1, 1.12, 1.19, 1.33, 1.44),
+    time = 0:5,
+    lloq = 0.5,
+    hl_method = "tobit",
+    allow.tmax.in.half.life = FALSE,
+    min.hl.points = 3
+  )
+  expect_equal(result$half.life, NA_real_)
+  expect_equal(
+    attr(result, "exclude"),
+    "No valid terminal phase: no Tobit span with lambda.z > 0"
+  )
+})
+
 # ---- Tobit half-life tests ----
 
 test_that("fit_half_life_tobit_LL returns correct negative log-likelihood", {

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

@@ -398,6 +398,36 @@ test_that("include_half.life and exclude_half.life work with NAs treated as miss
   expect_equal(d_nca_false$PPORRES[d_nca_false$PPTESTCD %in% "half.life"], 1.512942, tolerance = 0.00001)
 })
 
+test_that("non-logical half-life point columns fail loud at calculation time (#583)", {
+  # PKNCAconc() validates at construction, so replace the column afterward to
+  # reach the check in pk.nca()
+  d_conc <-
+    data.frame(
+      conc = c(1, 0.5, 0.25, 0.125, 0.06),
+      time = 0:4,
+      excl = c(NA, NA, NA, TRUE, NA),
+      incl = c(NA, TRUE, TRUE, TRUE, NA),
+      subject = 1
+    )
+  o_conc_excl <- PKNCAconc(d_conc, conc ~ time | subject, exclude_half.life = "excl")
+  o_data_excl <- PKNCAdata(o_conc_excl, intervals = data.frame(start = 0, end = Inf, half.life = TRUE))
+  o_data_excl$conc$data$excl <- ifelse(is.na(d_conc$excl), NA_character_, "yes")
+  expect_error(
+    suppressMessages(pk.nca(o_data_excl)),
+    regexp = "The exclude_half.life column ('excl') must be a logical (TRUE/FALSE/NA) column, not character",
+    fixed = TRUE
+  )
+
+  o_conc_incl <- PKNCAconc(d_conc, conc ~ time | subject, include_half.life = "incl")
+  o_data_incl <- PKNCAdata(o_conc_incl, intervals = data.frame(start = 0, end = Inf, half.life = TRUE))
+  o_data_incl$conc$data$incl <- ifelse(is.na(d_conc$incl), NA_character_, "yes")
+  expect_error(
+    suppressMessages(pk.nca(o_data_incl)),
+    regexp = "The include_half.life column ('incl') must be a logical (TRUE/FALSE/NA) column, not character",
+    fixed = TRUE
+  )
+})
+
 test_that("No interval requested (e.g. for placebo)", {
   tmpconc <- generate.conc(2, 1, 0:24)
   tmpdose <- generate.dose(tmpconc)

vignettes/v06-half-life-calculation.Rmd

@@ -82,8 +82,10 @@ as.data.frame(result_obj)
 
 # Manual Point Selection
 
-For both exclusion and inclusion methods below, the same `NA` handling rules
-apply on a per-interval basis. If all values are `NA`, then no inclusion or
+The `exclude_half.life` and `include_half.life` columns must be logical
+(`TRUE`/`FALSE`/`NA`); a non-logical column (for example, character `"yes"`) is
+an error.  For both exclusion and inclusion methods below, the same `NA`
+handling rules apply on a per-interval basis. If all values are `NA`, then no inclusion or
 exclusion is applied (the interval is treated as-is, like the argument had not
 been given). If some values are `NA` for the interval, those are treated as
 `FALSE`.