From c7d95510367da6f0261a475086bde86402fe9185 Mon Sep 17 00:00:00 2001 From: Bill Denney Date: Sun, 9 Aug 2026 11:37:56 -0400 Subject: [PATCH 1/2] fix: forward per-run options into sparse AUC calculation pk.calc.sparse_auc() and pk.calc.sparse_aumc() accepted an options argument but did not pass it to the mean-profile integration (pk.calc.auc()/pk.calc.aumc()), so per-PKNCAdata options such as conc.blq had no effect on sparse parameters while global PKNCA.options() settings did (issue 579). The pk.nca() interval machinery already delivers the merged options to the sparse parameter functions via their options formal, so forwarding the argument inside sparse.R completes the chain. Also correct the sparse_mean() documentation: a timepoint mean is zeroed when strictly more than 50% of the measurements are BLQ, matching the code; exactly 50% BLQ is not zeroed. The zeroing rule itself is unchanged, and results under default options are unchanged. Co-Authored-By: Claude Fable 5 --- NEWS.md | 8 ++++ R/sparse.R | 8 ++-- man/sparse_mean.Rd | 2 +- tests/testthat/test-sparse.R | 90 ++++++++++++++++++++++++++++++++++++ 4 files changed, 104 insertions(+), 4 deletions(-) diff --git a/NEWS.md b/NEWS.md index 563fa773..1e92ef0e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,14 @@ the dosing including dose amount and route. # Development version +* Bug fix: `pk.calc.sparse_auc()` and `pk.calc.sparse_aumc()` now use their + `options` argument when integrating the mean concentration-time profile, so + per-run options (e.g. `PKNCAdata(options = list(conc.blq = "keep"))`) affect + sparse AUC and AUMC calculations the same way global `PKNCA.options()` + settings always did. The documentation for `sparse_mean()` now correctly + states that a timepoint mean is zeroed when strictly more than 50% of the + measurements are BLQ (#579). + * Bug fix: `pk.nca()` no longer errors on unsorted concentration-time data. Group-level concentration data are now sorted by time before calculation, so parameters that use the full group (e.g. `aucint.all` and the other `aucint*` diff --git a/R/sparse.R b/R/sparse.R index dcbb32f6..b396e181 100644 --- a/R/sparse.R +++ b/R/sparse.R @@ -91,7 +91,7 @@ sparse_auc_weight_linear <- function(sparse_pk) { #' #' \describe{ #' \item{"arithmetic mean"}{Arithmetic mean (ignoring number of BLQ samples)} -#' \item{"arithmetic mean, <=50% BLQ"}{If >= 50% of the measurements are BLQ, zero. Otherwise, the arithmetic mean of all samples (including the BLQ as zero).} +#' \item{"arithmetic mean, <=50% BLQ"}{If strictly more than 50% of the measurements are BLQ, zero. Otherwise (including exactly 50% BLQ), the arithmetic mean of all samples (including the BLQ as zero).} #' } #' #' @inheritParams sparse_pk_attribute @@ -323,7 +323,8 @@ pk.calc.sparse_auc <- function(conc, time, subject, conc=sparse_pk_attribute(sparse_pk_mean, "mean"), time=sparse_pk_attribute(sparse_pk_mean, "time"), auc.type=auc.type, - method=method + method=method, + options=options ) var_auc <- var_sparse_auc(sparse_pk_mean) @@ -553,7 +554,8 @@ pk.calc.sparse_aumc <- function(conc, time, subject, conc = sparse_pk_attribute(sparse_pk_mean, "mean"), time = sparse_pk_attribute(sparse_pk_mean, "time"), auc.type = auc.type, - method = method + method = method, + options = options ) # Calculate variance on MOMENT data (this is where the fix matters) diff --git a/man/sparse_mean.Rd b/man/sparse_mean.Rd index f7d83b3f..2fd437a5 100644 --- a/man/sparse_mean.Rd +++ b/man/sparse_mean.Rd @@ -27,7 +27,7 @@ are: \details{ \describe{ \item{"arithmetic mean"}{Arithmetic mean (ignoring number of BLQ samples)} -\item{"arithmetic mean, <=50\% BLQ"}{If >= 50\% of the measurements are BLQ, zero. Otherwise, the arithmetic mean of all samples (including the BLQ as zero).} +\item{"arithmetic mean, <=50\% BLQ"}{If strictly more than 50\% of the measurements are BLQ, zero. Otherwise (including exactly 50\% BLQ), the arithmetic mean of all samples (including the BLQ as zero).} } } \seealso{ diff --git a/tests/testthat/test-sparse.R b/tests/testthat/test-sparse.R index e685d09e..7d9f563c 100644 --- a/tests/testthat/test-sparse.R +++ b/tests/testthat/test-sparse.R @@ -263,6 +263,96 @@ test_that("moment means are calculated correctly", { }) +# ============================================================================ +# Per-run options forwarding (#579) +# ============================================================================ +# Shared setup for the #579 tests: serial sparse design with 3 animals per +# timepoint. At t=2, 2 of 3 measurements are BLQ (strictly more than 50%), so +# sparse_mean zeroes that timepoint and the mean profile is +# (0,0), (1,3), (2,0), (3,2). The default conc.blq (middle = "drop") drops the +# middle zero before integration (AUClast = 6.5); conc.blq = "keep" keeps it +# (AUClast = 4). +d_sparse_579 <- + data.frame( + id = 1:12, + conc = c(0, 0, 0, 2, 3, 4, 0, 0, 1.5, 1, 2, 3), + time = c(0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 3) + ) + +test_that("pk.calc.sparse_auc and pk.calc.sparse_aumc use their options argument for the mean-profile integration (#579)", { + r_default <- + pk.calc.sparse_auclast( + conc = d_sparse_579$conc, time = d_sparse_579$time, subject = d_sparse_579$id + ) + r_keep <- + pk.calc.sparse_auclast( + conc = d_sparse_579$conc, time = d_sparse_579$time, subject = d_sparse_579$id, + options = list(conc.blq = "keep") + ) + expect_equal(as.numeric(r_default$sparse_auclast), 6.5) + expect_equal(as.numeric(r_keep$sparse_auclast), 4) + # The sparse AUC variance is calculated from the individual measurements and + # weights, not the cleaned mean profile, so it is unaffected by conc.blq + expect_equal(as.numeric(r_default$sparse_auc_se), as.numeric(r_keep$sparse_auc_se)) + + # The same forwarding applies to the sparse AUMC. Moment profile: + # t*C = (0,0), (1,3), (2,0), (3,6); default drops the middle zero + # concentration (AUMClast = 10.5); conc.blq = "keep" keeps it (AUMClast = 6). + ra_default <- + pk.calc.sparse_aumclast( + conc = d_sparse_579$conc, time = d_sparse_579$time, subject = d_sparse_579$id + ) + ra_keep <- + pk.calc.sparse_aumclast( + conc = d_sparse_579$conc, time = d_sparse_579$time, subject = d_sparse_579$id, + options = list(conc.blq = "keep") + ) + expect_equal(as.numeric(ra_default$sparse_aumclast), 10.5) + expect_equal(as.numeric(ra_keep$sparse_aumclast), 6) +}) + +test_that("per-PKNCAdata options affect sparse_auclast and match the global-option route (#579)", { + o_conc <- PKNCAconc(d_sparse_579, conc ~ time | id, sparse = TRUE) + d_intervals <- data.frame(start = 0, end = 3, sparse_auclast = TRUE) + o_data_default <- PKNCAdata(o_conc, intervals = d_intervals) + o_data_keep <- PKNCAdata(o_conc, intervals = d_intervals, options = list(conc.blq = "keep")) + res_default <- as.data.frame(suppressMessages(pk.nca(o_data_default, verbose = FALSE))) + res_keep <- as.data.frame(suppressMessages(pk.nca(o_data_keep, verbose = FALSE))) + expect_equal( + res_default$PPORRES[res_default$PPTESTCD %in% "sparse_auclast"], + 6.5 + ) + expect_equal( + res_keep$PPORRES[res_keep$PPTESTCD %in% "sparse_auclast"], + 4 + ) + + # The global-option route still works and now matches the per-run route + old_conc.blq <- PKNCA.options("conc.blq") + on.exit(PKNCA.options(conc.blq = old_conc.blq)) + PKNCA.options(conc.blq = "keep") + res_global <- as.data.frame(suppressMessages(pk.nca(o_data_default, verbose = FALSE))) + expect_equal( + res_global$PPORRES[res_global$PPTESTCD %in% "sparse_auclast"], + 4 + ) +}) + +test_that("sparse_mean does not zero a timepoint with exactly 50% BLQ", { + # Exactly 50% BLQ: the arithmetic mean is used (BLQ values count as zero) + sparse_pk_half <- as_sparse_pk(conc = c(0, 0, 2, 4), time = rep(1, 4), subject = 1:4) + expect_equal( + sparse_pk_attribute(sparse_mean(sparse_pk_half), "mean"), + 1.5 + ) + # Strictly more than 50% BLQ: the mean is zeroed + sparse_pk_most <- as_sparse_pk(conc = c(0, 0, 0, 4), time = rep(1, 4), subject = 1:4) + expect_equal( + sparse_pk_attribute(sparse_mean(sparse_pk_most), "mean"), + 0 + ) +}) + # ============================================================================ # Integration Tests # ============================================================================ From 2c4e8908a53497db99b265b944cc7a6fc15c2210 Mon Sep 17 00:00:00 2001 From: Bill Denney Date: Mon, 10 Aug 2026 08:52:58 -0400 Subject: [PATCH 2/2] docs: comments state the test rationale, not its source Co-Authored-By: Claude Fable 5 --- tests/testthat/test-sparse.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-sparse.R b/tests/testthat/test-sparse.R index 7d9f563c..427d75b8 100644 --- a/tests/testthat/test-sparse.R +++ b/tests/testthat/test-sparse.R @@ -264,9 +264,9 @@ test_that("moment means are calculated correctly", { # ============================================================================ -# Per-run options forwarding (#579) +# Per-run options forwarding # ============================================================================ -# Shared setup for the #579 tests: serial sparse design with 3 animals per +# Shared setup: serial sparse design with 3 animals per # timepoint. At t=2, 2 of 3 measurements are BLQ (strictly more than 50%), so # sparse_mean zeroes that timepoint and the mean profile is # (0,0), (1,3), (2,0), (3,2). The default conc.blq (middle = "drop") drops the @@ -279,7 +279,7 @@ d_sparse_579 <- time = c(0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 3) ) -test_that("pk.calc.sparse_auc and pk.calc.sparse_aumc use their options argument for the mean-profile integration (#579)", { +test_that("pk.calc.sparse_auc and pk.calc.sparse_aumc use their options argument for the mean-profile integration", { r_default <- pk.calc.sparse_auclast( conc = d_sparse_579$conc, time = d_sparse_579$time, subject = d_sparse_579$id @@ -311,7 +311,7 @@ test_that("pk.calc.sparse_auc and pk.calc.sparse_aumc use their options argument expect_equal(as.numeric(ra_keep$sparse_aumclast), 6) }) -test_that("per-PKNCAdata options affect sparse_auclast and match the global-option route (#579)", { +test_that("per-PKNCAdata options affect sparse_auclast and match the global-option route", { o_conc <- PKNCAconc(d_sparse_579, conc ~ time | id, sparse = TRUE) d_intervals <- data.frame(start = 0, end = 3, sparse_auclast = TRUE) o_data_default <- PKNCAdata(o_conc, intervals = d_intervals) @@ -327,7 +327,7 @@ test_that("per-PKNCAdata options affect sparse_auclast and match the global-opti 4 ) - # The global-option route still works and now matches the per-run route + # The global-option route matches the per-run route old_conc.blq <- PKNCA.options("conc.blq") on.exit(PKNCA.options(conc.blq = old_conc.blq)) PKNCA.options(conc.blq = "keep")