diff --git a/NEWS.md b/NEWS.md index d203cdef..73dc6064 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 >50% of the measurements are + BLQ (#579). + * Parameter descriptions in `add.interval.col()` are now limited to 40 characters to comply with SDTM requirements. diff --git a/R/sparse.R b/R/sparse.R index eb62b5c9..e467976e 100644 --- a/R/sparse.R +++ b/R/sparse.R @@ -103,7 +103,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 >50% of the measurements are BLQ, zero. Otherwise, the arithmetic mean of all samples (including the BLQ as zero).} #' } #' #' @inheritParams sparse_pk_attribute @@ -338,7 +338,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) @@ -565,7 +566,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..be1133b1 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 >50\% of the measurements are BLQ, zero. Otherwise, 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 049eec1d..85e66fce 100644 --- a/tests/testthat/test-sparse.R +++ b/tests/testthat/test-sparse.R @@ -287,6 +287,96 @@ test_that("moment means are calculated correctly", { }) +# ============================================================================ +# Per-run options forwarding +# ============================================================================ +# 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 +# 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", { + 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", { + 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 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 # ============================================================================