diff --git a/NEWS.md b/NEWS.md index 369d9338..e7558031 100644 --- a/NEWS.md +++ b/NEWS.md @@ -28,6 +28,8 @@ the dosing including dose amount and route. `summary()` (#477) * New post-processing functions to normalize PKNCA result parameters based on any column in PKNCAconc data.frame (`normalize_by_col()`) or by using a custom normalization table (`normalize()`) +* 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 diff --git a/R/001-add.interval.col.R b/R/001-add.interval.col.R index 076fee9e..908d3192 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", diff --git a/R/pk.calc.urine.R b/R/pk.calc.urine.R index aeb472a2..d919170f 100644 --- a/R/pk.calc.urine.R +++ b/R/pk.calc.urine.R @@ -33,29 +33,12 @@ PKNCA.set.summary( #' @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) @@ -155,3 +138,189 @@ 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) { + + # Generate messages about missing concentrations/volumes + message_all <- generate_missing_messages(conc, volume, + name_a = "concentrations", + name_b = "volumes") + + if (all(is.na(conc))) { + ret <- NA_real_ + } else if (all(conc %in% c(0, NA))) { + ret <- 0 + } else { + midtime <- time + duration.conc / 2 + midtime <- time + duration.conc / 2 + 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 +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) { + + # 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 + 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", + 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) { + + # 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))) { + ret <- 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 <- ret[1] + } else { + ret <- ret[length(ret)] + } + } + + if (length(message_all) != 0) { + message <- paste(message_all, collapse = "; ") + ret <- structure(ret, exclude = message) + } + 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 +) + + + +# 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 = deparse(substitute(a)), + name_b = deparse(substitute(b))) { + + 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)) +} diff --git a/R/unit-support.R b/R/unit-support.R index 46cba380..74982d4a 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), pknca_units_table_conc_time_amount_dose(concu=concu, timeu=timeu, amountu=amountu, doseu=doseu) @@ -367,6 +368,19 @@ 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 + ) +} + 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_ diff --git a/tests/testthat/test-pk.calc.urine.R b/tests/testthat/test-pk.calc.urine.R index 3c066005..392fae19 100644 --- a/tests/testthat/test-pk.calc.urine.R +++ b/tests/testthat/test-pk.calc.urine.R @@ -60,3 +60,75 @@ test_that("pk.calc.fe", { 0.3, info="fe is calculated correctly with both vector/scalar") }) + +test_that("pk.calc.ertlst", { + # All NA + 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)), + 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)), + max(c(0, 1) + 1/2) + ) +}) + +test_that("pk.calc.ermax", { + # All NA + 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)), + max(c(1, 2, 3) * 2 / 2) + ) +}) + +test_that("pk.calc.ertmax", { + # All NA or 0 + 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), + (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) + ) +}) + +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" + ) +})