diff --git a/NAMESPACE b/NAMESPACE index 1d625987..3e19b87c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -189,7 +189,15 @@ export(pk.calc.aumc.inf) export(pk.calc.aumc.inf.obs) export(pk.calc.aumc.inf.pred) export(pk.calc.aumc.last) +export(pk.calc.aumcint) +export(pk.calc.aumcint.all) +export(pk.calc.aumcint.inf.obs) +export(pk.calc.aumcint.inf.pred) +export(pk.calc.aumcint.last) +export(pk.calc.aumciv) export(pk.calc.auxc) +export(pk.calc.auxcint) +export(pk.calc.auxciv) export(pk.calc.c0) export(pk.calc.cav) export(pk.calc.ceoi) @@ -204,6 +212,9 @@ export(pk.calc.cstart) export(pk.calc.ctrough) export(pk.calc.deg.fluc) export(pk.calc.dn) +export(pk.calc.ermax) +export(pk.calc.ertlst) +export(pk.calc.ertmax) export(pk.calc.f) export(pk.calc.fe) export(pk.calc.half.life) @@ -214,6 +225,8 @@ export(pk.calc.mrt.md) export(pk.calc.ptr) export(pk.calc.sparse_auc) export(pk.calc.sparse_auclast) +export(pk.calc.sparse_aumc) +export(pk.calc.sparse_aumclast) export(pk.calc.swing) export(pk.calc.tfirst) export(pk.calc.thalf.eff) @@ -244,6 +257,7 @@ export(superposition) export(time_calc) export(ungroup) export(var_sparse_auc) +export(var_sparse_aumc) importFrom(dplyr,"%>%") importFrom(dplyr,filter) importFrom(dplyr,full_join) diff --git a/NEWS.md b/NEWS.md index e7558031..93ce6ba2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,16 @@ the dosing including dose amount and route. # Development version +## 2025-12-04 Changes in this version + +* Added new AUC Parameters related to CL, Kel, MRT, Vss and Vz +* Removed `aumc_integrate()` function; simplified usage by using `auc_integrate()` with arguments `fun_linear`, `fun_log`, and `fun_inf`. (#493) +* Refactored `pk.calc.aucint()` and `pk.calc.aumcint()`: + - Renamed original `pk.calc.aucint()` to `pk.calc.auxcint()` and added integration functions as arguments. + - Created new `pk.calc.aucint()` and `pk.calc.aumcint()` calling `pk.calc.auxcint()` with proper integration functions. (#494) +* Refactored `pk.calc.auciv()` and `pk.calc.aumciv()` similarly to #494. (#495) +* Saprse AUMC functions added + ## Breaking changes * Both include and excluding half-life points may not be done for the same interval (#406) diff --git a/R/auc.R b/R/auc.R index 5f6718b9..50bf88e1 100644 --- a/R/auc.R +++ b/R/auc.R @@ -70,7 +70,7 @@ pk.calc.auxc <- function(conc, time, interval=c(0, Inf), conc.blq=NULL, conc.na=NULL, check=TRUE, - fun_linear, fun_log, fun_inf) { + fun_linear, fun_log, fun_inf, ...) { # Check the inputs method <- PKNCA.choose.option(name="auc.method", value=method, options=options) if (check) { diff --git a/R/auc_integrate.R b/R/auc_integrate.R index 15b4a979..51237795 100644 --- a/R/auc_integrate.R +++ b/R/auc_integrate.R @@ -184,47 +184,3 @@ auc_integrate <- function(conc, time, clast, tlast, lambda.z, interval_method, f ret } -#' Support function for AUMC integration (reuses the same interval_method logic as AUC) -#' -#' @inheritParams auc_integrate -#' @param fun_linear Linear trapezoidal rule for t×conc (AUMC) -#' @param fun_log Log trapezoidal rule for t×conc (AUMC) -#' @param fun_inf Analytical extrapolation to infinity for AUMC -#' -#' @details -#' This function works identically to `auc_integrate()`, but integrates -#' the first moment curve (t × conc) instead of conc. -#' The `interval_method` vector from `choose_interval_method()` is reused directly. -#' -#' @returns The numeric value of the AUMC -#' @keywords internal -aumc_integrate <- function(conc, time, clast, tlast, lambda.z, interval_method, - fun_linear, fun_log, fun_inf) { - assert_lambdaz(lambda.z = lambda.z) - - interval_method_within <- interval_method[-length(interval_method)] - interval_method_extrap <- interval_method[length(interval_method)] - - idx_1 <- seq_len(length(conc) - 1) - idx_1_linear <- idx_1[interval_method_within == "linear"] - idx_1_log <- idx_1[interval_method_within == "log"] - - ret <- - c( - fun_linear(conc[idx_1_linear], conc[idx_1_linear + 1], - time[idx_1_linear], time[idx_1_linear + 1]), - fun_log(conc[idx_1_log], conc[idx_1_log + 1], - time[idx_1_log], time[idx_1_log + 1]) - ) - - if (interval_method_extrap %in% "extrap_log") { - # Whether AUMCinf,obs or AUMCinf,pred is calculated depends on if clast,obs - # or clast,pred is passed in. - ret[length(ret)+1] <- fun_inf(clast, tlast, lambda.z) - } else if (interval_method_extrap != "zero") { - stop("Invalid interval_method_extrap in aumc_integrate, please report a bug: ", interval_method_extrap) # nocov - } - - ret <- sum(ret) - ret -} diff --git a/R/aucint.R b/R/aucint.R index d739a05b..c4e42c36 100644 --- a/R/aucint.R +++ b/R/aucint.R @@ -1,47 +1,55 @@ -#' Calculate the AUC over an interval with interpolation and/or -#' extrapolation of concentrations for the beginning and end of the -#' interval. +#' Calculate AUXC (AUC or AUMC) over an interval with interpolation/extrapolation +#' +#' Calculates AUC or AUMC over a given interval, optionally interpolating or +#' extrapolating concentrations. #' #' @details -#' When `pk.calc.aucint()` needs to extrapolate using `lambda.z` (in other +#' When `pk.calc.auxcint()` needs to extrapolate using `lambda.z` (in other #' words, using the half-life), it will always extrapolate using the logarithmic #' trapezoidal rule to align with using a half-life calculation for the #' extrapolation. #' -#' #' @inheritParams pk.calc.auxc #' @inheritParams assert_intervaltime_single #' @inheritParams assert_lambdaz #' @param clast,clast.obs,clast.pred The last concentration above the limit of -#' quantification; this is used for AUCinf calculations. If provided as -#' clast.obs (observed clast value, default), AUCinf is AUCinf,obs. If -#' provided as clast.pred, AUCinf is AUCinf,pred. +#' quantification; this is used for AUCinf calculations. If provided as +#' `clast.obs` (observed clast value, default), AUCinf is AUCinf,obs. If +#' provided as `clast.pred`, AUCinf is AUCinf,pred. #' @param time.dose,route,duration.dose The time of doses, route of #' administration, and duration of dose used with interpolation and -#' extrapolation of concentration data (see [interp.extrap.conc.dose()]). If -#' `NULL`, [interp.extrap.conc()] will be used instead (assuming that no doses -#' affecting concentrations are in the interval). +#' extrapolation of concentration data (see [interp.extrap.conc.dose()]). +#' If `NULL`, [interp.extrap.conc()] will be used instead. +#' @param fun_linear,fun_log,fun_inf Integration functions for linear, +#' logarithmic, and infinite extrapolation methods. #' @param ... Additional arguments passed to `pk.calc.auxc` and #' `interp.extrap.conc` +#' +#' @return The AUXC for an interval of time as a number +#' #' @family AUC calculations +#' @family AUMC calculations #' @seealso [PKNCA.options()], [interp.extrap.conc.dose()] -#' @returns The AUC for an interval of time as a number #' @export -pk.calc.aucint <- function(conc, time, - interval=NULL, start=NULL, end=NULL, - clast=pk.calc.clast.obs(conc, time), - lambda.z=NA, - time.dose=NULL, - route="extravascular", - duration.dose=0, - method=NULL, - auc.type="AUClast", - conc.blq=NULL, - conc.na=NULL, - check=TRUE, - ..., - options=list()) { +pk.calc.auxcint <- function(conc, time, + interval=NULL, start=NULL, end=NULL, + clast=pk.calc.clast.obs(conc, time), + lambda.z=NA, + time.dose=NULL, + route="extravascular", + duration.dose=0, + auc.type=c("AUClast", "AUCinf", "AUCall"), + options=list(), + method=NULL, + conc.blq=NULL, + conc.na=NULL, + check=TRUE, + fun_linear, + fun_log, + fun_inf, + ...) { # Check inputs + auc.type <- match.arg(auc.type) method <- PKNCA.choose.option(name="auc.method", value=method, options=options) if (check) { assert_conc_time(conc, time) @@ -64,7 +72,7 @@ pk.calc.aucint <- function(conc, time, } else { setdiff(c(interval, time.dose), data$time) } - # Handle the potential double-calculation (before/after tlast) with AUCinf + # Handle the potential double-calculation (before/after tlast) with AUCinf/AUMCinf conc_clast <- NULL time_clast <- NULL if (auc.type %in% "AUCinf") { @@ -142,24 +150,7 @@ pk.calc.aucint <- function(conc, time, conc_interp <- data$conc[mask_time] time_interp <- data$time[mask_time] } - # AUCinf traces an AUClast curve if the interval is finite (because - # the interval doesn't go to infinity) while AUCall and AUClast trace - # their own curves. Or, they all trace their own curves. - auc.type_map <- - if (is.infinite(interval[2])) { - list( - AUClast="AUClast", - AUCall="AUCall", - AUCinf="AUCinf" - )[[auc.type]] - } else { - list( - AUClast="AUClast", - AUCall="AUCall", - AUCinf="AUClast" - )[[auc.type]] - } - + interval_method <- choose_interval_method( conc = conc_interp, @@ -180,13 +171,25 @@ pk.calc.aucint <- function(conc, time, conc = conc_interp, time = time_interp, clast = clast, tlast = tlast, lambda.z = lambda.z, interval_method = interval_method, - fun_linear = aucintegrate_linear, - fun_log = aucintegrate_log, - fun_inf = aucintegrate_inf + fun_linear = fun_linear, + fun_log = fun_log, + fun_inf = fun_inf ) ret } +#' @describeIn pk.calc.auxcint Calculate AUC over an interval +#' @export +pk.calc.aucint <- function(conc, time, ..., options=list()) { + pk.calc.auxcint( + conc = conc, time = time, ..., + options = options, + fun_linear = aucintegrate_linear, + fun_log = aucintegrate_log, + fun_inf = aucintegrate_inf + ) +} + #' @describeIn pk.calc.aucint Interpolate or extrapolate concentrations for #' AUClast #' @export @@ -248,12 +251,6 @@ add.interval.col("aucint.last", pretty_name="AUCint (based on AUClast extrapolation)", desc="The area under the concentration time curve in the interval extrapolating from Tlast to infinity with zeros (matching AUClast)", formalsmap=list(conc="conc.group", time="time.group", time.dose=NULL)) -PKNCA.set.summary( - name="aucint.last", - description="geometric mean and geometric coefficient of variation", - point=business.geomean, - spread=business.geocv -) add.interval.col("aucint.last.dose", FUN="pk.calc.aucint.last", @@ -262,12 +259,6 @@ add.interval.col("aucint.last.dose", pretty_name="AUCint (based on AUClast extrapolation, dose-aware)", desc="The area under the concentration time curve in the interval extrapolating from Tlast to infinity with zeros (matching AUClast) with dose-aware interpolation/extrapolation of concentrations", formalsmap=list(conc="conc.group", time="time.group", time.dose="time.dose.group")) -PKNCA.set.summary( - name="aucint.last.dose", - description="geometric mean and geometric coefficient of variation", - point=business.geomean, - spread=business.geocv -) add.interval.col("aucint.all", FUN="pk.calc.aucint.all", @@ -276,12 +267,6 @@ add.interval.col("aucint.all", pretty_name="AUCint (based on AUCall extrapolation)", desc="The area under the concentration time curve in the interval extrapolating from Tlast to infinity with the triangle from Tlast to the next point and zero thereafter (matching AUCall)", formalsmap=list(conc="conc.group", time="time.group", time.dose=NULL)) -PKNCA.set.summary( - name="aucint.all", - description="geometric mean and geometric coefficient of variation", - point=business.geomean, - spread=business.geocv -) add.interval.col("aucint.all.dose", FUN="pk.calc.aucint.all", @@ -290,12 +275,6 @@ add.interval.col("aucint.all.dose", pretty_name="AUCint (based on AUCall extrapolation, dose-aware)", desc="The area under the concentration time curve in the interval extrapolating from Tlast to infinity with the triangle from Tlast to the next point and zero thereafter (matching AUCall) with dose-aware interpolation/extrapolation of concentrations", formalsmap=list(conc="conc.group", time="time.group", time.dose="time.dose.group")) -PKNCA.set.summary( - name="aucint.all.dose", - description="geometric mean and geometric coefficient of variation", - point=business.geomean, - spread=business.geocv -) add.interval.col("aucint.inf.obs", FUN="pk.calc.aucint.inf.obs", @@ -305,12 +284,6 @@ add.interval.col("aucint.inf.obs", desc="The area under the concentration time curve in the interval extrapolating from Tlast to infinity with zeros (matching AUClast)", formalsmap=list(conc="conc.group", time="time.group", time.dose=NULL), depends=c("lambda.z", "clast.obs")) -PKNCA.set.summary( - name="aucint.inf.obs", - description="geometric mean and geometric coefficient of variation", - point=business.geomean, - spread=business.geocv -) add.interval.col("aucint.inf.obs.dose", FUN="pk.calc.aucint.inf.obs", @@ -320,12 +293,6 @@ add.interval.col("aucint.inf.obs.dose", desc="The area under the concentration time curve in the interval extrapolating from Tlast to infinity with zeros (matching AUClast) with dose-aware interpolation/extrapolation of concentrations", formalsmap=list(conc="conc.group", time="time.group", time.dose="time.dose.group"), depends=c("lambda.z", "clast.obs")) -PKNCA.set.summary( - name="aucint.inf.obs.dose", - description="geometric mean and geometric coefficient of variation", - point=business.geomean, - spread=business.geocv -) add.interval.col("aucint.inf.pred", FUN="pk.calc.aucint.inf.pred", @@ -335,12 +302,6 @@ add.interval.col("aucint.inf.pred", desc="The area under the concentration time curve in the interval extrapolating from Tlast to infinity with the triangle from Tlast to the next point and zero thereafter (matching AUCall)", formalsmap=list(conc="conc.group", time="time.group", time.dose=NULL), depends=c("lambda.z", "clast.pred")) -PKNCA.set.summary( - name="aucint.inf.pred", - description="geometric mean and geometric coefficient of variation", - point=business.geomean, - spread=business.geocv -) add.interval.col("aucint.inf.pred.dose", FUN="pk.calc.aucint.inf.pred", @@ -350,186 +311,28 @@ add.interval.col("aucint.inf.pred.dose", desc="The area under the concentration time curve in the interval extrapolating from Tlast to infinity with the triangle from Tlast to the next point and zero thereafter (matching AUCall) with dose-aware interpolation/extrapolation of concentrations", formalsmap=list(conc="conc.group", time="time.group", time.dose="time.dose.group"), depends=c("lambda.z", "clast.pred")) + PKNCA.set.summary( - name="aucint.inf.pred.dose", + name= c( + "aucint.last", "aucint.last.dose", "aucint.all", "aucint.all.dose", + "aucint.inf.obs", "aucint.inf.obs.dose", "aucint.inf.pred", "aucint.inf.pred.dose" + ), description="geometric mean and geometric coefficient of variation", point=business.geomean, spread=business.geocv ) -#' Calculate the AUMC over an interval with interpolation and/or -#' extrapolation of concentrations for the beginning and end of the -#' interval. -#' -#' @details -#' When `pk.calc.aumcint()` needs to extrapolate using `lambda.z` (in other -#' words, using the half-life), it will always extrapolate using the logarithmic -#' trapezoidal rule to align with using a half-life calculation for the -#' extrapolation. -#' -#' @inheritParams pk.calc.aucint -#' @family AUMC calculations -#' @returns The AUMC for an interval of time as a number +#' @describeIn pk.calc.auxcint Calculate AUMC over an interval #' @export -pk.calc.aumcint <- function(conc, time, - interval=NULL, start=NULL, end=NULL, - clast=pk.calc.clast.obs(conc, time), - lambda.z=NA, - time.dose=NULL, - route="extravascular", - duration.dose=0, - method=NULL, - auc.type="AUClast", - conc.blq=NULL, - conc.na=NULL, - check=TRUE, - ..., - options=list()) { - # Check inputs - method <- PKNCA.choose.option(name="auc.method", value=method, options=options) - if (check) { - assert_conc_time(conc, time) - data <- - clean.conc.blq( - conc = conc, time = time, - conc.blq = conc.blq, conc.na = conc.na, options = options, - check = FALSE - ) - } else { - data <- data.frame(conc, time) - } - if (all(data$conc %in% 0)) { - return(structure(0, exclude = "DO NOT EXCLUDE")) - } - interval <- assert_intervaltime_single(interval = interval, start = start, end = end) - missing_times <- - if (is.infinite(interval[2])) { - setdiff(c(interval[1], time.dose), data$time) - } else { - setdiff(c(interval, time.dose), data$time) - } - # Handle the potential double-calculation (before/after tlast) with AUMCinf - conc_clast <- NULL - time_clast <- NULL - if (auc.type %in% "AUCinf") { - tlast <- pk.calc.tlast(conc=data$conc, time=data$time) - clast_obs <- pk.calc.clast.obs(conc=data$conc, time=data$time) - if (is.na(clast) && is.na(lambda.z)) { - # clast.pred is NA likely because the half-life was not calculable - return(structure(NA_real_, exclude = "clast.pred is NA because the half-life is NA")) - } else if (is.na(clast)) { - stop("Please report a bug. clast is NA and the half-life is not NA") # nocov - } else if (clast != clast_obs & interval[2] > tlast) { - # If using clast.pred, we need to doubly calculate at tlast. - conc_clast <- clast - time_clast <- tlast - } - } - extrap_times <- numeric() - if (length(missing_times) > 0) { - if (is.null(time.dose)) { - missing_conc <- - interp.extrap.conc( - conc = data$conc, time = data$time, - time.out = missing_times, - method = method, - auc.type = auc.type, - clast = clast, - lambda.z = lambda.z, - options = options, - ... - ) - } else { - missing_conc <- - interp.extrap.conc.dose( - conc = data$conc, time = data$time, - time.out = missing_times, - method = method, - auc.type = auc.type, - clast = clast, lambda.z = lambda.z, - options = options, - # arguments specific to interp.extrap.conc.dose - time.dose = time.dose, - route.dose = route, - duration.dose = duration.dose, - out.after = FALSE, - ... - ) - } - new_data <- data.frame(conc=c(data$conc, conc_clast, missing_conc), - time=c(data$time, time_clast, missing_times)) - tlast <- pk.calc.tlast(conc = data$conc, time = data$time, check = FALSE) - extrap_times <- missing_times[missing_times > tlast] - new_data <- new_data[new_data$time >= interval[1] & - new_data$time <= interval[2],] - new_data <- new_data[order(new_data$time),] - conc_interp <- new_data$conc - time_interp <- new_data$time - if (any(mask_na_conc <- is.na(conc_interp))) { - missing_times <- time_interp[mask_na_conc] - warning_message <- - if (any(is.na(lambda.z))) { - paste("Some interpolated/extrapolated concentration values are missing", - "(may be due to interpolating or extrapolating over a dose with lambda.z=NA).", - "Time points with missing data are: ", - paste(missing_times, collapse=", ")) - } else { - paste("Some interpolated/extrapolated concentration values are missing", - "Time points with missing data are: ", - paste(missing_times, collapse=", ")) - } - warning(warning_message) - return(NA_real_) - } - } else { - mask_time <- data$time >= interval[1] & data$time <= interval[2] - conc_interp <- data$conc[mask_time] - time_interp <- data$time[mask_time] - } - # AUMCinf traces an AUMClast curve if the interval is finite (because - # the interval doesn't go to infinity) while AUMCall and AUMClast trace - # their own curves. Or, they all trace their own curves. - auc.type_map <- - if (is.infinite(interval[2])) { - list( - AUClast="AUClast", - AUCall="AUCall", - AUCinf="AUCinf" - )[[auc.type]] - } else { - list( - AUClast="AUClast", - AUCall="AUCall", - AUCinf="AUClast" - )[[auc.type]] - } - - interval_method <- - choose_interval_method( - conc = conc_interp, - time = time_interp, - tlast = max(time_interp), - method = method, - auc.type = auc.type, - options = options - ) - if (is.finite(interval[2])) { - interval_method[length(interval_method)] <- "zero" - } - if (length(extrap_times) > 0) { - interval_method[which(time_interp == extrap_times) - 1] <- "log" - } - ret <- - aumc_integrate( - conc = conc_interp, time = time_interp, - clast = clast, tlast = tlast, lambda.z = lambda.z, - interval_method = interval_method, - fun_linear = aumcintegrate_linear, - fun_log = aumcintegrate_log, - fun_inf = aumcintegrate_inf - ) - ret +pk.calc.aumcint <- function(conc, time, ..., options=list()) { + pk.calc.auxcint( + conc = conc, time = time, ..., + options = options, + fun_linear = aumcintegrate_linear, + fun_log = aumcintegrate_log, + fun_inf = aumcintegrate_inf + ) } #' @describeIn pk.calc.aumcint Interpolate or extrapolate concentrations for diff --git a/R/auciv.R b/R/auciv.R index fb870b1d..7355c4bf 100644 --- a/R/auciv.R +++ b/R/auciv.R @@ -1,48 +1,73 @@ -#' Calculate AUC for intravenous dosing +#' Calculate AUXC (AUC or AUMC) for IV dosing with C0 back-extrapolation #' -#' @details The AUC for intravenous (IV) dosing extrapolates the AUC back from -#' the first measurement to time 0 using c0 and the AUC calculated by another -#' method (for example the auclast). +#' Calculates AUC or AUMC for intravenous dosing, with optional back-extrapolation +#' to C0. #' -#' The calculation method takes the following steps: +#' @details +#' The AUXC for intravenous (IV) dosing extrapolates the AUXC back from the first +#' measurement to time 0 using `c0` and the AUXC calculated by another method +#' (e.g., auclast or aumclast). #' -#' \itemize{ -#' \item{`time = 0` must be present in the data with a measured concentration.} -#' \item{The AUC between `time = 0` and the next time point is calculated (`auc_first`).} -#' \item{The AUC between `time = 0` with `c0` and the next time point is calculated (`auc_second`).} -#' \item{The final AUC is the initial AUC plus the difference between the two AUCs (`auc_final <- auc + auc_second - auc_first`).} +#' The calculation method takes the following steps: +#' \enumerate{ +#' \item `time = 0` must be present in the data with a measured concentration. +#' \item The AUXC between `time = 0` and the next time point is calculated (`auxc_first`). +#' \item The AUXC between `time = 0` with `c0` and the next time point is calculated (`auxc_second`). +#' \item The final AUXC is the initial AUXC plus the difference between the two +#' AUXCs (`auxc_final <- auxc + auxc_second - auxc_first`). #' } +#' #' @inheritParams pk.calc.auxc #' @inheritParams PKNCA.choose.option -#' @param c0 The concentration at time 0, typically calculated using -#' `pk.calc.c0()` -#' @param auc The AUC calculated using `conc` and `time` without `c0` (it may be -#' calculated using any method) -#' @return `pk.calc.auciv`: The AUC calculated using `c0` +#' @param c0 The concentration at time 0, typically calculated using [pk.calc.c0()] +#' @param auxc The AUXC calculated using `conc` and `time` without `c0` +#' (it may be calculated using any method) +#' @param fun_auxc_last Function to calculate the AUXC for the last interval +#' (e.g., `pk.calc.auc.last` or `pk.calc.aumc.last`) +#' +#' @return The AUXC calculated using `c0` +#' +#' @family AUC calculations +#' @family AUMC calculations #' @export -pk.calc.auciv <- function(conc, time, c0, auc, ..., options = list(), check=TRUE) { +pk.calc.auxciv <- function(conc, time, c0, auxc, fun_auxc_last, ..., options = list(), check = TRUE) { if (check) { assert_conc_time(conc = conc, time = time) data <- clean.conc.blq( conc, time, options = options, - check=FALSE + check = FALSE ) } else { data <- data.frame(conc = conc, time = time) } if (!(0 %in% time)) { - return(structure(NA_real_, exclude="No time 0 in data")) + return(structure(NA_real_, exclude = "No time 0 in data")) } else if (is.na(c0)) { - return(structure(NA_real_, exclude="c0 is not calculated")) + return(structure(NA_real_, exclude = "c0 is not calculated")) } - auc_first <- pk.calc.auc.last(conc = data$conc[1:2], time = data$time[1:2], ..., check=FALSE) - auc_second <- pk.calc.auc.last(conc = c(c0, data$conc[2]), time = data$time[1:2], ..., check=FALSE) - auc_final <- auc + auc_second - auc_first - auc_final + auxc_first <- fun_auxc_last(conc = data$conc[1:2], time = data$time[1:2], ..., check = FALSE) + auxc_second <- fun_auxc_last(conc = c(c0, data$conc[2]), time = data$time[1:2], ..., check = FALSE) + auxc_final <- auxc + auxc_second - auxc_first + auxc_final } + +#' @describeIn pk.calc.auciv Calculate AUC for intravenous dosing with C0 back-extrapolation +#' @export +pk.calc.auciv <- function(conc, time, c0, auc, ..., options = list(), check = TRUE) { + pk.calc.auxciv( + conc = conc, time = time, + c0 = c0, auxc = auc, + fun_auxc_last = pk.calc.auc.last, + ..., + options = options, + check = check + ) +} + + add.interval.col( name = "aucivlast", FUN = "pk.calc.auciv", @@ -200,50 +225,18 @@ PKNCA.set.summary( ) -#' Calculate AUMC for intravenous dosing with C0 back-extrapolation -#' -#' @details Analogous to pk.calc.auciv but for AUMC. -#' Replaces the first AUMC interval (from measured C0) with one using extrapolated c0. -#' -#' @inheritParams pk.calc.auxc -#' @param c0 The concentration at time 0 (extrapolated) -#' @param aumc The AUMC calculated without c0 adjustment (e.g., aumcall, aumclast) -#' @return The AUMC with IV back-extrapolation applied +#' @describeIn pk.calc.auxciv Calculate AUMC for intravenous dosing with C0 back-extrapolation #' @export pk.calc.aumciv <- function(conc, time, c0, aumc, ..., options = list(), check = TRUE) { - if (check) { - assert_conc_time(conc = conc, time = time) - data <- clean.conc.blq(conc, time, options = options, check = FALSE) - } else { - data <- data.frame(conc = conc, time = time) - } - - if (!(0 %in% time)) { - return(structure(NA_real_, exclude = "No time 0 in data")) - } else if (is.na(c0)) { - return(structure(NA_real_, exclude = "c0 is not calculated")) - } - - # AUMC for first interval using measured concentrations - aumc_first <- pk.calc.aumc.last( - conc = data$conc[1:2], - time = data$time[1:2], + pk.calc.auxciv( + conc = conc, time = time, + c0 = c0, auxc = aumc, + fun_auxc_last = pk.calc.aumc.last, ..., - check = FALSE + options = options, + check = check ) - - # AUMC for first interval using extrapolated c0 - aumc_second <- pk.calc.aumc.last( - conc = c(c0, data$conc[2]), - time = data$time[1:2], - ..., - check = FALSE - ) - - aumc_final <- aumc + aumc_second - aumc_first - aumc_final } - # Register all standard AUMC IV versions add.interval.col( name = "aumcivlast", diff --git a/R/sparse.R b/R/sparse.R index cff1710b..25db9e9c 100644 --- a/R/sparse.R +++ b/R/sparse.R @@ -534,7 +534,6 @@ pk.calc.sparse_aumclast <- function(conc, time, subject, ..., options = list()) ret } -# Column registrations add.interval.col( "sparse_aumclast", sparse = TRUE, @@ -581,4 +580,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/man/as_sparse_pk.Rd b/man/as_sparse_pk.Rd index 4cf7fd98..2bf13b3d 100644 --- a/man/as_sparse_pk.Rd +++ b/man/as_sparse_pk.Rd @@ -25,6 +25,7 @@ Generate a sparse_pk object \seealso{ Other Sparse Methods: \code{\link{pk.calc.sparse_auc}()}, +\code{\link{pk.calc.sparse_aumc}()}, \code{\link{sparse_auc_weight_linear}()}, \code{\link{sparse_mean}()} } diff --git a/man/pk.calc.auciv.Rd b/man/pk.calc.auciv.Rd deleted file mode 100644 index eba72c29..00000000 --- a/man/pk.calc.auciv.Rd +++ /dev/null @@ -1,63 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/auciv.R -\name{pk.calc.auciv} -\alias{pk.calc.auciv} -\alias{pk.calc.auciv_pbext} -\title{Calculate AUC for intravenous dosing} -\usage{ -pk.calc.auciv(conc, time, c0, auc, ..., options = list(), check = TRUE) - -pk.calc.auciv_pbext(auc, auciv) -} -\arguments{ -\item{conc}{Measured concentrations} - -\item{time}{Time of the measurement of the concentrations} - -\item{c0}{The concentration at time 0, typically calculated using -\code{pk.calc.c0()}} - -\item{auc}{The AUC calculated using \code{conc} and \code{time} without \code{c0} (it may be -calculated using any method)} - -\item{...}{For functions other than \code{pk.calc.auxc}, these values are passed -to \code{pk.calc.auxc}} - -\item{options}{List of changes to the default PKNCA options (see -\code{PKNCA.options()})} - -\item{check}{Run \code{\link[=assert_conc_time]{assert_conc_time()}}, \code{\link[=clean.conc.blq]{clean.conc.blq()}}, and -\code{\link[=clean.conc.na]{clean.conc.na()}}?} - -\item{auciv}{The AUC calculated using \code{c0}} -} -\value{ -\code{pk.calc.auciv}: The AUC calculated using \code{c0} - -\code{pk.calc.auciv_pctbackextrap}: The AUC percent back-extrapolated -} -\description{ -Calculate AUC for intravenous dosing -} -\details{ -The AUC for intravenous (IV) dosing extrapolates the AUC back from -the first measurement to time 0 using c0 and the AUC calculated by another -method (for example the auclast). - -The calculation method takes the following steps: - -\itemize{ -\item{\code{time = 0} must be present in the data with a measured concentration.} -\item{The AUC between \code{time = 0} and the next time point is calculated (\code{auc_first}).} -\item{The AUC between \code{time = 0} with \code{c0} and the next time point is calculated (\code{auc_second}).} -\item{The final AUC is the initial AUC plus the difference between the two AUCs (\code{auc_final <- auc + auc_second - auc_first}).} -} - -The calculation for back-extrapolation is \code{100*(1 - auc/auciv)}. -} -\section{Functions}{ -\itemize{ -\item \code{pk.calc.auciv_pbext()}: Calculate the percent back-extrapolated AUC for IV -administration - -}} diff --git a/man/pk.calc.auxc.Rd b/man/pk.calc.auxc.Rd index b1447d32..3252c6de 100644 --- a/man/pk.calc.auxc.Rd +++ b/man/pk.calc.auxc.Rd @@ -30,7 +30,8 @@ pk.calc.auxc( check = TRUE, fun_linear, fun_log, - fun_inf + fun_inf, + ... ) pk.calc.auc(conc, time, ..., options = list()) @@ -173,6 +174,7 @@ Press, 2000. 164-7. \code{\link[=clean.conc.blq]{clean.conc.blq()}} Other AUC calculations: -\code{\link{pk.calc.aucint}()} +\code{\link{pk.calc.auxcint}()}, +\code{\link{pk.calc.auxciv}()} } \concept{AUC calculations} diff --git a/man/pk.calc.aucint.Rd b/man/pk.calc.auxcint.Rd similarity index 54% rename from man/pk.calc.aucint.Rd rename to man/pk.calc.auxcint.Rd index 6aea0c9f..4f3cde42 100644 --- a/man/pk.calc.aucint.Rd +++ b/man/pk.calc.auxcint.Rd @@ -1,16 +1,12 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/aucint.R -\name{pk.calc.aucint} +\name{pk.calc.auxcint} +\alias{pk.calc.auxcint} \alias{pk.calc.aucint} -\alias{pk.calc.aucint.last} -\alias{pk.calc.aucint.all} -\alias{pk.calc.aucint.inf.obs} -\alias{pk.calc.aucint.inf.pred} -\title{Calculate the AUC over an interval with interpolation and/or -extrapolation of concentrations for the beginning and end of the -interval.} +\alias{pk.calc.aumcint} +\title{Calculate AUXC (AUC or AUMC) over an interval with interpolation/extrapolation} \usage{ -pk.calc.aucint( +pk.calc.auxcint( conc, time, interval = NULL, @@ -21,58 +17,21 @@ pk.calc.aucint( time.dose = NULL, route = "extravascular", duration.dose = 0, + auc.type = c("AUClast", "AUCinf", "AUCall"), + options = list(), method = NULL, - auc.type = "AUClast", conc.blq = NULL, conc.na = NULL, check = TRUE, - ..., - options = list() + fun_linear, + fun_log, + fun_inf, + ... ) -pk.calc.aucint.last( - conc, - time, - start = NULL, - end = NULL, - time.dose, - ..., - options = list() -) +pk.calc.aucint(conc, time, ..., options = list()) -pk.calc.aucint.all( - conc, - time, - start = NULL, - end = NULL, - time.dose, - ..., - options = list() -) - -pk.calc.aucint.inf.obs( - conc, - time, - start = NULL, - end = NULL, - time.dose, - lambda.z, - clast.obs, - ..., - options = list() -) - -pk.calc.aucint.inf.pred( - conc, - time, - start = NULL, - end = NULL, - time.dose, - lambda.z, - clast.pred, - ..., - options = list() -) +pk.calc.aumcint(conc, time, ..., options = list()) } \arguments{ \item{conc}{Measured concentrations} @@ -87,25 +46,27 @@ integration} \item{end}{The end time of the interval} \item{clast, clast.obs, clast.pred}{The last concentration above the limit of -quantification; this is used for AUCinf calculations. If provided as -clast.obs (observed clast value, default), AUCinf is AUCinf,obs. If -provided as clast.pred, AUCinf is AUCinf,pred.} +quantification; this is used for AUCinf calculations. If provided as +\code{clast.obs} (observed clast value, default), AUCinf is AUCinf,obs. If +provided as \code{clast.pred}, AUCinf is AUCinf,pred.} \item{lambda.z}{The elimination rate (in units of inverse time) for extrapolation} \item{time.dose, route, duration.dose}{The time of doses, route of administration, and duration of dose used with interpolation and -extrapolation of concentration data (see \code{\link[=interp.extrap.conc.dose]{interp.extrap.conc.dose()}}). If -\code{NULL}, \code{\link[=interp.extrap.conc]{interp.extrap.conc()}} will be used instead (assuming that no doses -affecting concentrations are in the interval).} - -\item{method}{The method for integration (one of 'lin up/log down', -'lin-log', or 'linear')} +extrapolation of concentration data (see \code{\link[=interp.extrap.conc.dose]{interp.extrap.conc.dose()}}). +If \code{NULL}, \code{\link[=interp.extrap.conc]{interp.extrap.conc()}} will be used instead.} \item{auc.type}{The type of AUC to compute. Choices are 'AUCinf', 'AUClast', and 'AUCall'.} +\item{options}{List of changes to the default PKNCA options (see +\code{PKNCA.options()})} + +\item{method}{The method for integration (one of 'lin up/log down', +'lin-log', or 'linear')} + \item{conc.blq}{How to handle BLQ values in between the first and last above LOQ concentrations. (See \code{\link[=clean.conc.blq]{clean.conc.blq()}} for usage instructions.)} @@ -115,45 +76,41 @@ LOQ concentrations. (See \code{\link[=clean.conc.blq]{clean.conc.blq()}} for usa \item{check}{Run \code{\link[=assert_conc_time]{assert_conc_time()}}, \code{\link[=clean.conc.blq]{clean.conc.blq()}}, and \code{\link[=clean.conc.na]{clean.conc.na()}}?} +\item{fun_linear, fun_log, fun_inf}{Integration functions for linear, +logarithmic, and infinite extrapolation methods.} + \item{...}{Additional arguments passed to \code{pk.calc.auxc} and \code{interp.extrap.conc}} - -\item{options}{List of changes to the default PKNCA options (see -\code{PKNCA.options()})} } \value{ -The AUC for an interval of time as a number +The AUXC for an interval of time as a number } \description{ -Calculate the AUC over an interval with interpolation and/or -extrapolation of concentrations for the beginning and end of the -interval. +Calculates AUC or AUMC over a given interval, optionally interpolating or +extrapolating concentrations. } \details{ -When \code{pk.calc.aucint()} needs to extrapolate using \code{lambda.z} (in other +When \code{pk.calc.auxcint()} needs to extrapolate using \code{lambda.z} (in other words, using the half-life), it will always extrapolate using the logarithmic trapezoidal rule to align with using a half-life calculation for the extrapolation. } \section{Functions}{ \itemize{ -\item \code{pk.calc.aucint.last()}: Interpolate or extrapolate concentrations for -AUClast - -\item \code{pk.calc.aucint.all()}: Interpolate or extrapolate concentrations for -AUCall +\item \code{pk.calc.aucint()}: Calculate AUC over an interval -\item \code{pk.calc.aucint.inf.obs()}: Interpolate or extrapolate concentrations for -AUCinf.obs - -\item \code{pk.calc.aucint.inf.pred()}: Interpolate or extrapolate concentrations for -AUCinf.pred +\item \code{pk.calc.aumcint()}: Calculate AUMC over an interval }} \seealso{ \code{\link[=PKNCA.options]{PKNCA.options()}}, \code{\link[=interp.extrap.conc.dose]{interp.extrap.conc.dose()}} Other AUC calculations: -\code{\link{pk.calc.auxc}()} +\code{\link{pk.calc.auxc}()}, +\code{\link{pk.calc.auxciv}()} + +Other AUMC calculations: +\code{\link{pk.calc.auxciv}()} } \concept{AUC calculations} +\concept{AUMC calculations} diff --git a/man/pk.calc.auxciv.Rd b/man/pk.calc.auxciv.Rd new file mode 100644 index 00000000..43b89a35 --- /dev/null +++ b/man/pk.calc.auxciv.Rd @@ -0,0 +1,78 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/auciv.R +\name{pk.calc.auxciv} +\alias{pk.calc.auxciv} +\alias{pk.calc.aumciv} +\title{Calculate AUXC (AUC or AUMC) for IV dosing with C0 back-extrapolation} +\usage{ +pk.calc.auxciv( + conc, + time, + c0, + auxc, + fun_auxc_last, + ..., + options = list(), + check = TRUE +) + +pk.calc.aumciv(conc, time, c0, aumc, ..., options = list(), check = TRUE) +} +\arguments{ +\item{conc}{Measured concentrations} + +\item{time}{Time of the measurement of the concentrations} + +\item{c0}{The concentration at time 0, typically calculated using \code{\link[=pk.calc.c0]{pk.calc.c0()}}} + +\item{auxc}{The AUXC calculated using \code{conc} and \code{time} without \code{c0} +(it may be calculated using any method)} + +\item{fun_auxc_last}{Function to calculate the AUXC for the last interval +(e.g., \code{pk.calc.auc.last} or \code{pk.calc.aumc.last})} + +\item{...}{For functions other than \code{pk.calc.auxc}, these values are passed +to \code{pk.calc.auxc}} + +\item{options}{List of changes to the default PKNCA options (see +\code{PKNCA.options()})} + +\item{check}{Run \code{\link[=assert_conc_time]{assert_conc_time()}}, \code{\link[=clean.conc.blq]{clean.conc.blq()}}, and +\code{\link[=clean.conc.na]{clean.conc.na()}}?} +} +\value{ +The AUXC calculated using \code{c0} +} +\description{ +Calculates AUC or AUMC for intravenous dosing, with optional back-extrapolation +to C0. +} +\details{ +The AUXC for intravenous (IV) dosing extrapolates the AUXC back from the first +measurement to time 0 using \code{c0} and the AUXC calculated by another method +(e.g., auclast or aumclast). + +The calculation method takes the following steps: +\enumerate{ +\item \code{time = 0} must be present in the data with a measured concentration. +\item The AUXC between \code{time = 0} and the next time point is calculated (\code{auxc_first}). +\item The AUXC between \code{time = 0} with \code{c0} and the next time point is calculated (\code{auxc_second}). +\item The final AUXC is the initial AUXC plus the difference between the two +AUXCs (\code{auxc_final <- auxc + auxc_second - auxc_first}). +} +} +\section{Functions}{ +\itemize{ +\item \code{pk.calc.aumciv()}: Calculate AUMC for intravenous dosing with C0 back-extrapolation + +}} +\seealso{ +Other AUC calculations: +\code{\link{pk.calc.auxc}()}, +\code{\link{pk.calc.auxcint}()} + +Other AUMC calculations: +\code{\link{pk.calc.auxcint}()} +} +\concept{AUC calculations} +\concept{AUMC calculations} diff --git a/man/pk.calc.ermax.Rd b/man/pk.calc.ermax.Rd new file mode 100644 index 00000000..41c00411 --- /dev/null +++ b/man/pk.calc.ermax.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pk.calc.urine.R +\name{pk.calc.ermax} +\alias{pk.calc.ermax} +\title{Calculate the maximum excretion rate} +\usage{ +pk.calc.ermax(conc, volume, time, duration.conc, check = TRUE) +} +\arguments{ +\item{conc}{The concentration in the excreta (e.g., urine or feces)} + +\item{volume}{The volume (or mass) of the sample} + +\item{time}{The starting time of the collection interval} + +\item{duration.conc}{The duration of the collection interval} + +\item{check}{Should the concentration data be checked?} +} +\value{ +The maximum excretion rate, or NA if not available +} +\description{ +Calculate the maximum excretion rate +} diff --git a/man/pk.calc.ertlst.Rd b/man/pk.calc.ertlst.Rd new file mode 100644 index 00000000..83858b73 --- /dev/null +++ b/man/pk.calc.ertlst.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pk.calc.urine.R +\name{pk.calc.ertlst} +\alias{pk.calc.ertlst} +\title{Calculate the midpoint collection time of the last measurable excretion rate} +\usage{ +pk.calc.ertlst(conc, volume, time, duration.conc, check = TRUE) +} +\arguments{ +\item{conc}{The concentration in the excreta (e.g., urine or feces)} + +\item{volume}{The volume (or mass) of the sample} + +\item{time}{The starting time of the collection interval} + +\item{duration.conc}{The duration of the collection interval} + +\item{check}{Should the concentration and time data be checked?} +} +\value{ +The midpoint collection time of the last measurable excretion rate, or NA/0 if not available +} +\description{ +Calculate the midpoint collection time of the last measurable excretion rate +} diff --git a/man/pk.calc.ertmax.Rd b/man/pk.calc.ertmax.Rd new file mode 100644 index 00000000..0ce2993e --- /dev/null +++ b/man/pk.calc.ertmax.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pk.calc.urine.R +\name{pk.calc.ertmax} +\alias{pk.calc.ertmax} +\title{Calculate the midpoint collection time of the maximum excretion rate} +\usage{ +pk.calc.ertmax( + conc, + volume, + time, + duration.conc, + check = TRUE, + first.tmax = NULL +) +} +\arguments{ +\item{conc}{The concentration in the excreta (e.g., urine or feces)} + +\item{volume}{The volume (or mass) of the sample} + +\item{time}{The starting time of the collection interval} + +\item{duration.conc}{The duration of the collection interval} + +\item{check}{Should the concentration and time data be checked?} + +\item{first.tmax}{If TRUE, return the first time of maximum excretion rate; otherwise, return the last} +} +\value{ +The midpoint collection time of the maximum excretion rate, or NA if not available +} +\description{ +Calculate the midpoint collection time of the maximum excretion rate +} diff --git a/man/pk.calc.sparse_auc.Rd b/man/pk.calc.sparse_auc.Rd index ab8b711a..e2677cbb 100644 --- a/man/pk.calc.sparse_auc.Rd +++ b/man/pk.calc.sparse_auc.Rd @@ -58,6 +58,7 @@ Where: \seealso{ Other Sparse Methods: \code{\link{as_sparse_pk}()}, +\code{\link{pk.calc.sparse_aumc}()}, \code{\link{sparse_auc_weight_linear}()}, \code{\link{sparse_mean}()} } diff --git a/man/pk.calc.sparse_aumc.Rd b/man/pk.calc.sparse_aumc.Rd new file mode 100644 index 00000000..592da554 --- /dev/null +++ b/man/pk.calc.sparse_aumc.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sparse.R +\name{pk.calc.sparse_aumc} +\alias{pk.calc.sparse_aumc} +\alias{pk.calc.sparse_aumclast} +\title{Calculate AUMC and related parameters using sparse NCA methods} +\usage{ +pk.calc.sparse_aumc( + conc, + time, + subject, + method = NULL, + auc.type = "AUClast", + ..., + options = list() +) + +pk.calc.sparse_aumclast(conc, time, subject, ..., options = list()) +} +\arguments{ +\item{conc}{Measured concentrations} + +\item{time}{Time of the measurement of the concentrations} + +\item{subject}{Subject identifiers (may be any class; may not be null)} + +\item{method}{The method for integration (one of 'lin up/log down', +'lin-log', or 'linear')} + +\item{auc.type}{The type of AUC to compute. Choices are 'AUCinf', 'AUClast', +and 'AUCall'.} + +\item{...}{For functions other than \code{pk.calc.auxc}, these values are passed +to \code{pk.calc.auxc}} + +\item{options}{List of changes to the default PKNCA options (see +\code{PKNCA.options()})} +} +\value{ +A data.frame with columns: +\item{sparse_aumc}{The estimated AUMC} +\item{sparse_aumc_se}{Standard error of the AUMC estimate} +\item{sparse_aumc_df}{Degrees of freedom for the variance estimate} +} +\description{ +This is the exact analog of \code{\link[=pk.calc.sparse_auc]{pk.calc.sparse_auc()}} but for the first moment curve. +} +\section{Functions}{ +\itemize{ +\item \code{pk.calc.sparse_aumclast()}: Compute the AUMClast for sparse PK + +}} +\seealso{ +Other Sparse Methods: +\code{\link{as_sparse_pk}()}, +\code{\link{pk.calc.sparse_auc}()}, +\code{\link{sparse_auc_weight_linear}()}, +\code{\link{sparse_mean}()} +} +\concept{Sparse Methods} diff --git a/man/sparse_auc_weight_linear.Rd b/man/sparse_auc_weight_linear.Rd index 1373dae9..00fb4462 100644 --- a/man/sparse_auc_weight_linear.Rd +++ b/man/sparse_auc_weight_linear.Rd @@ -33,6 +33,7 @@ Where: Other Sparse Methods: \code{\link{as_sparse_pk}()}, \code{\link{pk.calc.sparse_auc}()}, +\code{\link{pk.calc.sparse_aumc}()}, \code{\link{sparse_mean}()} } \concept{Sparse Methods} diff --git a/man/sparse_mean.Rd b/man/sparse_mean.Rd index f59377f4..2e23ce9e 100644 --- a/man/sparse_mean.Rd +++ b/man/sparse_mean.Rd @@ -34,6 +34,7 @@ are: Other Sparse Methods: \code{\link{as_sparse_pk}()}, \code{\link{pk.calc.sparse_auc}()}, +\code{\link{pk.calc.sparse_aumc}()}, \code{\link{sparse_auc_weight_linear}()} } \concept{Sparse Methods} diff --git a/man/var_sparse_aumc.Rd b/man/var_sparse_aumc.Rd new file mode 100644 index 00000000..e2e56335 --- /dev/null +++ b/man/var_sparse_aumc.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sparse.R +\name{var_sparse_aumc} +\alias{var_sparse_aumc} +\title{Calculate the variance for the AUMC of sparsely sampled PK} +\usage{ +var_sparse_aumc(sparse_pk) +} +\arguments{ +\item{sparse_pk}{A sparse_pk object from \code{\link[=as_sparse_pk]{as_sparse_pk()}}} +} +\value{ +The variance of the AUMC estimate with a "df" attribute containing +the degrees of freedom +} +\description{ +This function calculates the variance of the area under the first moment +curve (AUMC) for sparse PK data. It follows the same methodology as +\code{\link[=var_sparse_auc]{var_sparse_auc()}} but applies to the moment curve (time × concentration). +} +\details{ +Equation 7.vii in Nedelman and Jia, 1998 is adapted for AUMC: + +\deqn{var\left(\hat{AUMC}\right) = \sum\limits_{i=0}^m\left(\frac{w_i^2 s_i^2}{r_i}\right) + 2\sum\limits_{i