From c2f8e171e66e40b9c973651ea2fcf3097b365ab6 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 30 Aug 2025 11:29:29 +0200 Subject: [PATCH 01/20] feat: include ppanmeth column in pk.nca output --- R/pk.calc.all.R | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/R/pk.calc.all.R b/R/pk.calc.all.R index aed65225..7640b9b2 100644 --- a/R/pk.calc.all.R +++ b/R/pk.calc.all.R @@ -363,6 +363,7 @@ pk.nca.interval <- function(conc, time, volume, duration.conc, if (nrow(interval) != 1) { stop("Please report a bug. Interval must be a one-row data.frame") } + tmp_method <- "" if (!all(is.na(impute_method))) { impute_funs <- PKNCA_impute_fun_list(impute_method) stopifnot(length(impute_funs) == 1) @@ -378,6 +379,10 @@ pk.nca.interval <- function(conc, time, volume, duration.conc, } conc <- impute_data$conc time <- impute_data$time + tmp_method <- paste( + tmp_method, "Imputation: ", + paste0(impute_method, collapse = ", "), ".", sep=" " + ) } # Prepare the return value using SDTM names ret <- data.frame(PPTESTCD=NA, PPORRES=NA)[-1,] @@ -485,6 +490,7 @@ pk.nca.interval <- function(conc, time, volume, duration.conc, } } } + # Apply manual inclusion and exclusion if (n %in% "half.life") { if (!is.null(include_half.life) && !all(is.na(include_half.life))) { @@ -498,6 +504,28 @@ pk.nca.interval <- function(conc, time, volume, duration.conc, call_args$time <- call_args$time[!exclude_tf] } } + # For half-life related parameters, indicate if there was any manual inclusion / exclusion + if (n %in% get.parameter.deps("half.life")) { + any_inclusion <- !is.null(include_half.life) && !all(is.na(include_half.life)) + any_exclusion <- !is.null(exclude_half.life) && !all(is.na(exclude_half.life)) + tmp_method <- paste0( + tmp_method, + "Lambda Z: ", + {if (any_inclusion) "Manual selection" else if (any_exclusion) "Manual exclusion" else "Default"}, + sep=" " + ) + } + # For AUC parameters, indicate the calculation method + auc_parameters <- grep("auc", names(get.interval.cols()), value = TRUE) + if (n %in% auc_parameters) { + tmp_method <- paste0( + tmp_method, + "AUC: ", + options$auc.method, + ".", + collapse = " " + ) + } # Do the calculation tmp_result <- do.call(all_intervals[[n]]$FUN, call_args) # The handling of the exclude column is documented in the @@ -548,6 +576,7 @@ pk.nca.interval <- function(conc, time, volume, duration.conc, data.frame( PPTESTCD=tmp_testcd, PPORRES=tmp_result, + PPANMETH=tmp_method, exclude=exclude_reason, stringsAsFactors=FALSE ) From 32b19a3657415a0380dfc8a8185455c6ef80de5b Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 30 Aug 2025 14:46:51 +0200 Subject: [PATCH 02/20] specify arg for ppanmeth and fix paste issue --- R/pk.calc.all.R | 48 +++++++++++++++++++++++++++--------------------- 1 file changed, 27 insertions(+), 21 deletions(-) diff --git a/R/pk.calc.all.R b/R/pk.calc.all.R index 7640b9b2..972413ad 100644 --- a/R/pk.calc.all.R +++ b/R/pk.calc.all.R @@ -10,13 +10,15 @@ #' the interval. For example, if an interval starts at 168 hours, ends at 192 #' hours, and and the maximum concentration is at 169 hours, `tmax=169-168=1`. #' -#' @param data A PKNCAdata object -#' @param verbose Indicate, by `message()`, the current state of calculation. -#' @returns A `PKNCAresults` object. -#' @seealso [PKNCAdata()], [PKNCA.options()], [summary.PKNCAresults()], -#' [as.data.frame.PKNCAresults()], [exclude()] -#' @export -pk.nca <- function(data, verbose=FALSE) { +##' @param data A PKNCAdata object +##' @param verbose Indicate, by `message()`, the current state of calculation. +##' @param include_ppanmeth Logical; if TRUE, output includes the PPANMETH column +##' with the analysis method specifications for the parameter. Default is FALSE. +##' @returns A `PKNCAresults` object. +##' @seealso [PKNCAdata()], [PKNCA.options()], [summary.PKNCAresults()], +##' [as.data.frame.PKNCAresults()], [exclude()] +##' @export +pk.nca <- function(data, verbose=FALSE, include_ppanmeth=FALSE) { assert_PKNCAdata(data) results <- data.frame() if (nrow(data$intervals) > 0) { @@ -73,6 +75,10 @@ pk.nca <- function(data, verbose=FALSE) { ) } } + # Remove PPANMETH column if include_ppanmeth is FALSE + if (!include_ppanmeth && "PPANMETH" %in% names(results)) { + results$PPANMETH <- NULL + } PKNCAresults( result=results, data=data, @@ -363,7 +369,7 @@ pk.nca.interval <- function(conc, time, volume, duration.conc, if (nrow(interval) != 1) { stop("Please report a bug. Interval must be a one-row data.frame") } - tmp_method <- "" + if (!all(is.na(impute_method))) { impute_funs <- PKNCA_impute_fun_list(impute_method) stopifnot(length(impute_funs) == 1) @@ -379,10 +385,11 @@ pk.nca.interval <- function(conc, time, volume, duration.conc, } conc <- impute_data$conc time <- impute_data$time - tmp_method <- paste( - tmp_method, "Imputation: ", - paste0(impute_method, collapse = ", "), ".", sep=" " + tmp_imp_method <- c( + paste0("Imputation: ", paste(na.omit(impute_method), collapse = ", ")) ) + } else { + tmp_imp_method <- c() } # Prepare the return value using SDTM names ret <- data.frame(PPTESTCD=NA, PPORRES=NA)[-1,] @@ -404,6 +411,7 @@ pk.nca.interval <- function(conc, time, volume, duration.conc, } # Do the calculations for (n in names(all_intervals)) { + tmp_method <- c(tmp_imp_method) request_to_calculate <- as.logical(interval[[n]]) has_calculation_function <- !is.na(all_intervals[[n]]$FUN) is_correct_sparse_dense <- all_intervals[[n]]$sparse == sparse @@ -508,22 +516,20 @@ pk.nca.interval <- function(conc, time, volume, duration.conc, if (n %in% get.parameter.deps("half.life")) { any_inclusion <- !is.null(include_half.life) && !all(is.na(include_half.life)) any_exclusion <- !is.null(exclude_half.life) && !all(is.na(exclude_half.life)) - tmp_method <- paste0( + tmp_method <- c( tmp_method, - "Lambda Z: ", - {if (any_inclusion) "Manual selection" else if (any_exclusion) "Manual exclusion" else "Default"}, - sep=" " + paste0( + "Lambda Z: ", + {if (any_inclusion) "Manual selection" else if (any_exclusion) "Manual exclusion" else "Default"} + ) ) } # For AUC parameters, indicate the calculation method auc_parameters <- grep("auc", names(get.interval.cols()), value = TRUE) if (n %in% auc_parameters) { - tmp_method <- paste0( + tmp_method <- c( tmp_method, - "AUC: ", - options$auc.method, - ".", - collapse = " " + paste0("AUC: ", options$auc.method) ) } # Do the calculation @@ -576,7 +582,7 @@ pk.nca.interval <- function(conc, time, volume, duration.conc, data.frame( PPTESTCD=tmp_testcd, PPORRES=tmp_result, - PPANMETH=tmp_method, + PPANMETH=paste(tmp_method, collapse=". "), exclude=exclude_reason, stringsAsFactors=FALSE ) From e17ab383b4ead1d1cf4e1a6305fc7dae25acd694 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 30 Aug 2025 14:50:37 +0200 Subject: [PATCH 03/20] add tests for PPANMETH in pk.nca output --- tests/testthat/test-pk.calc.all.R | 97 +++++++++++++++++++++++++++++++ 1 file changed, 97 insertions(+) diff --git a/tests/testthat/test-pk.calc.all.R b/tests/testthat/test-pk.calc.all.R index ac48ef24..23b8e41c 100644 --- a/tests/testthat/test-pk.calc.all.R +++ b/tests/testthat/test-pk.calc.all.R @@ -758,3 +758,100 @@ test_that("do not give rbind error when interval columns have attributes (#381)" list(label = "start") ) }) + +test_that("pk.nca with include_ppanmeth=TRUE", { + # --- Setup shared concentration and dose data --- + tmpconc <- generate.conc(2, 1, 0:24) + tmpdose <- generate.dose(tmpconc) + myconc <- PKNCAconc(tmpconc, formula=conc~time|treatment+ID) + mydose <- PKNCAdose(tmpdose, formula=dose~time|treatment+ID) + + # --- PPANMETH differentiates based on the AUC method used --- + mydata_linear <- PKNCAdata(myconc, mydose, intervals=data.frame(start=0, end=24, auclast=TRUE), options=list(auc.method="linear")) + mydata_linlog <- PKNCAdata(myconc, mydose, intervals=data.frame(start=0, end=24, auclast=TRUE), options=list(auc.method="lin up/log down")) + res_linear <- pk.nca(mydata_linear, include_ppanmeth=TRUE) + res_linlog <- pk.nca(mydata_linlog, include_ppanmeth=TRUE) + expect_true("PPANMETH" %in% names(res_linear$result)) + expect_true("PPANMETH" %in% names(res_linlog$result)) + expect_true(any(grepl("AUC: linear", res_linear$result$PPANMETH, fixed=TRUE))) + expect_true(any(grepl("AUC: lin up/log down", res_linlog$result$PPANMETH, fixed=TRUE))) + + # --- PPANMETH distinguishes how the half.life was adjusted --- + tmpconc$include_hl <- tmpconc$time <= 22 + tmpconc$exclude_hl <- tmpconc$time == 22 + myconc_base <- PKNCAconc(tmpconc, formula=conc~time|treatment+ID) + myconc_incl <- PKNCAconc(tmpconc, formula=conc~time|treatment+ID, include_half.life="include_hl") + myconc_excl <- PKNCAconc(tmpconc, formula=conc~time|treatment+ID, exclude_half.life="exclude_hl") + mydata_base <- PKNCAdata(myconc_base, mydose, intervals=data.frame(start=0, end=24, lambda.z=TRUE)) + mydata_incl <- PKNCAdata(myconc_incl, mydose, intervals=data.frame(start=0, end=24, lambda.z=TRUE)) + mydata_excl <- PKNCAdata(myconc_excl, mydose, intervals=data.frame(start=0, end=24, lambda.z=TRUE)) + res_base <- pk.nca(mydata_base, include_ppanmeth=TRUE) + res_incl <- pk.nca(mydata_incl, include_ppanmeth=TRUE) + res_excl <- pk.nca(mydata_excl, include_ppanmeth=TRUE) + expect_true("PPANMETH" %in% names(res_base$result)) + expect_true("PPANMETH" %in% names(res_incl$result)) + expect_true("PPANMETH" %in% names(res_excl$result)) + expect_equal( + unique(res_base$result$PPANMETH[res_base$result$PPTESTCD %in% c("lambda.z", "half.life", "r.squared")]), + "Lambda Z: Default" + ) + expect_equal( + unique(res_incl$result$PPANMETH[res_incl$result$PPTESTCD %in% c("lambda.z", "half.life", "r.squared")]), + "Lambda Z: Manual selection" + ) + expect_equal( + unique(res_excl$result$PPANMETH[res_excl$result$PPTESTCD %in% c("lambda.z", "half.life", "r.squared")]), + "Lambda Z: Manual exclusion" + ) + expect_equal( + unique(res_base$result$PPANMETH[res_base$result$PPTESTCD %in% c("tmax", "cmax")]), + "" + ) + expect_equal( + unique(res_incl$result$PPANMETH[res_incl$result$PPTESTCD %in% c("tmax", "cmax")]), + "" + ) + expect_equal( + unique(res_excl$result$PPANMETH[res_excl$result$PPTESTCD %in% c("tmax", "cmax")]), + "" + ) + + # --- PPANMETH specifies if an imputation method was used in the interval --- + tmpconc1 <- generate.conc(1, 1, 1:24) + tmpdose1 <- generate.dose(tmpconc1) + myconc1 <- PKNCAconc(tmpconc1, formula=conc~time|treatment+ID) + mydose1 <- PKNCAdose(tmpdose1, formula=dose~time|treatment+ID) + o_data <- PKNCAdata(myconc1, mydose1, intervals=data.frame(start=0, end=24, c0=TRUE)) + o_data_impute <- PKNCAdata(myconc1, mydose1, intervals=data.frame(start=0, end=24, c0=TRUE), impute="start_conc0") + res <- pk.nca(o_data, include_ppanmeth=TRUE) + res_impute <- pk.nca(o_data_impute, include_ppanmeth=TRUE) + expect_equal(res$result$PPANMETH, "") + expect_true("PPANMETH" %in% names(res$result)) + expect_equal(res$result$PPANMETH, "") + expect_equal(res_impute$result$PPANMETH, "Imputation: start_conc0") + + # --- PPANMETH reports based on the parameter dependencies --- + tmpconc2 <- generate.conc(1, 1, 1:12) + tmpdose2 <- generate.dose(tmpconc2) + tmpconc2$include_hl <- tmpconc2$time <= 22 + myconc2 <- PKNCAconc(tmpconc2, formula=conc~time|treatment+ID, include_half.life="include_hl") + mydose2 <- PKNCAdose(tmpdose2, formula=dose~time|treatment+ID) + mydata2 <- PKNCAdata( + myconc2, mydose2, + intervals=data.frame(start=0, end=24, c0 = TRUE, half.life = TRUE, aucinf.pred=TRUE), + impute = "start_conc0" + ) + res2 <- pk.nca(mydata2, include_ppanmeth=TRUE) + expect_equal( + res2$result$PPANMETH[res2$result$PPTESTCD == "c0"], + "Imputation: start_conc0" + ) + expect_equal( + res2$result$PPANMETH[res2$result$PPTESTCD == "half.life"], + "Imputation: start_conc0. Lambda Z: Manual selection" + ) + expect_equal( + res2$result$PPANMETH[res2$result$PPTESTCD == "aucinf.pred"], + "Imputation: start_conc0. Lambda Z: Manual selection. AUC: lin up/log down" + ) +}) From f75865d44a4969122b99af58edab085d278a995f Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 30 Aug 2025 14:51:39 +0200 Subject: [PATCH 04/20] update pk.nca.Rd docs --- man/PKNCA.Rd | 1 + man/pk.nca.Rd | 5 ++++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/man/PKNCA.Rd b/man/PKNCA.Rd index 1aa1f6de..19a5fe7a 100644 --- a/man/PKNCA.Rd +++ b/man/PKNCA.Rd @@ -52,6 +52,7 @@ Useful links: Authors: \itemize{ \item Clare Buckeridge \email{clare.buckeridge@pfizer.com} + \item Gerardo Jose Rodriguez \email{gerardo.jrac@gmail.com} (\href{https://orcid.org/0000-0003-1413-0060}{ORCID}) } Other contributors: diff --git a/man/pk.nca.Rd b/man/pk.nca.Rd index e81ef002..09cea2f7 100644 --- a/man/pk.nca.Rd +++ b/man/pk.nca.Rd @@ -4,12 +4,15 @@ \alias{pk.nca} \title{Compute NCA parameters for each interval for each subject.} \usage{ -pk.nca(data, verbose = FALSE) +pk.nca(data, verbose = FALSE, include_ppanmeth = FALSE) } \arguments{ \item{data}{A PKNCAdata object} \item{verbose}{Indicate, by \code{message()}, the current state of calculation.} + +\item{include_ppanmeth}{Logical; if TRUE, output includes the PPANMETH column +with the analysis method specifications for the parameter. Default is FALSE.} } \value{ A \code{PKNCAresults} object. From 0e7de7a04d181d31f633d58d3da98ba012b7e55d Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 30 Aug 2025 14:57:23 +0200 Subject: [PATCH 05/20] news: add ppanmeth feat --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 726880ec..b5e5d958 100644 --- a/NEWS.md +++ b/NEWS.md @@ -20,6 +20,7 @@ the dosing including dose amount and route. * PKNCA now has a debugging mode to support troubleshooting; it is not intended for production use. Debugging mode can be enabled using `PKNCA.options(debug = TRUE)`. +* `pk.nca` now has a logical argument `include_ppanmeth` (default `FALSE`). When set to `TRUE`, the output includes a `PPANMETH` column describing the analysis methods used for each parameter. # PKNCA 0.12.0 From 2b4c1b5d2a5d5b82d96105b3393f4824890b8638 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 30 Aug 2025 15:07:48 +0200 Subject: [PATCH 06/20] refactor a bit tests --- tests/testthat/test-pk.calc.all.R | 27 +++++++++------------------ 1 file changed, 9 insertions(+), 18 deletions(-) diff --git a/tests/testthat/test-pk.calc.all.R b/tests/testthat/test-pk.calc.all.R index 23b8e41c..5eb61b1b 100644 --- a/tests/testthat/test-pk.calc.all.R +++ b/tests/testthat/test-pk.calc.all.R @@ -761,7 +761,7 @@ test_that("do not give rbind error when interval columns have attributes (#381)" test_that("pk.nca with include_ppanmeth=TRUE", { # --- Setup shared concentration and dose data --- - tmpconc <- generate.conc(2, 1, 0:24) + tmpconc <- generate.conc(1, 1, 0:24) tmpdose <- generate.dose(tmpconc) myconc <- PKNCAconc(tmpconc, formula=conc~time|treatment+ID) mydose <- PKNCAdose(tmpdose, formula=dose~time|treatment+ID) @@ -817,12 +817,8 @@ test_that("pk.nca with include_ppanmeth=TRUE", { ) # --- PPANMETH specifies if an imputation method was used in the interval --- - tmpconc1 <- generate.conc(1, 1, 1:24) - tmpdose1 <- generate.dose(tmpconc1) - myconc1 <- PKNCAconc(tmpconc1, formula=conc~time|treatment+ID) - mydose1 <- PKNCAdose(tmpdose1, formula=dose~time|treatment+ID) - o_data <- PKNCAdata(myconc1, mydose1, intervals=data.frame(start=0, end=24, c0=TRUE)) - o_data_impute <- PKNCAdata(myconc1, mydose1, intervals=data.frame(start=0, end=24, c0=TRUE), impute="start_conc0") + o_data <- PKNCAdata(myconc, mydose, intervals=data.frame(start=0, end=24, c0=TRUE)) + o_data_impute <- PKNCAdata(myconc, mydose, intervals=data.frame(start=0, end=24, c0=TRUE), impute="start_conc0") res <- pk.nca(o_data, include_ppanmeth=TRUE) res_impute <- pk.nca(o_data_impute, include_ppanmeth=TRUE) expect_equal(res$result$PPANMETH, "") @@ -831,27 +827,22 @@ test_that("pk.nca with include_ppanmeth=TRUE", { expect_equal(res_impute$result$PPANMETH, "Imputation: start_conc0") # --- PPANMETH reports based on the parameter dependencies --- - tmpconc2 <- generate.conc(1, 1, 1:12) - tmpdose2 <- generate.dose(tmpconc2) - tmpconc2$include_hl <- tmpconc2$time <= 22 - myconc2 <- PKNCAconc(tmpconc2, formula=conc~time|treatment+ID, include_half.life="include_hl") - mydose2 <- PKNCAdose(tmpdose2, formula=dose~time|treatment+ID) - mydata2 <- PKNCAdata( - myconc2, mydose2, + mydata <- PKNCAdata( + myconc_incl, mydose, intervals=data.frame(start=0, end=24, c0 = TRUE, half.life = TRUE, aucinf.pred=TRUE), impute = "start_conc0" ) - res2 <- pk.nca(mydata2, include_ppanmeth=TRUE) + res <- pk.nca(mydata, include_ppanmeth=TRUE) expect_equal( - res2$result$PPANMETH[res2$result$PPTESTCD == "c0"], + res$result$PPANMETH[res$result$PPTESTCD == "c0"], "Imputation: start_conc0" ) expect_equal( - res2$result$PPANMETH[res2$result$PPTESTCD == "half.life"], + res$result$PPANMETH[res$result$PPTESTCD == "half.life"], "Imputation: start_conc0. Lambda Z: Manual selection" ) expect_equal( - res2$result$PPANMETH[res2$result$PPTESTCD == "aucinf.pred"], + res$result$PPANMETH[res$result$PPTESTCD == "aucinf.pred"], "Imputation: start_conc0. Lambda Z: Manual selection. AUC: lin up/log down" ) }) From 7ea493d02a3b130567d41a15acd585638191e8e6 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Fri, 12 Sep 2025 22:22:23 +0200 Subject: [PATCH 07/20] modify: rm arg option from pk.nca and news --- NEWS.md | 5 +++-- R/pk.calc.all.R | 6 +----- man/pk.nca.Rd | 2 +- 3 files changed, 5 insertions(+), 8 deletions(-) diff --git a/NEWS.md b/NEWS.md index 0657e02c..0eb903dc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -16,6 +16,8 @@ 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. +* `pk.nca` output now includes a `PPANMETH` column describing the analysis methods used for each parameter regarding imputations, AUC and half.life calculations (#457) + # PKNCA 0.12.1 ## Minor changes (unlikely to affect PKNCA use) @@ -24,7 +26,7 @@ the dosing including dose amount and route. amount/dose units rather than "fraction" (#426) * `get_halflife_points` will ignore points after `lambda.z.time.last`, instead of `tlast` (#448) -* `lambda.z` calculations will now only consider time points that occur after +* `lambda.z` calculations will now only consxider time points that occur after the end of the latest dose administration (#139) * `aucint.inf.pred` is `NA` when half-life is not estimable (#450) @@ -33,7 +35,6 @@ the dosing including dose amount and route. * PKNCA now has a debugging mode to support troubleshooting; it is not intended for production use. Debugging mode can be enabled using `PKNCA.options(debug = TRUE)`. -* `pk.nca` now has a logical argument `include_ppanmeth` (default `FALSE`). When set to `TRUE`, the output includes a `PPANMETH` column describing the analysis methods used for each parameter. # PKNCA 0.12.0 diff --git a/R/pk.calc.all.R b/R/pk.calc.all.R index 972413ad..6b3d4f45 100644 --- a/R/pk.calc.all.R +++ b/R/pk.calc.all.R @@ -18,7 +18,7 @@ ##' @seealso [PKNCAdata()], [PKNCA.options()], [summary.PKNCAresults()], ##' [as.data.frame.PKNCAresults()], [exclude()] ##' @export -pk.nca <- function(data, verbose=FALSE, include_ppanmeth=FALSE) { +pk.nca <- function(data, verbose=FALSE) { assert_PKNCAdata(data) results <- data.frame() if (nrow(data$intervals) > 0) { @@ -75,10 +75,6 @@ pk.nca <- function(data, verbose=FALSE, include_ppanmeth=FALSE) { ) } } - # Remove PPANMETH column if include_ppanmeth is FALSE - if (!include_ppanmeth && "PPANMETH" %in% names(results)) { - results$PPANMETH <- NULL - } PKNCAresults( result=results, data=data, diff --git a/man/pk.nca.Rd b/man/pk.nca.Rd index 09cea2f7..6bc64c7d 100644 --- a/man/pk.nca.Rd +++ b/man/pk.nca.Rd @@ -4,7 +4,7 @@ \alias{pk.nca} \title{Compute NCA parameters for each interval for each subject.} \usage{ -pk.nca(data, verbose = FALSE, include_ppanmeth = FALSE) +pk.nca(data, verbose = FALSE) } \arguments{ \item{data}{A PKNCAdata object} From 6fb8505ff647d138b6ce9596c368ec8f80be7e3c Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Fri, 12 Sep 2025 22:35:27 +0200 Subject: [PATCH 08/20] test: rm ppanmeth arg --- tests/testthat/test-pk.calc.all.R | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/tests/testthat/test-pk.calc.all.R b/tests/testthat/test-pk.calc.all.R index 4c56e5a3..7f9b22b1 100644 --- a/tests/testthat/test-pk.calc.all.R +++ b/tests/testthat/test-pk.calc.all.R @@ -759,7 +759,7 @@ test_that("do not give rbind error when interval columns have attributes (#381)" ) }) -test_that("pk.nca with include_ppanmeth=TRUE", { +test_that("pk.nca produces the PPANMETH column", { # --- Setup shared concentration and dose data --- tmpconc <- generate.conc(1, 1, 0:24) tmpdose <- generate.dose(tmpconc) @@ -769,8 +769,8 @@ test_that("pk.nca with include_ppanmeth=TRUE", { # --- PPANMETH differentiates based on the AUC method used --- mydata_linear <- PKNCAdata(myconc, mydose, intervals=data.frame(start=0, end=24, auclast=TRUE), options=list(auc.method="linear")) mydata_linlog <- PKNCAdata(myconc, mydose, intervals=data.frame(start=0, end=24, auclast=TRUE), options=list(auc.method="lin up/log down")) - res_linear <- pk.nca(mydata_linear, include_ppanmeth=TRUE) - res_linlog <- pk.nca(mydata_linlog, include_ppanmeth=TRUE) + res_linear <- pk.nca(mydata_linear) + res_linlog <- pk.nca(mydata_linlog) expect_true("PPANMETH" %in% names(res_linear$result)) expect_true("PPANMETH" %in% names(res_linlog$result)) expect_true(any(grepl("AUC: linear", res_linear$result$PPANMETH, fixed=TRUE))) @@ -785,9 +785,9 @@ test_that("pk.nca with include_ppanmeth=TRUE", { mydata_base <- PKNCAdata(myconc_base, mydose, intervals=data.frame(start=0, end=24, lambda.z=TRUE)) mydata_incl <- PKNCAdata(myconc_incl, mydose, intervals=data.frame(start=0, end=24, lambda.z=TRUE)) mydata_excl <- PKNCAdata(myconc_excl, mydose, intervals=data.frame(start=0, end=24, lambda.z=TRUE)) - res_base <- pk.nca(mydata_base, include_ppanmeth=TRUE) - res_incl <- pk.nca(mydata_incl, include_ppanmeth=TRUE) - res_excl <- pk.nca(mydata_excl, include_ppanmeth=TRUE) + res_base <- pk.nca(mydata_base) + res_incl <- pk.nca(mydata_incl) + res_excl <- pk.nca(mydata_excl) expect_true("PPANMETH" %in% names(res_base$result)) expect_true("PPANMETH" %in% names(res_incl$result)) expect_true("PPANMETH" %in% names(res_excl$result)) @@ -819,8 +819,8 @@ test_that("pk.nca with include_ppanmeth=TRUE", { # --- PPANMETH specifies if an imputation method was used in the interval --- o_data <- PKNCAdata(myconc, mydose, intervals=data.frame(start=0, end=24, c0=TRUE)) o_data_impute <- PKNCAdata(myconc, mydose, intervals=data.frame(start=0, end=24, c0=TRUE), impute="start_conc0") - res <- pk.nca(o_data, include_ppanmeth=TRUE) - res_impute <- pk.nca(o_data_impute, include_ppanmeth=TRUE) + res <- pk.nca(o_data) + res_impute <- pk.nca(o_data_impute) expect_equal(res$result$PPANMETH, "") expect_true("PPANMETH" %in% names(res$result)) expect_equal(res$result$PPANMETH, "") @@ -832,7 +832,7 @@ test_that("pk.nca with include_ppanmeth=TRUE", { intervals=data.frame(start=0, end=24, c0 = TRUE, half.life = TRUE, aucinf.pred=TRUE), impute = "start_conc0" ) - res <- pk.nca(mydata, include_ppanmeth=TRUE) + res <- pk.nca(mydata) expect_equal( res$result$PPANMETH[res$result$PPTESTCD == "c0"], "Imputation: start_conc0" From 91d497595b69452a68d1d4b33da806b2dc17d503 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 13 Sep 2025 09:55:29 +0200 Subject: [PATCH 09/20] fix: disconsider PPANMETH for wide results --- R/class-PKNCAresults.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/class-PKNCAresults.R b/R/class-PKNCAresults.R index 7fdefeb9..e42054fa 100644 --- a/R/class-PKNCAresults.R +++ b/R/class-PKNCAresults.R @@ -89,7 +89,7 @@ as.data.frame.PKNCAresults <- function(x, ..., out_format = c('long', 'wide'), f # Since we moved the results into PPTESTCD and PPORRES regardless of what # they really are in the source data, remove the extra units and unit # conversion columns to allow spread to work. - ret <- ret[, setdiff(names(ret), c("PPSTRES", "PPSTRESU", "PPORRESU"))] + ret <- ret[, setdiff(names(ret), c("PPSTRES", "PPSTRESU", "PPORRESU", "PPANMETH"))] ret <- tidyr::spread(ret, key="PPTESTCD", value="PPORRES") } ret From e632ed70f6797b46eb79599f633f0efbbb2744a6 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 13 Sep 2025 09:57:22 +0200 Subject: [PATCH 10/20] test: add PPANMETH col when relevant --- tests/testthat/test-class-PKNCAresults.R | 291 ++++++++++++----------- tests/testthat/test-pk.calc.all.R | 16 ++ tests/testthat/test-pk.calc.simple.R | 1 + 3 files changed, 173 insertions(+), 135 deletions(-) diff --git a/tests/testthat/test-class-PKNCAresults.R b/tests/testthat/test-class-PKNCAresults.R index 10bb6b89..d968ef08 100644 --- a/tests/testthat/test-class-PKNCAresults.R +++ b/tests/testthat/test-class-PKNCAresults.R @@ -1,7 +1,7 @@ test_that("PKNCAresults object creation", { - minimal_result <- PKNCAresults(data.frame(a=1), data=list()) + minimal_result <- PKNCAresults(data.frame(a = 1), data = list()) expect_equal(minimal_result$columns$exclude, "exclude") - result_with_exclude_col <- PKNCAresults(data.frame(exclude=1), data=list()) + result_with_exclude_col <- PKNCAresults(data.frame(exclude = 1), data = list()) expect_equal(result_with_exclude_col$columns$exclude, "exclude.exclude") }) @@ -10,100 +10,120 @@ test_that("PKNCAresults generation", { # to happen here. tmpconc <- generate.conc(2, 1, 0:24) tmpdose <- generate.dose(tmpconc) - myconc <- PKNCAconc(tmpconc, formula=conc~time|treatment+ID) - mydose <- PKNCAdose(tmpdose, formula=dose~time|treatment+ID) + myconc <- PKNCAconc(tmpconc, formula = conc ~ time | treatment + ID) + mydose <- PKNCAdose(tmpdose, formula = dose ~ time | treatment + ID) mydata <- PKNCAdata(myconc, mydose) myresult <- pk.nca(mydata) expect_equal( names(myresult), c("result", "data", "columns"), - info="Make sure that the result has the expected names (and only the expected names) in it." + info = "Make sure that the result has the expected names (and only the expected names) in it." ) expect_true( checkProvenance(myresult), - info="Provenance exists and can be confirmed on results" + info = "Provenance exists and can be confirmed on results" ) # Test each of the pieces for myresult for accuracy expect_equal( - myresult$data, { + myresult$data, + { tmp <- mydata # The options should be the default options after the # calculations are done. tmp$options <- PKNCA.options() tmp - }, info="The data is just a copy of the input data plus an instantiation of the PKNCA.options" + }, + info = "The data is just a copy of the input data plus an instantiation of the PKNCA.options" ) verify.result <- tibble::tibble( - treatment="Trt 1", - ID=as.integer(rep(c(1, 2), each=16)), - start=0, - end=c(24, rep(Inf, 15), - 24, rep(Inf, 15)), - PPTESTCD=rep(c("auclast", "cmax", "tmax", "tlast", "clast.obs", - "lambda.z", "r.squared", "adj.r.squared", "lambda.z.corrxy", - "lambda.z.time.first", "lambda.z.time.last", "lambda.z.n.points", - "clast.pred", "half.life", "span.ratio", "aucinf.obs"), - times=2), - PPORRES=c(13.54, 0.9998, 4.000, 24.00, 0.3441, - 0.04297, 0.9072, 0.9021, -0.9521, 5.000, 24.00, - 20.00, 0.3356, 16.13, 1.178, - 21.55, 14.03, 0.9410, 2.000, - 24.00, 0.3148, 0.05689, 0.9000, - 0.8944, -0.9487, 5.000, 24.00, 20.00, 0.3011, - 12.18, 1.560, 19.56), - exclude=NA_character_ + treatment = "Trt 1", + ID = as.integer(rep(c(1, 2), each = 16)), + start = 0, + end = c( + 24, rep(Inf, 15), + 24, rep(Inf, 15) + ), + PPTESTCD = rep( + c( + "auclast", "cmax", "tmax", "tlast", "clast.obs", + "lambda.z", "r.squared", "adj.r.squared", "lambda.z.corrxy", + "lambda.z.time.first", "lambda.z.time.last", "lambda.z.n.points", + "clast.pred", "half.life", "span.ratio", "aucinf.obs" + ), + times = 2 + ), + PPORRES = c( + 13.54, 0.9998, 4.000, 24.00, 0.3441, + 0.04297, 0.9072, 0.9021, -0.9521, 5.000, 24.00, + 20.00, 0.3356, 16.13, 1.178, + 21.55, 14.03, 0.9410, 2.000, + 24.00, 0.3148, 0.05689, 0.9000, + 0.8944, -0.9487, 5.000, 24.00, 20.00, 0.3011, + 12.18, 1.560, 19.56 + ), + PPANMETH = c( + "AUC: lin up/log down", + rep("", 4), + rep("Lambda Z: Default", 10), + "Lambda Z: Default. AUC: lin up/log down", + "AUC: lin up/log down", + rep("", 4), + rep("Lambda Z: Default", 10), + "Lambda Z: Default. AUC: lin up/log down" + ), + exclude = NA_character_ ) expect_equal( myresult$result, verify.result, - tolerance=0.001, - info="The specific order of the levels isn't important-- the fact that they are factors and that the set doesn't change is important." + tolerance = 0.001, + info = "The specific order of the levels isn't important-- the fact that they are factors and that the set doesn't change is important." ) # Test conversion to a data.frame expect_equal( as.data.frame(myresult), verify.result, - tolerance=0.001, - info="Conversion of PKNCAresults to a data.frame in long format (default long format)" + tolerance = 0.001, + info = "Conversion of PKNCAresults to a data.frame in long format (default long format)" ) expect_equal( - as.data.frame(myresult, out_format="long"), + as.data.frame(myresult, out_format = "long"), verify.result, - tolerance=0.001, - info="Conversion of PKNCAresults to a data.frame in long format (specifying long format)" + tolerance = 0.001, + info = "Conversion of PKNCAresults to a data.frame in long format (specifying long format)" ) expect_equal( - as.data.frame(myresult, out_format="wide"), - tidyr::spread(verify.result, key="PPTESTCD", value="PPORRES"), - tolerance=0.001, - info="Conversion of PKNCAresults to a data.frame in wide format (specifying wide format)" + as.data.frame(myresult, out_format = "wide"), + tidyr::spread(verify.result[,names(verify.result) != "PPANMETH"], key = "PPTESTCD", value = "PPORRES"), + tolerance = 0.001, + info = "Conversion of PKNCAresults to a data.frame in wide format (specifying wide format)" ) tmpconc <- generate.conc(2, 1, 0:24) tmpdose <- generate.dose(tmpconc) - myconc <- PKNCAconc(tmpconc, formula=conc~time|treatment+ID) - mydose <- PKNCAdose(tmpdose, formula=dose~time|treatment+ID) - mydata <- PKNCAdata(myconc, mydose, intervals=data.frame(start=0, end=12, aucint.inf.obs=TRUE)) + myconc <- PKNCAconc(tmpconc, formula = conc ~ time | treatment + ID) + mydose <- PKNCAdose(tmpdose, formula = dose ~ time | treatment + ID) + mydata <- PKNCAdata(myconc, mydose, intervals = data.frame(start = 0, end = 12, aucint.inf.obs = TRUE)) myresult <- pk.nca(mydata) tmpconc12 <- tmpconc tmpconc12$time <- tmpconc$time + 12 tmpdose12 <- generate.dose(tmpconc12) - myconc12 <- PKNCAconc(tmpconc12, formula=conc~time|treatment+ID) - mydose12 <- PKNCAdose(tmpdose12, formula=dose~time|treatment+ID) - mydata12 <- PKNCAdata(myconc12, mydose12, intervals=data.frame(start=12, end=24, aucint.inf.obs=TRUE)) + myconc12 <- PKNCAconc(tmpconc12, formula = conc ~ time | treatment + ID) + mydose12 <- PKNCAdose(tmpdose12, formula = dose ~ time | treatment + ID) + mydata12 <- PKNCAdata(myconc12, mydose12, intervals = data.frame(start = 12, end = 24, aucint.inf.obs = TRUE)) myresult12 <- pk.nca(mydata12) comparison_orig <- as.data.frame(myresult) comparison_12 <- as.data.frame(myresult12) expect_equal( comparison_orig$PPORRES[comparison_orig$PPTESTCD %in% "aucint.inf.obs"], comparison_12$PPORRES[comparison_12$PPTESTCD %in% "aucint.inf.obs"], - info="Time shift does not affect aucint calculations." + info = "Time shift does not affect aucint calculations." ) }) @@ -111,69 +131,70 @@ test_that("PKNCAresults has exclude, when applicable", { tmpconc <- generate.conc(2, 1, 0:24) tmpconc$conc[tmpconc$ID %in% 2] <- 0 tmpdose <- generate.dose(tmpconc) - myconc <- PKNCAconc(tmpconc, conc~time|treatment+ID) - mydose <- PKNCAdose(tmpdose, dose~time|treatment+ID) + myconc <- PKNCAconc(tmpconc, conc ~ time | treatment + ID) + mydose <- PKNCAdose(tmpdose, dose ~ time | treatment + ID) mydata <- PKNCAdata(myconc, mydose) # Not capturing the warning due to R bug # https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=17122 - #expect_warning(myresult <- pk.nca(mydata), + # expect_warning(myresult <- pk.nca(mydata), # regexp="Too few points for half-life calculation") suppressWarnings(myresult <- pk.nca(mydata)) myresult_df <- as.data.frame(myresult) expect_true( all(myresult_df$PPTESTCD %in% - c( - "adj.r.squared", "lambda.z.corrxy", "aucinf.obs", "auclast", "clast.obs", - "clast.pred", "cmax", "half.life", "lambda.z", "lambda.z.n.points", - "lambda.z.time.first", "lambda.z.time.last", "r.squared", - "span.ratio", "tlast", "tmax" - ) - ), - info="verify that only expected results are present" + c( + "adj.r.squared", "lambda.z.corrxy", "aucinf.obs", "auclast", "clast.obs", + "clast.pred", "cmax", "half.life", "lambda.z", "lambda.z.n.points", + "lambda.z.time.first", "lambda.z.time.last", "r.squared", + "span.ratio", "tlast", "tmax" + )), + info = "verify that only expected results are present" ) expect_equal( unique( myresult_df$exclude[ myresult_df$ID == 2 & myresult_df$PPTESTCD %in% - c( - "lambda.z", "r.squared", "adj.r.squared", "lambda.z.corrxy", - "lambda.z.time.first", "lambda.z.time.last", - "lambda.z.n.points", "clast.pred", "half.life", "span.ratio" - ) - ] + c( + "lambda.z", "r.squared", "adj.r.squared", "lambda.z.corrxy", + "lambda.z.time.first", "lambda.z.time.last", + "lambda.z.n.points", "clast.pred", "half.life", "span.ratio" + ) + ] ), "Too few points for half-life calculation (min.hl.points=3 with only 0 points)", - info="exclusions are propogated to results" + info = "exclusions are propogated to results" ) expect_equal( unique( myresult_df$exclude[ !(myresult_df$ID == 2 & - myresult_df$PPTESTCD %in% - c("lambda.z", "r.squared", "adj.r.squared", "lambda.z.corrxy", "lambda.z.time.first", - "lambda.z.time.last", "lambda.z.n.points", "clast.pred", "half.life", "span.ratio") + myresult_df$PPTESTCD %in% + c( + "lambda.z", "r.squared", "adj.r.squared", "lambda.z.corrxy", "lambda.z.time.first", + "lambda.z.time.last", "lambda.z.n.points", "clast.pred", "half.life", "span.ratio" + ) ) - ] + ] ), NA_character_, - info="exclusions are propogated to results only when applicable" + info = "exclusions are propogated to results only when applicable" ) }) test_that("ptr works as a parameter", { tmpconc <- generate.conc(2, 1, 0:24) tmpdose <- generate.dose(tmpconc) - myconc <- PKNCAconc(tmpconc, formula=conc~time|treatment+ID) - mydose <- PKNCAdose(tmpdose, formula=dose~time|treatment+ID) - myinterval <- data.frame(start=0, end=24, ptr=TRUE) - mydata <- PKNCAdata(myconc, mydose, intervals=myinterval) + myconc <- PKNCAconc(tmpconc, formula = conc ~ time | treatment + ID) + mydose <- PKNCAdose(tmpdose, formula = dose ~ time | treatment + ID) + myinterval <- data.frame(start = 0, end = 24, ptr = TRUE) + mydata <- PKNCAdata(myconc, mydose, intervals = myinterval) myresult <- pk.nca(mydata) ptr_result <- as.data.frame(myresult) expect_equal( ptr_result$PPORRES[ptr_result$PPTESTCD %in% "ptr"], c(2.9055, 2.9885), - tolerance=0.0001 + tolerance = 0.0001 ) }) @@ -185,23 +206,23 @@ test_that("exclude values are maintained in derived parameters during automatic subject = 1 ) - conc_obj <- PKNCAconc(my_conc, conc~time|subject) + conc_obj <- PKNCAconc(my_conc, conc ~ time | subject) data_obj <- PKNCAdata( - data.conc=conc_obj, - intervals= + data.conc = conc_obj, + intervals = data.frame( - start=0, - end=Inf, - aucinf.obs=TRUE + start = 0, + end = Inf, + aucinf.obs = TRUE ) ) expect_message( expect_warning( results_obj <- pk.nca(data_obj), - regexp="Too few points for half-life" + regexp = "Too few points for half-life" ), - regexp="No dose information provided" + regexp = "No dose information provided" ) d_results <- as.data.frame(results_obj) expect_equal( @@ -211,16 +232,16 @@ test_that("exclude values are maintained in derived parameters during automatic }) test_that("ctrough is correctly calculated", { - my_conc <- data.frame(time=0:6, conc=2^(0:-6), subject=1) - conc_obj <- PKNCAconc(my_conc, conc~time|subject) + my_conc <- data.frame(time = 0:6, conc = 2^(0:-6), subject = 1) + conc_obj <- PKNCAconc(my_conc, conc ~ time | subject) data_obj <- PKNCAdata( - data.conc=conc_obj, - intervals= + data.conc = conc_obj, + intervals = data.frame( - start=0, - end=c(6, Inf), - ctrough=TRUE + start = 0, + end = c(6, Inf), + ctrough = TRUE ) ) expect_message( @@ -228,21 +249,21 @@ test_that("ctrough is correctly calculated", { as.data.frame(pk.nca(data_obj))$PPORRES, c(2^-6, NA_real_) ), - regexp="No dose information provided" + regexp = "No dose information provided" ) }) test_that("single subject, ungrouped data works (#74)", { - my_conc <- data.frame(time=0:6, conc=2^(0:-6)) - conc_obj <- PKNCAconc(my_conc, conc~time) + my_conc <- data.frame(time = 0:6, conc = 2^(0:-6)) + conc_obj <- PKNCAconc(my_conc, conc ~ time) data_obj <- PKNCAdata( - data.conc=conc_obj, - intervals= + data.conc = conc_obj, + intervals = data.frame( - start=0, - end=Inf, - cmax=TRUE + start = 0, + end = Inf, + cmax = TRUE ) ) expect_message( @@ -250,27 +271,27 @@ test_that("single subject, ungrouped data works (#74)", { as.data.frame(pk.nca(data_obj))$PPORRES, 1 ), - regexp="No dose information provided", + regexp = "No dose information provided", ) }) test_that("units work for calculations and summaries with one set of units across all analytes", { tmpconc <- generate.conc(2, 1, 0:24) tmpdose <- generate.dose(tmpconc) - myconc <- PKNCAconc(tmpconc, formula=conc~time|treatment+ID) - mydose <- PKNCAdose(tmpdose, formula=dose~time|treatment+ID) + myconc <- PKNCAconc(tmpconc, formula = conc ~ time | treatment + ID) + mydose <- PKNCAdose(tmpdose, formula = dose ~ time | treatment + ID) mydata <- PKNCAdata(myconc, mydose) myresult <- pk.nca(mydata) - d_units_orig <- pknca_units_table(concu="ng/mL", doseu="mg", amountu="mg", timeu="hr") + d_units_orig <- pknca_units_table(concu = "ng/mL", doseu = "mg", amountu = "mg", timeu = "hr") d_units_std <- pknca_units_table( - concu="ng/mL", doseu="mg", amountu="mg", timeu="hr", - conversions=data.frame(PPORRESU="ng/mL", PPSTRESU="mg/mL") + concu = "ng/mL", doseu = "mg", amountu = "mg", timeu = "hr", + conversions = data.frame(PPORRESU = "ng/mL", PPSTRESU = "mg/mL") ) - mydata_orig <- PKNCAdata(myconc, mydose, units=d_units_orig) + mydata_orig <- PKNCAdata(myconc, mydose, units = d_units_orig) myresult_units_orig <- pk.nca(mydata_orig) - mydata_std <- PKNCAdata(myconc, mydose, units=d_units_std) + mydata_std <- PKNCAdata(myconc, mydose, units = d_units_std) myresult_units_std <- pk.nca(mydata_std) # Summaries are the same except for the column names @@ -294,18 +315,18 @@ test_that("units work for calculations and summaries with one set of units acros c(".", "9.70e-7 [4.29]") ) # Wide conversion works for original and standardized units - df_wide_orig <- as.data.frame(myresult_units_orig, out_format="wide") - df_wide_std <- as.data.frame(myresult_units_std, out_format="wide") + df_wide_orig <- as.data.frame(myresult_units_orig, out_format = "wide") + df_wide_std <- as.data.frame(myresult_units_std, out_format = "wide") expect_equal( - as.data.frame(myresult, out_format="wide"), + as.data.frame(myresult, out_format = "wide"), # The difference is the addition of units to the column names df_wide_orig %>% - dplyr::rename_with(.fn=gsub, pattern=" \\(.*$", replacement="") + dplyr::rename_with(.fn = gsub, pattern = " \\(.*$", replacement = "") ) expect_true( all( names(df_wide_orig) %in% c("treatment", "ID", "start", "end", "exclude") | - grepl(x=names(df_wide_orig), pattern=" (", fixed=TRUE) + grepl(x = names(df_wide_orig), pattern = " (", fixed = TRUE) ) ) # Everything is the same unless it is a concentration which has been converted @@ -316,7 +337,7 @@ test_that("units work for calculations and summaries with one set of units acros # Concentration conversion works correctly expect_equal( df_wide_orig$`cmax (ng/mL)`, - df_wide_std$`cmax (mg/mL)`*1e6 + df_wide_std$`cmax (mg/mL)` * 1e6 ) }) @@ -328,25 +349,25 @@ test_that("units work for calculations and summaries with one set of units acros tmpconc <- rbind(tmpconc1, tmpconc2) tmpdose <- generate.dose(tmpconc) - myconc <- PKNCAconc(tmpconc, formula=conc~time|treatment+ID/analyte) - mydose <- PKNCAdose(tmpdose, formula=dose~time|treatment+ID) + myconc <- PKNCAconc(tmpconc, formula = conc ~ time | treatment + ID / analyte) + mydose <- PKNCAdose(tmpdose, formula = dose ~ time | treatment + ID) mydata <- PKNCAdata(myconc, mydose) myresult <- pk.nca(mydata) d_units_std1 <- pknca_units_table( - concu="ng/mL", doseu="mg", amountu="mg", timeu="hr", - conversions=data.frame(PPORRESU="ng/mL", PPSTRESU="mg/mL") + concu = "ng/mL", doseu = "mg", amountu = "mg", timeu = "hr", + conversions = data.frame(PPORRESU = "ng/mL", PPSTRESU = "mg/mL") ) d_units_std1$analyte <- "drug1" d_units_std2 <- pknca_units_table( - concu="ng/mL", doseu="mg", amountu="mg", timeu="hr", - conversions=data.frame(PPORRESU="ng/mL", PPSTRESU="mmol/L", conversion_factor=2) + concu = "ng/mL", doseu = "mg", amountu = "mg", timeu = "hr", + conversions = data.frame(PPORRESU = "ng/mL", PPSTRESU = "mmol/L", conversion_factor = 2) ) d_units_std2$analyte <- "drug2" d_units_std <- rbind(d_units_std1, d_units_std2) - mydata_std <- PKNCAdata(myconc, mydose, units=d_units_std) + mydata_std <- PKNCAdata(myconc, mydose, units = d_units_std) myresult_units_std <- pk.nca(mydata_std) summary_myresult_units_std <- summary(myresult_units_std) # Everything is the same between analytes except for "cmax" @@ -367,54 +388,54 @@ test_that("units work for calculations and summaries with one set of units acros myresult_units_manipulated$result$PPSTRESU[myresult_units_manipulated$result$PPTESTCD %in% "auclast"][1] <- "foo" expect_error( summary(myresult_units_manipulated), - regexp="Multiple units cannot be summarized together. For auclast, trying to combine: foo, hr*ng/mL", - fixed=TRUE + regexp = "Multiple units cannot be summarized together. For auclast, trying to combine: foo, hr*ng/mL", + fixed = TRUE ) }) test_that("getGroups.PKNCAresults", { tmpconc <- generate.conc(2, 1, 0:24) tmpdose <- generate.dose(tmpconc) - myconc <- PKNCAconc(tmpconc, formula=conc~time|treatment+ID) - mydose <- PKNCAdose(tmpdose, formula=dose~time|treatment+ID) + myconc <- PKNCAconc(tmpconc, formula = conc ~ time | treatment + ID) + mydose <- PKNCAdose(tmpdose, formula = dose ~ time | treatment + ID) mydata <- PKNCAdata(myconc, mydose) myresult <- pk.nca(mydata) expect_equal( - getGroups(myresult, level="treatment"), - myresult$result[, "treatment", drop=FALSE] + getGroups(myresult, level = "treatment"), + myresult$result[, "treatment", drop = FALSE] ) expect_equal( - getGroups(myresult, level=factor("treatment")), - myresult$result[, "treatment", drop=FALSE] + getGroups(myresult, level = factor("treatment")), + myresult$result[, "treatment", drop = FALSE] ) expect_error( - getGroups(myresult, level="foo"), - regexp="Not all levels are listed in the group names. Missing levels are: foo" + getGroups(myresult, level = "foo"), + regexp = "Not all levels are listed in the group names. Missing levels are: foo" ) expect_equal( - getGroups(myresult, level=2), + getGroups(myresult, level = 2), myresult$result[, c("treatment", "ID")] ) expect_equal( - getGroups(myresult, level=2:3), + getGroups(myresult, level = 2:3), myresult$result[, c("ID", "start")] ) expect_equal( - getGroups(myresult, level=3:4), + getGroups(myresult, level = 3:4), myresult$result[, c("start", "end")] ) }) test_that("group_vars.PKNCAresult", { - o_conc_group <- PKNCAconc(as.data.frame(datasets::Theoph), conc~Time|Subject) + o_conc_group <- PKNCAconc(as.data.frame(datasets::Theoph), conc ~ Time | Subject) o_data_group <- PKNCAdata(o_conc_group, intervals = data.frame(start = 0, end = 1, cmax = TRUE)) suppressMessages(o_nca_group <- pk.nca(o_data_group)) expect_equal(dplyr::group_vars(o_nca_group), "Subject") # Check that it works without groupings as expected [empty] - o_conc_nongroup <- PKNCAconc(as.data.frame(datasets::Theoph)[datasets::Theoph$Subject == 1,], conc~Time) + o_conc_nongroup <- PKNCAconc(as.data.frame(datasets::Theoph)[datasets::Theoph$Subject == 1, ], conc ~ Time) o_data_nogroup <- PKNCAdata(o_conc_nongroup, intervals = data.frame(start = 0, end = 1, cmax = TRUE)) suppressMessages(o_nca_nogroup <- pk.nca(o_data_nogroup)) @@ -424,8 +445,8 @@ test_that("group_vars.PKNCAresult", { test_that("as.data.frame.PKNCAresults can filter for only requested parameters", { tmpconc <- generate.conc(2, 1, 0:24) tmpdose <- generate.dose(tmpconc) - myconc <- PKNCAconc(tmpconc, formula=conc~time|treatment+ID) - mydose <- PKNCAdose(tmpdose, formula=dose~time|treatment+ID) + myconc <- PKNCAconc(tmpconc, formula = conc ~ time | treatment + ID) + mydose <- PKNCAdose(tmpdose, formula = dose ~ time | treatment + ID) mydata <- PKNCAdata(myconc, mydose, intervals = data.frame(start = 0, end = Inf, half.life = TRUE)) myresult <- pk.nca(mydata) @@ -436,8 +457,8 @@ test_that("as.data.frame.PKNCAresults can filter for only requested parameters", test_that("as.data.frame.PKNCAresults can filter to remove excluded parameters", { tmpconc <- generate.conc(2, 1, c(0, 2, 6, 12, 24)) tmpdose <- generate.dose(tmpconc) - myconc <- PKNCAconc(tmpconc, formula=conc~time|treatment+ID) - mydose <- PKNCAdose(tmpdose, formula=dose~time|treatment+ID) + myconc <- PKNCAconc(tmpconc, formula = conc ~ time | treatment + ID) + mydose <- PKNCAdose(tmpdose, formula = dose ~ time | treatment + ID) mydata <- PKNCAdata(myconc, mydose, intervals = data.frame(start = 0, end = Inf, half.life = TRUE)) myresult <- exclude(pk.nca(mydata), FUN = exclude_nca_span.ratio(1)) diff --git a/tests/testthat/test-pk.calc.all.R b/tests/testthat/test-pk.calc.all.R index 7f9b22b1..cc925a0b 100644 --- a/tests/testthat/test-pk.calc.all.R +++ b/tests/testthat/test-pk.calc.all.R @@ -63,6 +63,16 @@ test_that("pk.nca", { 24.00, 0.3148, 0.05689, 0.9000, 0.8944, -0.952, 5.000, 24.00, 20.00, 0.3011, 12.18, 1.560, 19.56), + PPANMETH = c( + "AUC: lin up/log down", + rep("", 4), + rep("Lambda Z: Default", 10), + "Lambda Z: Default. AUC: lin up/log down", + "AUC: lin up/log down", + rep("", 4), + rep("Lambda Z: Default", 10), + "Lambda Z: Default. AUC: lin up/log down" + ), exclude=NA_character_ ) expect_equal( @@ -244,6 +254,12 @@ test_that("Calculations when no dose info is given", { PPTESTCD=rep(c("auclast", "cmax", "cl.last"), 2), PPORRES=c(13.5417297156528, 0.999812606062292, NA, 14.0305397438242, 0.94097296083447, NA), + PPANMETH = c( + "AUC: lin up/log down", + rep("", 2), + "AUC: lin up/log down", + rep("", 2) + ), exclude=NA_character_ ) ) diff --git a/tests/testthat/test-pk.calc.simple.R b/tests/testthat/test-pk.calc.simple.R index 78eadd79..c2784f84 100644 --- a/tests/testthat/test-pk.calc.simple.R +++ b/tests/testthat/test-pk.calc.simple.R @@ -453,6 +453,7 @@ test_that("pk.calc.aucabove", { pk.calc.aucabove(conc = d_conc$conc, time = d_conc$time, conc_above = 2), pk.calc.aucabove(conc = d_conc$conc, time = d_conc$time, conc_above = 3) ), + PPANMETH = c("", "", "AUC: lin up/log down", "AUC: lin up/log down"), exclude = NA_character_ ) ) From e7a114590d35702f42b54a1e9d56afcccddf6994 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 13 Sep 2025 12:18:38 +0200 Subject: [PATCH 11/20] docs: rm add_ppanmeth arg --- R/pk.calc.all.R | 2 -- man/pk.nca.Rd | 3 --- 2 files changed, 5 deletions(-) diff --git a/R/pk.calc.all.R b/R/pk.calc.all.R index 6b3d4f45..b4e91c72 100644 --- a/R/pk.calc.all.R +++ b/R/pk.calc.all.R @@ -12,8 +12,6 @@ #' ##' @param data A PKNCAdata object ##' @param verbose Indicate, by `message()`, the current state of calculation. -##' @param include_ppanmeth Logical; if TRUE, output includes the PPANMETH column -##' with the analysis method specifications for the parameter. Default is FALSE. ##' @returns A `PKNCAresults` object. ##' @seealso [PKNCAdata()], [PKNCA.options()], [summary.PKNCAresults()], ##' [as.data.frame.PKNCAresults()], [exclude()] diff --git a/man/pk.nca.Rd b/man/pk.nca.Rd index 6bc64c7d..e81ef002 100644 --- a/man/pk.nca.Rd +++ b/man/pk.nca.Rd @@ -10,9 +10,6 @@ pk.nca(data, verbose = FALSE) \item{data}{A PKNCAdata object} \item{verbose}{Indicate, by \code{message()}, the current state of calculation.} - -\item{include_ppanmeth}{Logical; if TRUE, output includes the PPANMETH column -with the analysis method specifications for the parameter. Default is FALSE.} } \value{ A \code{PKNCAresults} object. From 9bf05d0d254c8ebd8b4a130b87d07be769ab9c9f Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 19 Oct 2025 08:45:12 +0200 Subject: [PATCH 12/20] fix: typpo in NEWS.md --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 0eb903dc..317d3ed5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -26,7 +26,7 @@ the dosing including dose amount and route. amount/dose units rather than "fraction" (#426) * `get_halflife_points` will ignore points after `lambda.z.time.last`, instead of `tlast` (#448) -* `lambda.z` calculations will now only consxider time points that occur after +* `lambda.z` calculations will now only consider time points that occur after the end of the latest dose administration (#139) * `aucint.inf.pred` is `NA` when half-life is not estimable (#450) From 3be8500080fe95ce5c8bc58ad4b4ebcc704eb9d5 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Mon, 24 Nov 2025 05:04:11 +0100 Subject: [PATCH 13/20] rm method definition for half.life & AUC from pk.calc.all.R --- R/pk.calc.all.R | 39 +++++++++++---------------------------- 1 file changed, 11 insertions(+), 28 deletions(-) diff --git a/R/pk.calc.all.R b/R/pk.calc.all.R index 5f080431..0eb96bf8 100644 --- a/R/pk.calc.all.R +++ b/R/pk.calc.all.R @@ -10,12 +10,12 @@ #' the interval. For example, if an interval starts at 168 hours, ends at 192 #' hours, and and the maximum concentration is at 169 hours, `tmax=169-168=1`. #' -##' @param data A PKNCAdata object -##' @param verbose Indicate, by `message()`, the current state of calculation. -##' @returns A `PKNCAresults` object. -##' @seealso [PKNCAdata()], [PKNCA.options()], [summary.PKNCAresults()], -##' [as.data.frame.PKNCAresults()], [exclude()] -##' @export +#' @param data A PKNCAdata object +#' @param verbose Indicate, by `message()`, the current state of calculation. +#' @returns A `PKNCAresults` object. +#' @seealso [PKNCAdata()], [PKNCA.options()], [summary.PKNCAresults()], +#' [as.data.frame.PKNCAresults()], [exclude()] +#' @export pk.nca <- function(data, verbose=FALSE) { assert_PKNCAdata(data) results <- data.frame() @@ -390,7 +390,7 @@ pk.nca.interval <- function(conc, time, volume, duration.conc, paste0("Imputation: ", paste(na.omit(impute_method), collapse = ", ")) ) } else { - tmp_imp_method <- c() + tmp_imp_method <- character() } # Prepare the return value using SDTM names ret <- data.frame(PPTESTCD=NA, PPORRES=NA)[-1,] @@ -412,7 +412,6 @@ pk.nca.interval <- function(conc, time, volume, duration.conc, } # Do the calculations for (n in names(all_intervals)) { - tmp_method <- c(tmp_imp_method) request_to_calculate <- as.logical(interval[[n]]) has_calculation_function <- !is.na(all_intervals[[n]]$FUN) is_correct_sparse_dense <- all_intervals[[n]]$sparse == sparse @@ -515,26 +514,7 @@ pk.nca.interval <- function(conc, time, volume, duration.conc, call_args$time <- call_args$time[!exclude_tf] } } - # For half-life related parameters, indicate if there was any manual inclusion / exclusion - if (n %in% get.parameter.deps("half.life")) { - any_inclusion <- !is.null(include_half.life) && !all(is.na(include_half.life)) - any_exclusion <- !is.null(exclude_half.life) && !all(is.na(exclude_half.life)) - tmp_method <- c( - tmp_method, - paste0( - "Lambda Z: ", - {if (any_inclusion) "Manual selection" else if (any_exclusion) "Manual exclusion" else "Default"} - ) - ) - } - # For AUC parameters, indicate the calculation method - auc_parameters <- grep("auc", names(get.interval.cols()), value = TRUE) - if (n %in% auc_parameters) { - tmp_method <- c( - tmp_method, - paste0("AUC: ", options$auc.method) - ) - } + # Do the calculation tmp_result <- do.call(all_intervals[[n]]$FUN, call_args) # The handling of the exclude column is documented in the @@ -552,6 +532,9 @@ pk.nca.interval <- function(conc, time, volume, duration.conc, } else { NA_character_ } + # The handling of the method column (PPANMETH) + tmp_method <- c(tmp_imp_method, attr(tmp_result, "method")) + # If the function returns a data frame, save all the returned values, # otherwise, save the value returned. if (is.data.frame(tmp_result)) { From 6a0e7d3847a56b791da2906a1ca64d32dd83fcbb Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Mon, 24 Nov 2025 05:04:50 +0100 Subject: [PATCH 14/20] add method as attr in auc.R, aucint.R and half.life.R --- R/auc.R | 10 ++++++++++ R/aucint.R | 10 ++++++++++ R/half.life.R | 14 +++++++++++++- 3 files changed, 33 insertions(+), 1 deletion(-) diff --git a/R/auc.R b/R/auc.R index 5f6718b9..5795e02a 100644 --- a/R/auc.R +++ b/R/auc.R @@ -184,6 +184,16 @@ pk.calc.auxc <- function(conc, time, interval=c(0, Inf), fun_linear = fun_linear, fun_log = fun_log, fun_inf = fun_inf ) } + # Add method details as an attribute + method_vec <- character() + auc_method <- if (is.null(method)) { + PKNCA.options()$auc.method + } else { + method + } + method_vec <- c(method_vec, paste0("AUC: ", auc_method)) + attr(ret, "method") <- method_vec + ret } diff --git a/R/aucint.R b/R/aucint.R index b8aebf86..8fa4be09 100644 --- a/R/aucint.R +++ b/R/aucint.R @@ -184,6 +184,16 @@ pk.calc.aucint <- function(conc, time, fun_log = aucintegrate_log, fun_inf = aucintegrate_inf ) + # Add method details as an attribute + method_vec <- character() + auc_method <- if (is.null(method)) { + PKNCA.options()$auc.method + } else { + method + } + method_vec <- c(method_vec, paste0("AUC: ", auc_method)) + attr(ret, "method") <- method_vec + ret } diff --git a/R/half.life.R b/R/half.life.R index a1fc0629..0bb9d169 100644 --- a/R/half.life.R +++ b/R/half.life.R @@ -87,7 +87,10 @@ pk.calc.half.life <- function(conc, time, tmax, tlast, conc.na=NULL, first.tmax=NULL, allow.tmax.in.half.life=NULL, - check=TRUE) { + check=TRUE, + impute_method=NA_character_, + include_half.life=NULL, + exclude_half.life=NULL) { # Check inputs min.hl.points <- PKNCA.choose.option( @@ -134,6 +137,13 @@ pk.calc.half.life <- function(conc, time, tmax, tlast, data <- data[as.numeric(data$time) > max(end.dose, na.rm = TRUE), ] } } + # Build method attribute + method_vec <- character() + # Imputation method + if (!all(is.na(impute_method))) { + method_vec <- c(method_vec, paste0("Imputation: ", paste(na.omit(impute_method), collapse = ", "))) + } + # Prepare the return values ret <- data.frame( # Terminal elimination slope @@ -181,6 +191,7 @@ pk.calc.half.life <- function(conc, time, tmax, tlast, dfK <- data[as.numeric(data$time) > as.numeric(ret$tmax), ] } if (manually.selected.points) { + method_vec <- c(method_vec, "Lambda Z: Manual selection") if (nrow(data) > 0) { fit <- fit_half_life(data=data, tlast=ret$tlast, conc_units=conc_units) ret[,ret_replacements] <- fit[,ret_replacements] @@ -271,6 +282,7 @@ pk.calc.half.life <- function(conc, time, tmax, tlast, ret$tmax <- NULL if (!missing(tlast)) ret$tlast <- NULL + attr(ret, "method") <- method_vec ret } From eae9721936bd69f77a58599f12f82e985d678efc Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Mon, 24 Nov 2025 05:05:32 +0100 Subject: [PATCH 15/20] modify tests: expect_equal calls to ignore attributes & add attr method tests --- tests/testthat/test-auc.R | 97 ++++++++++++++++++------ tests/testthat/test-aucint.R | 50 +++++++++++- tests/testthat/test-auciv.R | 33 +++++++- tests/testthat/test-class-PKNCAresults.R | 10 +-- tests/testthat/test-half.life.R | 7 +- tests/testthat/test-pk.calc.all.R | 14 ++-- 6 files changed, 171 insertions(+), 40 deletions(-) diff --git a/tests/testthat/test-auc.R b/tests/testthat/test-auc.R index 328f9ddc..39837e9a 100644 --- a/tests/testthat/test-auc.R +++ b/tests/testthat/test-auc.R @@ -71,7 +71,7 @@ test_that("pk.calc.auc: Linear AUC when the conc at the end of the interval is a lambda.z=NA, auc.type=t, method="linear")) - expect_equal(v1, tests[[t]], info=t) + expect_equal(v1, tests[[t]], info=t, ignore_attr = TRUE) } }) @@ -95,7 +95,7 @@ test_that("pk.calc.auc: Linear AUC when the conc at the end of the interval is B lambda.z=NA, auc.type=t, method="linear")) - expect_equal(v1, tests[[t]], info=t) + expect_equal(v1, tests[[t]], info=t, ignore_attr = TRUE) } }) @@ -118,7 +118,7 @@ test_that("pk.calc.auc: Linear AUC when the conc at the end of the interval is B lambda.z=1, auc.type=t, method="linear")) - expect_equal(v1, tests[[t]], info=t) + expect_equal(v1, tests[[t]], info=t, ignore_attr = TRUE) } }) @@ -140,7 +140,7 @@ test_that("pk.calc.auc: Linear AUC when when there are multiple BLQ values at th lambda.z=1, auc.type=t, method="linear")) - expect_equal(v1, tests[[t]], info=t) + expect_equal(v1, tests[[t]], info=t, ignore_attr = TRUE) } }) @@ -171,7 +171,7 @@ test_that("pk.calc.auc: Confirm that center BLQ points are dropped, kept, or imp auc.type=n, conc.blq="keep", method=t)) - expect_equal(v1, tests[[t]][[n]], info=paste(t, n)) + expect_equal(v1, tests[[t]][[n]], info=paste(t, n), ignore_attr = TRUE) } } }) @@ -203,7 +203,7 @@ test_that("pk.calc.auc: Confirm BLQ in the middle or end are calculated correctl auc.type=n, conc.blq="keep", method=t)) - expect_equal(v1, tests[[t]][[n]], info=paste(t, n)) + expect_equal(v1, tests[[t]][[n]], info=paste(t, n), ignore_attr = TRUE) } } @@ -238,9 +238,12 @@ test_that("pk.calc.auc: Confirm BLQ in the middle or end are calculated correctl middle="drop", last="keep"), method=t)) - expect_equal(v1, - tests[[t]][[n]], - info=paste(t, n)) + expect_equal( + v1, + tests[[t]][[n]], + info=paste(t, n), + ignore_attr = TRUE + ) } } }) @@ -274,9 +277,12 @@ test_that("pk.calc.auc: When AUCinf is requested with NA for lambda.z, the resul middle="drop", last="keep"), method=t)) - expect_equal(v1, - tests[[t]][[n]], - info=paste(t, n)) + expect_equal( + v1, + tests[[t]][[n]], + info=paste(t, n), + ignore_attr = TRUE + ) } } }) @@ -314,9 +320,12 @@ test_that("pk.calc.auc: Test NA at the end", { middle="drop", last="keep"), method=t)) - expect_equal(v1, - tests[[t]][[n]], - info=paste(t, n)) + expect_equal( + v1, + tests[[t]][[n]], + info=paste(t, n), + ignore_attr = TRUE + ) } }) @@ -349,9 +358,12 @@ test_that("pk.calc.auc: interpolation of times within the time interval", { middle="drop", last="keep"), method=t)) - expect_equal(v1, - tests[[t]][[n]], - info=paste(t, n)) + expect_equal( + v1, + tests[[t]][[n]], + info=paste(t, n), + ignore_attr = TRUE + ) } } }) @@ -397,7 +409,8 @@ test_that("pk.calc.auc: warning with beginning of interval before the beginning expect_equal( v1, tests[[t]][[n]], - info=paste(t, n) + info=paste(t, n), + ignore_attr = TRUE ) } } @@ -449,7 +462,8 @@ test_that("pk.calc.auc: warning with beginning of interval before the beginning ) expect_equal(v1, tests[[t]][[n]], - info=paste(t, n)) + info=paste(t, n), + ignore_attr = TRUE) } # Confirm error with concentration and time not of equal lengths @@ -563,14 +577,18 @@ test_that("pk.calc.aumc", { time=0:3, interval=c(0, 3), method="linear"), - 3.75) + 3.75, + ignore_attr = TRUE + ) expect_equal( pk.calc.aumc( conc=c(0, 1, 1, 0.5), time=0:3, interval=c(0, 3), method="lin up/log down"), - 2-0.5/log(0.5)+0.5/(log(0.5)^2)) + 2-0.5/log(0.5)+0.5/(log(0.5)^2), + ignore_attr = TRUE + ) expect_equal( pk.calc.aumc( conc=c(0, 1, 1, 0.5), @@ -579,7 +597,9 @@ test_that("pk.calc.aumc", { auc.type="AUCinf", lambda.z=1, method="lin up/log down"), - 2 - 0.5/log(0.5) + 0.5/(log(0.5)^2) + 1.5 + 0.5) + 2 - 0.5/log(0.5) + 0.5/(log(0.5)^2) + 1.5 + 0.5, + ignore_attr = TRUE + ) }) @@ -728,3 +748,34 @@ test_that("AUC with a single concentration measured should return NA (fix #176)" ) ) }) + +test_that("pk.calc.auc and wrappers: method attribute is set and propagated", { + + auc_params <- c( + "auc", "auc.last", "auc.inf.obs", "auc.inf.pred", "auc.all", + "aumc.last", "aumc.inf.obs", "aumc.inf.pred", "aumc.all" + ) + auc_methods <- c("linear", "lin up/log down", "lin-log") + auc_args <- list( + conc=c(0,1,1), + time=0:2, + interval=c(0,2), + lambda.z=1, + clast.pred = 1, + clast.obs = 1 + ) + + for (param in auc_params) { + auc_fun <- get(paste0("pk.calc.", param)) + args_fun <- auc_args[intersect(names(auc_args), names(formals(auc_fun)))] + for (method in auc_methods) { + args_fun$method <- method + v <- do.call(auc_fun, args_fun) + expect_equal( + attr(v, "method"), + paste0("AUC: ", method), + info=paste("pk.calc.param sets method attribute for", param, "with method", method) + ) + } + } +}) diff --git a/tests/testthat/test-aucint.R b/tests/testthat/test-aucint.R index 5b3d204f..cff7727b 100644 --- a/tests/testthat/test-aucint.R +++ b/tests/testthat/test-aucint.R @@ -84,6 +84,7 @@ test_that("AUCint gives the same value when no interpolation/extrapolation is re conc = concdata$conc, time = concdata$time, interval = c(0, 3) ), + ignore_attr = TRUE, info = "No interpolation/extrapolation is equivalent to normal AUC" ) expect_equal( @@ -95,6 +96,7 @@ test_that("AUCint gives the same value when no interpolation/extrapolation is re conc = concdata$conc, time = concdata$time, interval = c(0, 3) ), + ignore_attr = TRUE, info = "Giving interval and start+end are the same, no interp/extrap (test 1)" ) expect_equal( @@ -106,6 +108,7 @@ test_that("AUCint gives the same value when no interpolation/extrapolation is re conc = concdata$conc, time = concdata$time, interval = c(0, 2) ), + ignore_attr = TRUE, info = "Giving interval and start+end are the same, no interp/extrap (test 2)" ) }) @@ -177,6 +180,7 @@ test_that("AUCint respects auc.type and does the correct calculations for each A conc = c(concdata$conc, 0.5), time = c(concdata$time, 4), interval = c(0, 4) ), + ignore_attr = TRUE, info = "AUCinf is traced" ) expect_equal( @@ -192,6 +196,7 @@ test_that("AUCint respects auc.type and does the correct calculations for each A conc = c(2, 1), time = c(3, 4), interval = c(3, 4) ), + ignore_attr = TRUE, info = "AUCinf is traced with clast respected" ) expect_equal( @@ -203,6 +208,7 @@ test_that("AUCint respects auc.type and does the correct calculations for each A conc = c(concdata$conc, 0.25), time = c(concdata$time, 4), interval = c(0, 4) ), + ignore_attr = TRUE, info = "AUCinf is traced with lambda.z respected" ) expect_equal( @@ -218,6 +224,7 @@ test_that("AUCint respects auc.type and does the correct calculations for each A conc = c(2, 0.5), time = c(3, 4), interval = c(3, 4) ), + ignore_attr = TRUE, info = "AUCinf is traced with clast and lambda.z respected" ) @@ -230,6 +237,7 @@ test_that("AUCint respects auc.type and does the correct calculations for each A conc = concdata$conc, time = concdata$time, interval = c(0, 3), auc.type = "AUCall" ), + ignore_attr = TRUE, info = "AUCall is the same as AUClast when no BLQ follow tlast (both AUCall)" ) expect_equal( @@ -241,6 +249,7 @@ test_that("AUCint respects auc.type and does the correct calculations for each A conc = concdata$conc, time = concdata$time, interval = c(0, 3), auc.type = "AUClast" ), + ignore_attr = TRUE, info = "AUCall is the same as AUClast when no BLQ follow tlast (test AUClast)" ) expect_equal( @@ -252,6 +261,7 @@ test_that("AUCint respects auc.type and does the correct calculations for each A conc = concdata_blq$conc, time = concdata_blq$time, interval = c(0, 4), auc.type = "AUCall" ), + ignore_attr = TRUE, info = "AUCall is the same the normal calculation when no interpolation/extrapolation happens" ) expect_equal( @@ -263,6 +273,7 @@ test_that("AUCint respects auc.type and does the correct calculations for each A conc = c(concdata$conc, 0.5), time = c(concdata$time, 3.5), interval = c(0, 4), auc.type = "AUClast" ), + ignore_attr = TRUE, info = "AUCall traces correctly" ) }) @@ -321,10 +332,12 @@ test_that("aucint works with infinite intervals", { concdata <- data.frame(conc = c(8, 4, 2, 1), time = 0:3) expect_equal(pk.calc.aucint.last(conc = concdata$conc, time = concdata$time, start = 0, end = Inf), pk.calc.auc.last(conc = concdata$conc, time = concdata$time), + ignore_attr = TRUE, info = "Simple AUClast = aucint.last" ) expect_equal(pk.calc.aucint.all(conc = concdata$conc, time = concdata$time, start = 0, end = Inf), pk.calc.auc.all(conc = concdata$conc, time = concdata$time), + ignore_attr = TRUE, info = "Simple AUCall = aucint.all" ) expect_equal( @@ -337,6 +350,7 @@ test_that("aucint works with infinite intervals", { conc = concdata$conc, time = concdata$time, clast.obs = 1, lambda.z = log(2) ), + ignore_attr = TRUE, info = "Simple AUCinf.obs = aucint.inf.obs" ) expect_equal( @@ -349,6 +363,7 @@ test_that("aucint works with infinite intervals", { conc = concdata$conc, time = concdata$time, clast.pred = 2, lambda.z = log(2) ), + ignore_attr = TRUE, info = "Simple AUCinf.pred = aucint.inf.pred" ) }) @@ -429,11 +444,13 @@ test_that("aucint uses log extrapolation regardless of the interpolation method # the second is more directly mathematical. expect_equal( aucinf_obs6_lin - aucinf_obs5_lin, - aucinf_obs6_log - aucinf_obs5_log + aucinf_obs6_log - aucinf_obs5_log, + ignore_attr = TRUE ) expect_equal( aucinf_obs6_lin, - aucinf_obs5_lin + (6-5)*(clast-ctau_extrap)/log(clast/ctau_extrap) + aucinf_obs5_lin + (6-5)*(clast-ctau_extrap)/log(clast/ctau_extrap), + ignore_attr = TRUE ) }) @@ -454,3 +471,32 @@ test_that("aucint.inf.pred returns NA when half-life is not estimable (#450)", { aucint_inf_pred <- aucint_inf_pred_prep$PPORRES[aucint_inf_pred_prep$PPTESTCD %in% "aucint.inf.pred"] expect_equal(aucint_inf_pred, NA_real_) }) + +test_that("pk.calc.aucint and wrappers: method attribute is set and propagated", { + aucint_params <- c("aucint", "aucint.last", "aucint.inf.obs", "aucint.inf.pred", "aucint.all") + auc_methods <- c("linear", "lin up/log down", "lin-log") + auc_args <- list( + conc = c(0,1,1), + time = 0:2, + interval = c(0,2), + lambda.z = 1, + clast.pred = 1, + clast.obs = 1, + start = 0, + end = 2 + ) + + for (param in aucint_params) { + auc_fun <- get(paste0("pk.calc.", param)) + args_fun <- auc_args[intersect(names(auc_args), names(formals(auc_fun)))] + for (method in auc_methods) { + args_fun$method <- method + v <- do.call(auc_fun, args_fun) + expect_equal( + attr(v, "method"), + paste0("AUC: ", method), + info = paste("pk.calc.param sets method attribute for", param, "with method", method) + ) + } + } +}) diff --git a/tests/testthat/test-auciv.R b/tests/testthat/test-auciv.R index a6fbe4fb..9fd865de 100644 --- a/tests/testthat/test-auciv.R +++ b/tests/testthat/test-auciv.R @@ -6,12 +6,14 @@ test_that("pk.calc.auciv", { expect_equal( # No check is done to confirm that the auc argument matches the data pk.calc.auciv(conc = 0:5, time = 0:5, c0 = 1, auc = 2.75), - 2.75 + 1 - 0.5 + 2.75 + 1 - 0.5, + ignore_attr = TRUE ) expect_equal( # No verifications are made on the data pk.calc.auciv(conc = 0:5, time = 0:5, c0 = 1, auc = 2.75, check=FALSE), - 2.75 + 1 - 0.5 + 2.75 + 1 - 0.5, + ignore_attr = TRUE ) }) @@ -52,3 +54,30 @@ test_that("missing dose information does not cause NA time (#353)", { ) expect_s3_class(o_nca, "PKNCAresults") }) + + +test_that("pk.calc.auciv: method attribute is set and propagated", { + + auc_params <- c("auciv") + auc_methods <- c("linear", "lin up/log down", "lin-log") + auc_args <- list( + conc=3:1, + time=0:2, + c0 = 1, + auc = 2 + ) + + for (param in auc_params) { + auc_fun <- get(paste0("pk.calc.", param)) + args_fun <- auc_args[intersect(names(auc_args), names(formals(auc_fun)))] + for (method in auc_methods) { + args_fun$method <- method + v <- do.call(auc_fun, args_fun) + expect_equal( + attr(v, "method"), + paste0("AUC: ", method), + info=paste("pk.calc.param sets method attribute for", param, "with method", method) + ) + } + } +}) diff --git a/tests/testthat/test-class-PKNCAresults.R b/tests/testthat/test-class-PKNCAresults.R index c21f895b..d2788e35 100644 --- a/tests/testthat/test-class-PKNCAresults.R +++ b/tests/testthat/test-class-PKNCAresults.R @@ -67,12 +67,12 @@ test_that("PKNCAresults generation", { PPANMETH = c( "AUC: lin up/log down", rep("", 4), - rep("Lambda Z: Default", 10), - "Lambda Z: Default. AUC: lin up/log down", + rep("", 10), + "AUC: lin up/log down", "AUC: lin up/log down", rep("", 4), - rep("Lambda Z: Default", 10), - "Lambda Z: Default. AUC: lin up/log down" + rep("", 10), + "AUC: lin up/log down" ), exclude = NA_character_ ) @@ -98,7 +98,7 @@ test_that("PKNCAresults generation", { ) expect_equal( as.data.frame(o_result, out_format="wide"), - tidyr::spread(verify.result, key="PPTESTCD", value="PPORRES"), + tidyr::spread(verify.result[names(verify.result) != "PPANMETH"], key="PPTESTCD", value="PPORRES"), tolerance=0.001, info="Conversion of PKNCAresults to a data.frame in wide format (specifying wide format)" ) diff --git a/tests/testthat/test-half.life.R b/tests/testthat/test-half.life.R index c2dcea38..f488f36f 100644 --- a/tests/testthat/test-half.life.R +++ b/tests/testthat/test-half.life.R @@ -78,6 +78,7 @@ test_that("pk.calc.half.life", { clast.pred=0.12507, half.life=1.000346, span.ratio=2.998962), + ignore_attr=TRUE, tolerance=0.0001) # It only gives tlast or tmax if you don't give them as inputs. expect_equal(pk.calc.half.life(conc=c(1, 0.5, 0.25, 0.1251), @@ -98,6 +99,7 @@ test_that("pk.calc.half.life", { half.life=1.000346, span.ratio=2.998962, tmax=0), + ignore_attr=TRUE, tolerance=0.0001) expect_equal(pk.calc.half.life(conc=c(1, 0.5, 0.25, 0.1251), time=c(0, 1, 2, 3), @@ -117,6 +119,7 @@ test_that("pk.calc.half.life", { half.life=1.000346, span.ratio=2.998962, tlast=3), + ignore_attr=TRUE, tolerance=0.0001) }) @@ -194,6 +197,7 @@ test_that("half-life manual point selection", { tlast = 3L ) attr(excluded_result, "exclude") <- "Negative half-life estimated with manually-selected points" + attr(excluded_result, "method") <- "Lambda Z: Manual selection" expect_equal( pk.calc.half.life(conc = 2^(1:3), time = 1:3, manually.selected.points = TRUE), excluded_result @@ -223,7 +227,8 @@ test_that("two-point half-life succeeds (fix #114)", { span.ratio=1, tmax=0, tlast=1 - ) + ), + ignore_attr=TRUE ), class = "pknca_halflife_2points"), class = "pknca_adjr2_2points" diff --git a/tests/testthat/test-pk.calc.all.R b/tests/testthat/test-pk.calc.all.R index 76776123..fecfb9c1 100644 --- a/tests/testthat/test-pk.calc.all.R +++ b/tests/testthat/test-pk.calc.all.R @@ -66,12 +66,12 @@ test_that("pk.nca", { PPANMETH = c( "AUC: lin up/log down", rep("", 4), - rep("Lambda Z: Default", 10), - "Lambda Z: Default. AUC: lin up/log down", + rep("", 10), + "AUC: lin up/log down", "AUC: lin up/log down", rep("", 4), - rep("Lambda Z: Default", 10), - "Lambda Z: Default. AUC: lin up/log down" + rep("", 10), + "AUC: lin up/log down" ), exclude=NA_character_ ) @@ -807,7 +807,7 @@ test_that("pk.nca produces the PPANMETH column", { expect_true("PPANMETH" %in% names(res_excl$result)) expect_equal( unique(res_base$result$PPANMETH[res_base$result$PPTESTCD %in% c("lambda.z", "half.life", "r.squared")]), - "Lambda Z: Default" + "" ) expect_equal( unique(res_incl$result$PPANMETH[res_incl$result$PPTESTCD %in% c("lambda.z", "half.life", "r.squared")]), @@ -815,7 +815,7 @@ test_that("pk.nca produces the PPANMETH column", { ) expect_equal( unique(res_excl$result$PPANMETH[res_excl$result$PPTESTCD %in% c("lambda.z", "half.life", "r.squared")]), - "Lambda Z: Manual exclusion" + "" ) expect_equal( unique(res_base$result$PPANMETH[res_base$result$PPTESTCD %in% c("tmax", "cmax")]), @@ -857,7 +857,7 @@ test_that("pk.nca produces the PPANMETH column", { ) expect_equal( res$result$PPANMETH[res$result$PPTESTCD == "aucinf.pred"], - "Imputation: start_conc0. Lambda Z: Manual selection. AUC: lin up/log down" + "Imputation: start_conc0. AUC: lin up/log down" ) }) test_that("Cannot include and exclude half-life points at the same time (#406)", { From d3095e2ceab53a92041e44d4cf820fad214f664d Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Mon, 24 Nov 2025 05:54:29 +0100 Subject: [PATCH 16/20] fix: remove attr method from pk.nca result (PPANMETH already has this info) --- R/pk.calc.all.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/pk.calc.all.R b/R/pk.calc.all.R index 0eb96bf8..08c660ca 100644 --- a/R/pk.calc.all.R +++ b/R/pk.calc.all.R @@ -534,6 +534,7 @@ pk.nca.interval <- function(conc, time, volume, duration.conc, } # The handling of the method column (PPANMETH) tmp_method <- c(tmp_imp_method, attr(tmp_result, "method")) + attr(tmp_result, "method") <- NULL # If the function returns a data frame, save all the returned values, # otherwise, save the value returned. From 4dd25c3046c7cda949e5a93a85875c86125a32fd Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Mon, 24 Nov 2025 05:55:11 +0100 Subject: [PATCH 17/20] add method attr to auc sparse calculations --- R/sparse.R | 8 ++++++++ tests/testthat/test-sparse.R | 21 +++++++++++++++++++-- 2 files changed, 27 insertions(+), 2 deletions(-) diff --git a/R/sparse.R b/R/sparse.R index 7a59f2cc..9a78f99c 100644 --- a/R/sparse.R +++ b/R/sparse.R @@ -316,6 +316,14 @@ pk.calc.sparse_auc <- function(conc, time, subject, auc.type=auc.type, method="linear" ) + + # Add method details as an attribute + method_vec <- character() + auc_method <- "linear" + method_vec <- c(method_vec, paste0("AUC: ", auc_method)) + method_vec <- c(method_vec, paste0("Sparse: ", "arithmetic mean, <=50% BLQ")) + attr(auc, "method") <- method_vec + var_auc <- var_sparse_auc(sparse_pk_mean) data.frame( sparse_auc=auc, diff --git a/tests/testthat/test-sparse.R b/tests/testthat/test-sparse.R index 31f49b18..99c20a40 100644 --- a/tests/testthat/test-sparse.R +++ b/tests/testthat/test-sparse.R @@ -20,12 +20,12 @@ test_that("sparse_auc", { sparse_batch <- pk.calc.sparse_auc(conc=d_sparse$conc, time=d_sparse$time, subject=d_sparse$id), regexp="Cannot yet calculate sparse degrees of freedom for multiple samples per subject" ) - expect_equal(sparse_batch$sparse_auc, auclast) + expect_equal(sparse_batch$sparse_auc, auclast, ignore_attr = TRUE) expect_equal(sparse_batch$sparse_auc_se, auclast_se_batch) expect_equal(sparse_batch$sparse_auc_df, NA_real_) sparse_serial <- pk.calc.sparse_auc(conc=d_sparse$conc, time=d_sparse$time, subject=seq_len(nrow(d_sparse))) - expect_equal(sparse_serial$sparse_auc, auclast) + expect_equal(sparse_serial$sparse_auc, auclast, ignore_attr = TRUE) expect_equal(as.numeric(sparse_serial$sparse_auc_se), auclast_se_serial) expect_equal(sparse_serial$sparse_auc_df, auclast_df_serial) }) @@ -61,3 +61,20 @@ test_that("sparse_mean", { "arithmetic mean" ) }) + +test_that("sparse_auc and sparse_auclast method attribute", { + d_sparse <- + data.frame( + id = c(1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 4L, 5L, 6L, 4L, 5L, 6L, 7L, 8L, 9L, 7L, 8L, 9L), + conc = c(0, 0, 0, 1.75, 2.2, 1.58, 4.63, 2.99, 1.52, 3.03, 1.98, 2.22, 3.34, 1.3, 1.22, 3.54, 2.84, 2.55, 0.3, 0.0421, 0.231), + time = c(0, 0, 0, 1, 1, 1, 6, 6, 6, 2, 2, 2, 10, 10, 10, 4, 4, 4, 24, 24, 24), + dose = c(100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, 100) + ) + auc <- pk.calc.sparse_auc(conc=d_sparse$conc, time=d_sparse$time, subject=seq_len(nrow(d_sparse))) + expect_equal(attr(auc$sparse_auc, "method"), + c("AUC: linear", "Sparse: arithmetic mean, <=50% BLQ")) + + auclast <- pk.calc.sparse_auclast(conc=d_sparse$conc, time=d_sparse$time, subject=seq_len(nrow(d_sparse))) + expect_equal(attr(auclast$sparse_auclast, "method"), + c("AUC: linear", "Sparse: arithmetic mean, <=50% BLQ")) +}) From 8fb9d991f3cc719ac4ac92b1af15129d48e6314b Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Mon, 24 Nov 2025 06:10:02 +0100 Subject: [PATCH 18/20] namespace na.omit --- R/half.life.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/half.life.R b/R/half.life.R index 0bb9d169..db6ebd20 100644 --- a/R/half.life.R +++ b/R/half.life.R @@ -141,7 +141,9 @@ pk.calc.half.life <- function(conc, time, tmax, tlast, method_vec <- character() # Imputation method if (!all(is.na(impute_method))) { - method_vec <- c(method_vec, paste0("Imputation: ", paste(na.omit(impute_method), collapse = ", "))) + method_vec <- c(method_vec, paste0( + "Imputation: ", paste(stats::na.omit(impute_method), collapse = ", ") + )) } # Prepare the return values From c6ab60a030c3fadd57d9d66bcf25c50d015dd40a Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Mon, 24 Nov 2025 18:32:35 +0100 Subject: [PATCH 19/20] refactor attr method assignment --- R/auc.R | 5 ++--- R/aucint.R | 5 ++--- R/half.life.R | 22 ++++++++-------------- R/sparse.R | 19 +++++++++++-------- 4 files changed, 23 insertions(+), 28 deletions(-) diff --git a/R/auc.R b/R/auc.R index 5795e02a..ed5a3ad7 100644 --- a/R/auc.R +++ b/R/auc.R @@ -185,14 +185,13 @@ pk.calc.auxc <- function(conc, time, interval=c(0, Inf), ) } # Add method details as an attribute - method_vec <- character() + attr(ret, "method") <- character() auc_method <- if (is.null(method)) { PKNCA.options()$auc.method } else { method } - method_vec <- c(method_vec, paste0("AUC: ", auc_method)) - attr(ret, "method") <- method_vec + attr(ret, "method") <- c(attr(ret, "method"), paste0("AUC: ", auc_method)) ret } diff --git a/R/aucint.R b/R/aucint.R index 8fa4be09..ca562742 100644 --- a/R/aucint.R +++ b/R/aucint.R @@ -185,14 +185,13 @@ pk.calc.aucint <- function(conc, time, fun_inf = aucintegrate_inf ) # Add method details as an attribute - method_vec <- character() + attr(ret, "method") <- character() auc_method <- if (is.null(method)) { PKNCA.options()$auc.method } else { method } - method_vec <- c(method_vec, paste0("AUC: ", auc_method)) - attr(ret, "method") <- method_vec + attr(ret, "method") <- c(attr(ret, "method"), paste0("AUC: ", auc_method)) ret } diff --git a/R/half.life.R b/R/half.life.R index db6ebd20..34e5c219 100644 --- a/R/half.life.R +++ b/R/half.life.R @@ -87,10 +87,7 @@ pk.calc.half.life <- function(conc, time, tmax, tlast, conc.na=NULL, first.tmax=NULL, allow.tmax.in.half.life=NULL, - check=TRUE, - impute_method=NA_character_, - include_half.life=NULL, - exclude_half.life=NULL) { + check=TRUE) { # Check inputs min.hl.points <- PKNCA.choose.option( @@ -137,14 +134,6 @@ pk.calc.half.life <- function(conc, time, tmax, tlast, data <- data[as.numeric(data$time) > max(end.dose, na.rm = TRUE), ] } } - # Build method attribute - method_vec <- character() - # Imputation method - if (!all(is.na(impute_method))) { - method_vec <- c(method_vec, paste0( - "Imputation: ", paste(stats::na.omit(impute_method), collapse = ", ") - )) - } # Prepare the return values ret <- data.frame( @@ -168,6 +157,11 @@ pk.calc.half.life <- function(conc, time, tmax, tlast, half.life=NA, # T1/2 span ratio span.ratio=NA) + + + # Build method attribute + attr(ret, "method") <- character() + ret_replacements <- c("lambda.z", "r.squared", "adj.r.squared", "lambda.z.corrxy", "lambda.z.time.first", "lambda.z.time.last", "lambda.z.n.points", "clast.pred", "half.life", "span.ratio") @@ -193,7 +187,7 @@ pk.calc.half.life <- function(conc, time, tmax, tlast, dfK <- data[as.numeric(data$time) > as.numeric(ret$tmax), ] } if (manually.selected.points) { - method_vec <- c(method_vec, "Lambda Z: Manual selection") + attr(ret, "method") <- c(attr(ret, "method"), "Lambda Z: Manual selection") if (nrow(data) > 0) { fit <- fit_half_life(data=data, tlast=ret$tlast, conc_units=conc_units) ret[,ret_replacements] <- fit[,ret_replacements] @@ -284,7 +278,7 @@ pk.calc.half.life <- function(conc, time, tmax, tlast, ret$tmax <- NULL if (!missing(tlast)) ret$tlast <- NULL - attr(ret, "method") <- method_vec + ret } diff --git a/R/sparse.R b/R/sparse.R index 9a78f99c..b65c8ec3 100644 --- a/R/sparse.R +++ b/R/sparse.R @@ -317,20 +317,23 @@ pk.calc.sparse_auc <- function(conc, time, subject, method="linear" ) - # Add method details as an attribute - method_vec <- character() - auc_method <- "linear" - method_vec <- c(method_vec, paste0("AUC: ", auc_method)) - method_vec <- c(method_vec, paste0("Sparse: ", "arithmetic mean, <=50% BLQ")) - attr(auc, "method") <- method_vec - var_auc <- var_sparse_auc(sparse_pk_mean) - data.frame( + ret <- data.frame( sparse_auc=auc, # as.numeric() drops the "df" attribute sparse_auc_se=sqrt(as.numeric(var_auc)), sparse_auc_df=attr(var_auc, "df") ) + + # Add method details as an attribute + for (col in names(ret)) { + attr(ret[[col]], "method") <- character() + auc_method <- "linear" + attr(ret[[col]], "method") <- c(attr(ret[[col]], "method"), paste0("AUC: ", auc_method)) + attr(ret[[col]], "method") <- c(attr(ret[[col]], "method"), paste0("Sparse: ", "arithmetic mean, <=50% BLQ")) + } + + ret } #' @describeIn pk.calc.sparse_auc Compute the AUClast for sparse PK From 1c45fe3aa4cf92ecedff9c0d1520c8efbfe924a0 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Mon, 24 Nov 2025 18:32:51 +0100 Subject: [PATCH 20/20] test: ignore_attr when relevant --- tests/testthat/test-sparse.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-sparse.R b/tests/testthat/test-sparse.R index 99c20a40..fd828a80 100644 --- a/tests/testthat/test-sparse.R +++ b/tests/testthat/test-sparse.R @@ -21,13 +21,13 @@ test_that("sparse_auc", { regexp="Cannot yet calculate sparse degrees of freedom for multiple samples per subject" ) expect_equal(sparse_batch$sparse_auc, auclast, ignore_attr = TRUE) - expect_equal(sparse_batch$sparse_auc_se, auclast_se_batch) - expect_equal(sparse_batch$sparse_auc_df, NA_real_) + expect_equal(sparse_batch$sparse_auc_se, auclast_se_batch, ignore_attr = TRUE) + expect_equal(sparse_batch$sparse_auc_df, NA_real_, ignore_attr = TRUE) sparse_serial <- pk.calc.sparse_auc(conc=d_sparse$conc, time=d_sparse$time, subject=seq_len(nrow(d_sparse))) expect_equal(sparse_serial$sparse_auc, auclast, ignore_attr = TRUE) expect_equal(as.numeric(sparse_serial$sparse_auc_se), auclast_se_serial) - expect_equal(sparse_serial$sparse_auc_df, auclast_df_serial) + expect_equal(sparse_serial$sparse_auc_df, auclast_df_serial, ignore_attr = TRUE) }) test_that("sparse_auclast expected errors", {