From d3a357693572809eb16ca30764fe7cec1c4159d9 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Mon, 27 Oct 2025 07:02:04 +0100 Subject: [PATCH 01/12] draft: funs for ertlst, ermax, ertmax --- R/pk.calc.urine.R | 117 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 117 insertions(+) diff --git a/R/pk.calc.urine.R b/R/pk.calc.urine.R index 3dcf2310..ce8d7e9d 100644 --- a/R/pk.calc.urine.R +++ b/R/pk.calc.urine.R @@ -133,3 +133,120 @@ PKNCA.set.summary( point=business.geomean, spread=business.geocv ) + +#' Calculate the midpoint collection time of the last measurable excretion rate +#' +#' @param conc The concentration in the excreta (e.g., urine or feces) +#' @param volume The volume (or mass) of the sample +#' @param time The starting time of the collection interval +#' @param duration.conc The duration of the collection interval +#' @param check Should the concentration and time data be checked? +#' @return The midpoint collection time of the last measurable excretion rate, or NA/0 if not available +#' @export +pk.calc.ertlst <- function(conc, volume, time, duration.conc, check = TRUE) { + if (check) { + assert_conc_time(conc = conc, time = time) + } + if (all(is.na(conc))) { + NA_real_ + } else if (all(conc %in% c(0, NA))) { + 0 + } else { + er <- conc * volume / duration.conc + midtime <- time + duration.conc / 2 + max(midtime[!(conc %in% c(NA, 0))]) + } +} + +# Add the column to the interval specification +add.interval.col("ertlst", + FUN="pk.calc.ertlst", + unit_type="time", + pretty_name="Tlast excretion rate", + desc="The midpoint collection time of the last measurable excretion rate (typically in urine or feces)") + +PKNCA.set.summary( + name="ertlst", + description="median and range", + point=business.median, + spread=business.range +) + +#' Calculate the maximum excretion rate +#' +#' @param conc The concentration in the excreta (e.g., urine or feces) +#' @param volume The volume (or mass) of the sample +#' @param time The starting time of the collection interval +#' @param duration.conc The duration of the collection interval +#' @param check Should the concentration data be checked? +#' @return The maximum excretion rate, or NA if not available +#' @export +pk.calc.ermax <- function(conc, volume, time, duration.conc, check = TRUE) { + if (check) { + assert_conc(conc = conc) + } + if (length(conc) == 0 | all(is.na(conc))) { + NA + } else { + er <- conc * volume / duration.conc + max(er, na.rm=TRUE) + } +} + +add.interval.col("ermax", + FUN="pk.calc.ermax", + unit_type="amount_time", + pretty_name="Maximum excretion rate", + desc="The maximum excretion rate (typically in urine or feces)") + +PKNCA.set.summary( + name="ermax", + description="geometric mean and geometric coefficient of variation", + point=business.geomean, + spread=business.geocv +) + +#' Calculate the midpoint collection time of the maximum excretion rate +#' +#' @param conc The concentration in the excreta (e.g., urine or feces) +#' @param volume The volume (or mass) of the sample +#' @param time The starting time of the collection interval +#' @param duration.conc The duration of the collection interval +#' @param check Should the concentration and time data be checked? +#' @param first.tmax If TRUE, return the first time of maximum excretion rate; otherwise, return the last +#' @return The midpoint collection time of the maximum excretion rate, or NA if not available +#' @export +pk.calc.ertmax <- function(conc, volume, time, duration.conc, check = TRUE, first.tmax = NULL) { + + if (check) { + assert_conc_time(conc = conc, time = time) + } + + if (length(conc) == 0 | all(conc %in% c(NA, 0))) { + NA + } else { + er <- conc * volume / duration.conc + ermax <- pk.calc.ermax(conc, volume, time, duration.conc, check = FALSE) + midtime <- time + duration.conc / 2 + ret <- midtime[er %in% ermax] + + if (first.tmax) { + ret[1] + } else { + ret[length(ret)] + } + } +} + +add.interval.col("ertmax", + FUN="pk.calc.ertmax", + unit_type="time", + pretty_name="Tmax excretion rate", + desc="The midpoint collection time of the maximum excretion rate (typically in urine or feces)") + +PKNCA.set.summary( + name="ertmax", + description="median and range", + point=business.median, + spread=business.range +) From d8690fb0ddf0766d70e131957f0d073111efe4e9 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Mon, 27 Oct 2025 07:02:27 +0100 Subject: [PATCH 02/12] test: add tests for ermax, ertmax, ertlst --- tests/testthat/test-pk.calc.urine.R | 46 +++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/tests/testthat/test-pk.calc.urine.R b/tests/testthat/test-pk.calc.urine.R index 2fb7b91a..a7df64de 100644 --- a/tests/testthat/test-pk.calc.urine.R +++ b/tests/testthat/test-pk.calc.urine.R @@ -53,3 +53,49 @@ test_that("pk.calc.fe", { 0.3, info="fe is calculated correctly with both vector/scalar") }) + +test_that("pk.calc.ertlst", { + # All NA + expect_true(is.na(pk.calc.ertlst(conc = c(NA, NA), volume = c(1, 1), time = c(0, 1), duration.conc = c(1, 1)))) + # All 0 or NA + expect_equal(pk.calc.ertlst(conc = c(0, NA), volume = c(1, 1), time = c(0, 1), duration.conc = c(1, 1)), 0) + # Normal case + expect_equal( + pk.calc.ertlst(conc = c(1, 2, 0), volume = c(1, 1, 1), time = c(0, 1, 2), duration.conc = c(1, 1, 1)), + max(c(0, 1) + 1/2) + ) +}) + +test_that("pk.calc.ermax", { + # All NA + expect_true(is.na(pk.calc.ermax(conc = c(NA, NA), volume = c(1, 1), time = c(0, 1), duration.conc = c(1, 1)))) + # Normal case + expect_equal( + pk.calc.ermax(conc = c(1, 2, 3), volume = c(2, 2, 2), time = c(0, 1, 2), duration.conc = c(2, 2, 2)), + max(c(1, 2, 3) * 2 / 2) + ) +}) + +test_that("pk.calc.ertmax", { + # All NA or 0 + expect_true(is.na(pk.calc.ertmax(conc = c(NA, 0), volume = c(1, 1), time = c(0, 1), duration.conc = c(1, 1)))) + # Normal case, last tmax + expect_equal( + pk.calc.ertmax(conc = c(1, 3, 2), volume = c(2, 2, 2), time = c(0, 1, 2), duration.conc = c(2, 2, 2), first.tmax = FALSE), + (1 + 2/2) + ) + # Normal case, first tmax + expect_equal( + pk.calc.ertmax(conc = c(1, 3, 2), volume = c(2, 2, 2), time = c(0, 1, 2), duration.conc = c(2, 2, 2), first.tmax = TRUE), + (1 + 2/2) + ) + # Multiple maxima + expect_equal( + pk.calc.ertmax(conc = c(1, 3, 3), volume = c(2, 2, 2), time = c(0, 1, 2), duration.conc = c(2, 2, 2), first.tmax = TRUE), + (1 + 2/2) + ) + expect_equal( + pk.calc.ertmax(conc = c(1, 3, 3), volume = c(2, 2, 2), time = c(0, 1, 2), duration.conc = c(2, 2, 2), first.tmax = FALSE), + (2 + 2/2) + ) +}) From c0d37c3ad01aaa7c882aa81d6076c278a918e672 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Mon, 27 Oct 2025 07:03:22 +0100 Subject: [PATCH 03/12] add new unit type in add.interval.col for ER (amount_time) --- R/001-add.interval.col.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/001-add.interval.col.R b/R/001-add.interval.col.R index 82c2cfc2..ca9c2d7f 100644 --- a/R/001-add.interval.col.R +++ b/R/001-add.interval.col.R @@ -114,9 +114,9 @@ add.interval.col <- function(name, choices=c( "unitless", "fraction", "%", "count", "time", "inverse_time", - "amount", "amount_dose", + "amount", "amount_dose", "amount_time", "conc", "conc_dosenorm", - "dose", + "dose", "volume", "auc", "aumc", "auc_dosenorm", "aumc_dosenorm", From 1f4851e9988aea83da31382b9b0d36d6d677f440 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Mon, 27 Oct 2025 07:03:54 +0100 Subject: [PATCH 04/12] news: include new ER parameters in NEWS --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS.md b/NEWS.md index 2da1b658..e7748ca9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -16,6 +16,9 @@ the dosing including dose amount and route. * `pk.calc.half.life()` now returns also `lambda.z.corrxy`, the correlation between the time and the log-concentration of the lambda z points. +* New excretion rate parameters: `ermax` (Maximum excretion rate), `ertmax` (Midpoint time + of maximum excretion rate) and `ertlst` (Time of last excretion rate measurement) (#433) + # PKNCA 0.12.1 ## Minor changes (unlikely to affect PKNCA use) From 13eedd7b18f7e317345d31ba29a5e81817c8826f Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Fri, 31 Oct 2025 13:25:44 +0100 Subject: [PATCH 05/12] refactor check in pk.calc.ae and use it for new funs with volume --- R/pk.calc.urine.R | 142 ++++++++++++++++++++++++++++++++-------------- 1 file changed, 99 insertions(+), 43 deletions(-) diff --git a/R/pk.calc.urine.R b/R/pk.calc.urine.R index ce8d7e9d..ba1fe6ab 100644 --- a/R/pk.calc.urine.R +++ b/R/pk.calc.urine.R @@ -11,29 +11,12 @@ #' @seealso [pk.calc.clr()], [pk.calc.fe()] #' @export pk.calc.ae <- function(conc, volume, check=TRUE) { - mask_missing_conc <- is.na(conc) - mask_missing_vol <- is.na(volume) - mask_missing_both <- mask_missing_conc & mask_missing_vol - mask_missing_conc <- mask_missing_conc & !mask_missing_both - mask_missing_vol <- mask_missing_vol & !mask_missing_both - message_both <- message_conc <- message_vol <- NA_character_ - if (all(mask_missing_both)) { - message_both <- "All concentrations and volumes are missing" - } else if (any(mask_missing_both)) { - message_both <- sprintf("%g of %g concentrations and volumes are missing", sum(mask_missing_both), length(conc)) - } - if (all(mask_missing_conc)) { - message_conc <- "All concentrations are missing" - } else if (any(mask_missing_conc)) { - message_conc <- sprintf("%g of %g concentrations are missing", sum(mask_missing_conc), length(conc)) - } - if (all(mask_missing_vol)) { - message_vol <- "All volumes are missing" - } else if (any(mask_missing_vol)) { - message_vol <- sprintf("%g of %g volumes are missing", sum(mask_missing_vol), length(conc)) - } - message_all <- stats::na.omit(c(message_both, message_conc, message_vol)) - ret <- sum(conc*volume) + # Generate combined missing-data messages for conc/volume using helper + message_all <- .generate_missing_messages(conc, volume, + name_a = "concentrations", + name_b = "volumes") + + ret <- sum(conc * volume) if (length(message_all) != 0) { message <- paste(message_all, collapse = "; ") ret <- structure(ret, exclude = message) @@ -144,18 +127,27 @@ PKNCA.set.summary( #' @return The midpoint collection time of the last measurable excretion rate, or NA/0 if not available #' @export pk.calc.ertlst <- function(conc, volume, time, duration.conc, check = TRUE) { - if (check) { - assert_conc_time(conc = conc, time = time) - } + + # Generate messages about missing concentrations/volumes + message_all <- .generate_missing_messages(conc, volume, + name_a = "concentrations", + name_b = "volumes") + if (all(is.na(conc))) { - NA_real_ + ret <- NA_real_ } else if (all(conc %in% c(0, NA))) { - 0 + ret <- 0 } else { - er <- conc * volume / duration.conc + midtime <- time + duration.conc / 2 midtime <- time + duration.conc / 2 - max(midtime[!(conc %in% c(NA, 0))]) + ret <- max(midtime[!(conc %in% c(NA, 0))]) } + + if (length(message_all) != 0) { + message <- paste(message_all, collapse = "; ") + ret <- structure(ret, exclude = message) + } + ret } # Add the column to the interval specification @@ -182,15 +174,24 @@ PKNCA.set.summary( #' @return The maximum excretion rate, or NA if not available #' @export pk.calc.ermax <- function(conc, volume, time, duration.conc, check = TRUE) { - if (check) { - assert_conc(conc = conc) - } - if (length(conc) == 0 | all(is.na(conc))) { - NA + + # Generate messages about missing concentrations/volumes + message_all <- .generate_missing_messages(conc, volume, + name_a = "concentrations", + name_b = "volumes") + + if (length(conc) == 0 || all(is.na(conc))) { + ret <- NA } else { er <- conc * volume / duration.conc - max(er, na.rm=TRUE) + ret <- max(er, na.rm=TRUE) } + + if (length(message_all) != 0) { + message <- paste(message_all, collapse = "; ") + ret <- structure(ret, exclude = message) + } + ret } add.interval.col("ermax", @@ -218,12 +219,13 @@ PKNCA.set.summary( #' @export pk.calc.ertmax <- function(conc, volume, time, duration.conc, check = TRUE, first.tmax = NULL) { - if (check) { - assert_conc_time(conc = conc, time = time) - } + # Generate messages about missing concentrations/volumes + message_all <- .generate_missing_messages(conc, volume, + name_a = "concentrations", + name_b = "volumes") - if (length(conc) == 0 | all(conc %in% c(NA, 0))) { - NA + if (length(conc) == 0 || all(conc %in% c(NA, 0))) { + ret <- NA } else { er <- conc * volume / duration.conc ermax <- pk.calc.ermax(conc, volume, time, duration.conc, check = FALSE) @@ -231,11 +233,17 @@ pk.calc.ertmax <- function(conc, volume, time, duration.conc, check = TRUE, firs ret <- midtime[er %in% ermax] if (first.tmax) { - ret[1] + ret <- ret[1] } else { - ret[length(ret)] + ret <- ret[length(ret)] } } + + if (length(message_all) != 0) { + message <- paste(message_all, collapse = "; ") + ret <- structure(ret, exclude = message) + } + ret } add.interval.col("ertmax", @@ -250,3 +258,51 @@ PKNCA.set.summary( point=business.median, spread=business.range ) + + + +# Helper to generate missing-data checking messages for paired vectors +# +# This function accepts two columns/vectors (for example, concentrations +# and volumes). It computes missingness internally and produces a character +# vector of human-readable messages describing the missingness that matches +# the style used in the package (used previously in `pk.calc.ae`). +.generate_missing_messages <- function(a, b, + name_a = "concentrations", + name_b = "volumes") { + + if (length(a) != length(b)) { + stop("'a' and 'b' must have the same length") + } + + mask_a <- is.na(a) + mask_b <- is.na(b) + + mask_both <- mask_a & mask_b + mask_a_only <- mask_a & !mask_both + mask_b_only <- mask_b & !mask_both + + msg_both <- msg_a <- msg_b <- NA_character_ + n <- length(mask_a) + + if (all(mask_both)) { + msg_both <- sprintf("All %s and %s are missing", name_a, name_b) + } else if (any(mask_both)) { + msg_both <- sprintf("%g of %g %s and %s are missing", sum(mask_both), n, name_a, name_b) + } + + if (all(mask_a_only)) { + msg_a <- sprintf("All %s are missing", name_a) + } else if (any(mask_a_only)) { + msg_a <- sprintf("%g of %g %s are missing", sum(mask_a_only), n, name_a) + } + + if (all(mask_b_only)) { + msg_b <- sprintf("All %s are missing", name_b) + } else if (any(mask_b_only)) { + msg_b <- sprintf("%g of %g %s are missing", sum(mask_b_only), n, name_b) + } + + # Return non-NA messages + stats::na.omit(c(msg_both, msg_a, msg_b)) +} \ No newline at end of file From cceb7f8b46b078660d7665cb5730e9a37da9118e Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Fri, 31 Oct 2025 13:26:03 +0100 Subject: [PATCH 06/12] test: include check for missing volume and/or conc --- tests/testthat/test-pk.calc.urine.R | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-pk.calc.urine.R b/tests/testthat/test-pk.calc.urine.R index a7df64de..389360f4 100644 --- a/tests/testthat/test-pk.calc.urine.R +++ b/tests/testthat/test-pk.calc.urine.R @@ -56,9 +56,19 @@ test_that("pk.calc.fe", { test_that("pk.calc.ertlst", { # All NA - expect_true(is.na(pk.calc.ertlst(conc = c(NA, NA), volume = c(1, 1), time = c(0, 1), duration.conc = c(1, 1)))) + expect_equal( + pk.calc.ertlst(conc = c(NA, NA), volume = c(1, 1), time = c(0, 1), duration.conc = c(1, 1)), + structure(NA_real_, exclude = "All concentrations are missing") + ) + expect_equal( + pk.calc.ertlst(conc = c(NA, NA), volume = c(NA, NA), time = c(0, 1), duration.conc = c(1, 1)), + structure(NA_real_, exclude = "All concentrations and volumes are missing") + ) # All 0 or NA - expect_equal(pk.calc.ertlst(conc = c(0, NA), volume = c(1, 1), time = c(0, 1), duration.conc = c(1, 1)), 0) + expect_equal( + pk.calc.ertlst(conc = c(0, NA), volume = c(1, 1), time = c(0, 1), duration.conc = c(1, 1)), + structure(0, exclude = "1 of 2 concentrations are missing") + ) # Normal case expect_equal( pk.calc.ertlst(conc = c(1, 2, 0), volume = c(1, 1, 1), time = c(0, 1, 2), duration.conc = c(1, 1, 1)), @@ -68,7 +78,10 @@ test_that("pk.calc.ertlst", { test_that("pk.calc.ermax", { # All NA - expect_true(is.na(pk.calc.ermax(conc = c(NA, NA), volume = c(1, 1), time = c(0, 1), duration.conc = c(1, 1)))) + expect_equal( + pk.calc.ermax(conc = c(NA, NA), volume = c(1, 1), time = c(0, 1), duration.conc = c(1, 1)), + structure(NA, exclude = "All concentrations are missing") + ) # Normal case expect_equal( pk.calc.ermax(conc = c(1, 2, 3), volume = c(2, 2, 2), time = c(0, 1, 2), duration.conc = c(2, 2, 2)), @@ -78,7 +91,10 @@ test_that("pk.calc.ermax", { test_that("pk.calc.ertmax", { # All NA or 0 - expect_true(is.na(pk.calc.ertmax(conc = c(NA, 0), volume = c(1, 1), time = c(0, 1), duration.conc = c(1, 1)))) + expect_equal( + pk.calc.ertmax(conc = c(NA, 0), volume = c(1, 1), time = c(0, 1), duration.conc = c(1, 1)), + structure(NA, exclude = "1 of 2 concentrations are missing") + ) # Normal case, last tmax expect_equal( pk.calc.ertmax(conc = c(1, 3, 2), volume = c(2, 2, 2), time = c(0, 1, 2), duration.conc = c(2, 2, 2), first.tmax = FALSE), From c9b82652a6cf18ef4dae360ffce4ac3d3e6a5e03 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Fri, 31 Oct 2025 13:27:14 +0100 Subject: [PATCH 07/12] rm length checking in check fun (was not before) --- R/pk.calc.urine.R | 4 ---- 1 file changed, 4 deletions(-) diff --git a/R/pk.calc.urine.R b/R/pk.calc.urine.R index ba1fe6ab..a4fddb84 100644 --- a/R/pk.calc.urine.R +++ b/R/pk.calc.urine.R @@ -271,10 +271,6 @@ PKNCA.set.summary( name_a = "concentrations", name_b = "volumes") { - if (length(a) != length(b)) { - stop("'a' and 'b' must have the same length") - } - mask_a <- is.na(a) mask_b <- is.na(b) From 811c48333d962b883499e2d6ed785d383bfaae4c Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Fri, 31 Oct 2025 14:19:18 +0100 Subject: [PATCH 08/12] fix: add amount_time in units to support (pknca_units_table_time_amount) --- R/unit-support.R | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/R/unit-support.R b/R/unit-support.R index 7ea15bf1..9b0a949d 100644 --- a/R/unit-support.R +++ b/R/unit-support.R @@ -77,6 +77,7 @@ pknca_units_table <- function(concu, doseu, amountu, timeu, pknca_units_table_dose(doseu = doseu), pknca_units_table_conc_dose(concu=concu, doseu=doseu), pknca_units_table_conc_time(concu=concu, timeu=timeu), + pknca_units_table_time_amount(timeu=timeu, amountu=amountu), pknca_units_table_conc_time_dose(concu=concu, timeu=timeu, doseu=doseu), pknca_units_table_conc_time_amount(concu=concu, timeu=timeu, amountu=amountu) ) @@ -366,6 +367,20 @@ pknca_units_table_conc_time_amount <- function(concu, timeu, amountu) { ) } + +pknca_units_table_time_amount <- function(timeu, amountu) { + if (useless(timeu) || useless(amountu)) { + time_amount <- NA_character_ + } else { + time_amount <- sprintf("%s*%s", timeu, amountu) + } + data.frame( + PPORRESU = time_amount, + PPTESTCD = pknca_find_units_param(unit_type = "amount_time"), + stringsAsFactors = FALSE + ) +} + #' Find NCA parameters with a given unit type #' #' @param unit_type The type of unit as assigned with `add.interval.col` From cda8303d417365b739a0e6fd3421272ec1e1ad62 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Tue, 11 Nov 2025 06:59:00 +0100 Subject: [PATCH 09/12] replace: .generate_missing_messages > generate_missing_messages --- R/pk.calc.urine.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/pk.calc.urine.R b/R/pk.calc.urine.R index a4fddb84..cd5ec92c 100644 --- a/R/pk.calc.urine.R +++ b/R/pk.calc.urine.R @@ -12,7 +12,7 @@ #' @export pk.calc.ae <- function(conc, volume, check=TRUE) { # Generate combined missing-data messages for conc/volume using helper - message_all <- .generate_missing_messages(conc, volume, + message_all <- generate_missing_messages(conc, volume, name_a = "concentrations", name_b = "volumes") @@ -129,7 +129,7 @@ PKNCA.set.summary( pk.calc.ertlst <- function(conc, volume, time, duration.conc, check = TRUE) { # Generate messages about missing concentrations/volumes - message_all <- .generate_missing_messages(conc, volume, + message_all <- generate_missing_messages(conc, volume, name_a = "concentrations", name_b = "volumes") @@ -176,7 +176,7 @@ PKNCA.set.summary( pk.calc.ermax <- function(conc, volume, time, duration.conc, check = TRUE) { # Generate messages about missing concentrations/volumes - message_all <- .generate_missing_messages(conc, volume, + message_all <- generate_missing_messages(conc, volume, name_a = "concentrations", name_b = "volumes") @@ -220,7 +220,7 @@ PKNCA.set.summary( pk.calc.ertmax <- function(conc, volume, time, duration.conc, check = TRUE, first.tmax = NULL) { # Generate messages about missing concentrations/volumes - message_all <- .generate_missing_messages(conc, volume, + message_all <- generate_missing_messages(conc, volume, name_a = "concentrations", name_b = "volumes") @@ -267,7 +267,7 @@ PKNCA.set.summary( # and volumes). It computes missingness internally and produces a character # vector of human-readable messages describing the missingness that matches # the style used in the package (used previously in `pk.calc.ae`). -.generate_missing_messages <- function(a, b, +generate_missing_messages <- function(a, b, name_a = "concentrations", name_b = "volumes") { From 346456a2d0a2465616632f9a77bbd4c72e75daa1 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Mon, 24 Nov 2025 06:22:49 +0100 Subject: [PATCH 10/12] make by default name_a and name_b the deparsed substitute of a and b --- R/pk.calc.urine.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/pk.calc.urine.R b/R/pk.calc.urine.R index cd5ec92c..eaaf88d1 100644 --- a/R/pk.calc.urine.R +++ b/R/pk.calc.urine.R @@ -268,9 +268,9 @@ PKNCA.set.summary( # vector of human-readable messages describing the missingness that matches # the style used in the package (used previously in `pk.calc.ae`). generate_missing_messages <- function(a, b, - name_a = "concentrations", - name_b = "volumes") { - + name_a = deparse(substitute(a)), + name_b = deparse(substitute(b))) { + mask_a <- is.na(a) mask_b <- is.na(b) @@ -301,4 +301,4 @@ generate_missing_messages <- function(a, b, # Return non-NA messages stats::na.omit(c(msg_both, msg_a, msg_b)) -} \ No newline at end of file +} From af47e72f8e1c41ce9403d88afed198e660916018 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Mon, 24 Nov 2025 06:34:51 +0100 Subject: [PATCH 11/12] fix merge --- R/unit-support.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/unit-support.R b/R/unit-support.R index 51df19ef..74982d4a 100644 --- a/R/unit-support.R +++ b/R/unit-support.R @@ -368,7 +368,6 @@ pknca_units_table_conc_time_amount <- function(concu, timeu, amountu) { ) } - pknca_units_table_time_amount <- function(timeu, amountu) { if (useless(timeu) || useless(amountu)) { time_amount <- NA_character_ @@ -379,6 +378,9 @@ pknca_units_table_time_amount <- function(timeu, amountu) { PPORRESU = time_amount, PPTESTCD = pknca_find_units_param(unit_type = "amount_time"), stringsAsFactors = FALSE + ) +} + pknca_units_table_conc_time_amount_dose <- function(concu, timeu, amountu, doseu) { if (useless(concu) || useless(timeu) || useless(amountu) || useless(doseu)) { renal_clearance_dosenorm <- NA_character_ From 9d811b4fa96352f649311a3381a4324409df4999 Mon Sep 17 00:00:00 2001 From: Bill Denney Date: Mon, 24 Nov 2025 11:35:58 -0500 Subject: [PATCH 12/12] Add specific test for message text --- tests/testthat/test-pk.calc.urine.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/tests/testthat/test-pk.calc.urine.R b/tests/testthat/test-pk.calc.urine.R index 91dc9dbe..392fae19 100644 --- a/tests/testthat/test-pk.calc.urine.R +++ b/tests/testthat/test-pk.calc.urine.R @@ -122,3 +122,13 @@ test_that("pk.calc.ertmax", { (2 + 2/2) ) }) + +test_that("generate_missing_messages", { + # Ensure that the deparse(substitute()) methods work + conc <- NA_real_ + volume <- NA_real_ + expect_equal( + as.character(generate_missing_messages(conc, volume)), + "All conc and volume are missing" + ) +})