diff --git a/NEWS.md b/NEWS.md index ec1d0d80..f147140a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -99,6 +99,7 @@ the dosing including dose amount and route. when the issue is due to an excluded point (#310) * The `PKNCAdose` function won't give an error for a missing-time check when the issue is due to an excluded point (#310) * `pk.nca` will calculate `fe` and `clr` even if their dependent parameters (e.g, `ae`) were not requested to be calculated in the intervals (#473) +* sparse calculations won't abort with `pk.nca` when the data contains missing (NA) concentrations. It will silently drop them. ## New features diff --git a/R/sparse.R b/R/sparse.R index dcbb32f6..6bac6f92 100644 --- a/R/sparse.R +++ b/R/sparse.R @@ -14,8 +14,15 @@ as_sparse_pk <- function(conc, time, subject) { subject <- conc$subject conc <- conc$conc } - assert_conc_time(conc = conc, time = time, any_missing_conc = FALSE, sorted_time = FALSE) + assert_conc_time(conc = conc, time = time, any_missing_conc = TRUE, sorted_time = FALSE) checkmate::check_vector(subject, any.missing=FALSE, len=length(conc), null.ok=FALSE) + # Drop observations with missing concentrations so that per-timepoint means, + # variances, and subject counts reflect only available data. + mask_ok <- !is.na(conc) + conc <- conc[mask_ok] + time <- time[mask_ok] + subject <- subject[mask_ok] + unique_times <- sort(unique(time)) ret <- list() for (current_time in unique_times) { @@ -632,4 +639,4 @@ PKNCA.set.summary( description = "arithmetic mean and standard deviation", point = business.mean, spread = business.sd -) \ No newline at end of file +) diff --git a/tests/testthat/test-sparse.R b/tests/testthat/test-sparse.R index e685d09e..98f7cf9d 100644 --- a/tests/testthat/test-sparse.R +++ b/tests/testthat/test-sparse.R @@ -33,6 +33,30 @@ test_that("sparse_auc", { expect_equal(sparse_serial$sparse_auc_df, structure(auclast_df_serial, method=c("AUC: linear", "Sparse: arithmetic mean, <=50% BLQ"))) }) +test_that("as_sparse_pk drops NA concentrations (#563)", { + sparse_pk <- as_sparse_pk( + conc = c(0, 0, 5, 7, 3, NA), + time = c(0, 0, 4, 4, 24, 24), + subject = c(1, 2, 3, 4, 5, 6) + ) + # The NA row (subject 6, time 24) should be dropped + expect_length(sparse_pk, 3) # 3 unique times: 0, 4, 24 + expect_equal(sparse_pk[[3]]$conc, 3) + expect_equal(sparse_pk[[3]]$subject, 5) +}) + +test_that("sparse_auc tolerates NA concentrations (#563)", { + result <- pk.calc.sparse_auc( + conc = c(0, 0, 5, 7, 3, NA), + time = c(0, 0, 4, 4, 24, 24), + subject = 1:6 + ) + expect_false(is.na(result$sparse_auc)) + # Mean profile: time 0 = 0, time 4 = 6, time 24 = 3 + # AUC linear: 0.5*(0+6)*4 + 0.5*(6+3)*20 = 12 + 90 = 102 + expect_equal(as.numeric(result$sparse_auc), 102) +}) + test_that("sparse_auclast expected errors", { expect_error( pk.calc.sparse_auclast(auc.type = "foo"),