tests/testthat/test-exclude_nca.R

In PKNCA: Perform Pharmacokinetic Non-Compartmental Analysis

test_that("exclude_nca", {
  my_conc <- PKNCAconc(data.frame(conc=c(1.1^(3:0), 1.1), time=0:4, subject=1), conc~time|subject)
  my_data <- PKNCAdata(my_conc, intervals=data.frame(start=0, end=Inf, aucinf.obs=TRUE, aucpext.obs=TRUE))
  suppressMessages(
    my_result <- pk.nca(my_data)
  )

  my_result_excluded <- exclude(my_result, FUN=exclude_nca_max.aucinf.pext())
  expect_equal(as.data.frame(my_result_excluded)$exclude,
               c(rep(NA_character_, nrow(my_result_excluded$result)-2),
                 rep("aucpext > 20", 2)))

  my_result_excluded <- exclude(my_result, FUN=exclude_nca_max.aucinf.pext(50))
  expect_equal(as.data.frame(my_result_excluded)$exclude,
               c(rep(NA_character_, nrow(my_result_excluded$result)-2),
                 rep("aucpext > 50", 2)))

  my_result_excluded <- exclude(my_result, FUN=exclude_nca_span.ratio())
  expect_equal(as.data.frame(my_result_excluded)$exclude,
               c(rep(NA_character_, 4),
                 rep("span.ratio < 2", 11)))
  my_result_excluded <- exclude(my_result, FUN=exclude_nca_span.ratio(1))
  expect_equal(as.data.frame(my_result_excluded)$exclude,
               c(rep(NA_character_, 4),
                 rep("span.ratio < 1", 11)))

  my_result_excluded <- exclude(my_result, FUN=exclude_nca_min.hl.r.squared())
  expect_equal(as.data.frame(my_result_excluded)$exclude,
               c(rep(NA_character_, 4),
                 rep("r.squared < 0.9", 11)))
  my_result_excluded <- exclude(my_result, FUN=exclude_nca_min.hl.r.squared(0.95))
  expect_equal(as.data.frame(my_result_excluded)$exclude,
               c(rep(NA_character_, 4),
                 rep("r.squared < 0.95", 11)))

  my_result_excluded <- exclude(my_result, FUN=exclude_nca_min.hl.adj.r.squared())
  expect_equal(as.data.frame(my_result_excluded)$exclude,
               c(rep(NA_character_, 4),
                 rep("adj.r.squared < 0.9", 11)))
  my_result_excluded <- exclude(my_result, FUN=exclude_nca_min.hl.adj.r.squared(0.95))
  expect_equal(as.data.frame(my_result_excluded)$exclude,
               c(rep(NA_character_, 4),
                 rep("adj.r.squared < 0.95", 11)))

  my_data <- PKNCAdata(my_conc, intervals=data.frame(start=0, end=Inf, cmax=TRUE))
  suppressMessages(
    my_result <- pk.nca(my_data)
  )
  expect_equal(my_result,
               exclude(my_result, FUN=exclude_nca_max.aucinf.pext()),
               info="Result is ignored when not calculated")
  expect_equal(my_result,
               exclude(my_result, FUN=exclude_nca_span.ratio()),
               info="Result is ignored when not calculated")
  expect_equal(my_result,
               exclude(my_result, FUN=exclude_nca_min.hl.r.squared()),
               info="Result is ignored when not calculated")
  expect_equal(my_result,
               exclude(my_result, FUN=exclude_nca_min.hl.adj.r.squared()),
               info="Result is ignored when not calculated")
})

test_that("exclude_nca_max.aucinf.pext", {
  my_conc <- PKNCAconc(data.frame(conc=c(1.1^(3:0), 1.1), time=0:4, subject=1), conc~time|subject)
  my_data <- PKNCAdata(my_conc, intervals=data.frame(start=0, end=Inf, aucpext.pred=TRUE, aucpext.obs=TRUE))
  suppressMessages(
    my_result <- pk.nca(my_data)
  )
  expect_equal(
    as.data.frame(my_result)$exclude,
    rep(NA_character_, nrow(as.data.frame(my_result)))
  )
  my_result_exclude_20 <- exclude(my_result, FUN = exclude_nca_max.aucinf.pext(max.aucinf.pext = 20))
  expect_equal(
    as.data.frame(my_result_exclude_20)$exclude,
    c(rep(NA_character_, nrow(as.data.frame(my_result_exclude_20))-4), rep("aucpext > 20", 4))
  )
  my_result_exclude_50 <- exclude(my_result, FUN = exclude_nca_max.aucinf.pext(max.aucinf.pext = 50))
  expect_equal(
    as.data.frame(my_result_exclude_50)$exclude,
    c(rep(NA_character_, nrow(as.data.frame(my_result_exclude_50))-4), rep("aucpext > 50", 4))
  )
})

test_that("exclude_nca_count_conc_measured", {
  my_conc <- PKNCAconc(data.frame(conc=c(1.1^(c(3:0, -Inf)), 1.1), time=0:5, subject = 1), conc~time|subject)
  my_data <- PKNCAdata(my_conc, intervals=data.frame(start=0, end=Inf, aucinf.obs=TRUE, aucpext.obs=TRUE, count_conc_measured = TRUE))
  suppressMessages(
    my_result <- pk.nca(my_data)
  )
  expect_equal(
    as.data.frame(my_result)$exclude,
    rep(NA_character_, 16)
  )
  my_result_exclude5 <- exclude(my_result, FUN = exclude_nca_count_conc_measured(min_count = 5))
  expect_equal(
    as.data.frame(my_result_exclude5)$exclude,
    rep(NA_character_, 16)
  )
  my_result_exclude10 <- exclude(my_result, FUN = exclude_nca_count_conc_measured(min_count = 10))
  expect_equal(
    as.data.frame(my_result_exclude10)$exclude,
    c("count_conc_measured < 10", rep(NA_character_, 13), rep("count_conc_measured < 10", 2))
  )
})

test_that("exclude_nca_tmax_early", {
  my_conc <- PKNCAconc(data.frame(conc=c(1.1^(c(3:0, -Inf)), 1.1), time=0:5, subject = 1), conc~time|subject)
  my_data <- PKNCAdata(my_conc, intervals=data.frame(start=0, end=Inf, auclast = TRUE, half.life = TRUE))
  suppressMessages(
    my_result <- pk.nca(my_data)
  )
  expect_equal(
    as.data.frame(my_result)$exclude,
    rep(NA_character_, nrow(as.data.frame(my_result)))
  )
  my_result_exclude_1 <- exclude(my_result, FUN = exclude_nca_tmax_early(tmax_early = 1))
  expect_equal(
    as.data.frame(my_result_exclude_1)$exclude,
    rep("tmax < 1 (likely missed dose, insufficient PK samples, or PK sample swap)", nrow(as.data.frame(my_result_exclude_1)))
  )
  my_result_exclude_0 <- exclude(my_result, FUN = exclude_nca_tmax_0())
  expect_equal(
    as.data.frame(my_result_exclude_0)$exclude,
    rep("tmax <= 0 (likely missed dose, insufficient PK samples, or PK sample swap)", nrow(as.data.frame(my_result_exclude_0)))
  )
  # This should never happen in real code
  expect_error(
    exclude_nca_tmax_early()(data.frame(PPTESTCD = "tmax", PPORRES = 1:2)),
    regexp = "Should not see more than one tmax (please report this as a bug)",
    fixed = TRUE
  )
})

test_that("exclude_nca_by_param works as expected", {
  # Define the input
  my_conc <- PKNCAconc(data.frame(conc=c(1.1^(3:0), 1.1), time=0:4, subject=1), conc~time|subject)
  my_data <- PKNCAdata(my_conc, intervals=data.frame(start=0, end=Inf, span.ratio=TRUE))
  suppressMessages(
    my_result <- pk.nca(my_data)
  )

  # excludes rows based on min_thr
  res_min_excluded <- PKNCA::exclude(
    my_result,
    FUN = exclude_nca_by_param("span.ratio", min_thr = 100)
  )
  expect_equal(
    as.data.frame(res_min_excluded)$exclude,
    c(rep(NA, 10), "span.ratio < 100")
  )

  # does not exclude rows when min_thr is not met
  res_min_not_excluded <- PKNCA::exclude(
    my_result,
    FUN = exclude_nca_by_param("span.ratio", min_thr = 0.01)
  )
  expect_equal(
    as.data.frame(res_min_not_excluded)$exclude,
    rep(NA_character_, 11)
  )

  # excludes rows based on max_thr
  res_max_excluded <- PKNCA::exclude(
    my_result,
    FUN = exclude_nca_by_param("span.ratio", max_thr = 0.01)
  )
  expect_equal(
    as.data.frame(res_max_excluded)$exclude,
    c(rep(NA, 10), "span.ratio > 0.01")
  )

  # does not exclude rows when max_thr is not exceeded
  res_max_not_excluded <- PKNCA::exclude(
    my_result,
    FUN = exclude_nca_by_param("span.ratio", max_thr = 100)
  )
  expect_equal(
    as.data.frame(res_max_not_excluded)$exclude,
    rep(NA_character_, 11)
  )

  # throws an error for invalid min_thr
  expect_error(
    exclude_nca_by_param("span.ratio", min_thr = "invalid"),
    "Check on 'min_thr' failed: Must be of type 'number'"
  )

  # throws an error for invalid max_thr
  expect_error(
    exclude_nca_by_param(parameter = "span.ratio", max_thr = c(1, 2)),
    "Check on 'max_thr' failed: Must have length 1"
  )

  # throws an error when min_thr is greater than max_thr
  expect_error(
    exclude_nca_by_param("span.ratio", min_thr = 10, max_thr = 5),
    "if both defined min_thr must be less than max_thr"
  )

  # returns the original object when the parameter is not found
  res <- PKNCA::exclude(my_result, FUN = exclude_nca_by_param("nonexistent", min_thr = 0))
  expect_true(all(is.na(as.data.frame(res)$exclude)))

  # returns the object when the parameter's value is NA
  my_result_na <- my_result
  my_result_na$result$PPORRES <- NA
  res <- PKNCA::exclude(
    my_result_na,
    FUN = exclude_nca_by_param("span.ratio", min_thr = 0)
  )
  expect_true(all(is.na(as.data.frame(res)$exclude)))

  # marks records associated with the affected_parameters
  res <- PKNCA::exclude(
    my_result,
    FUN = exclude_nca_by_param(
      "span.ratio", min_thr = 0.01, affected_parameters = c("lambda.z", "span.ratio")
    )
  )
  # All span.ratio records should be NA (not excluded)
  expect_true(all(is.na(as.data.frame(res)$exclude[res$result$PPTESTCD == "span.ratio"])))
  expect_true(all(is.na(as.data.frame(res)$exclude[res$result$PPTESTCD == "lambda.z"])))

  # produces an error when more than 1 PPORRES is per parameter (should never happen in real code)
  expect_error(
    exclude_nca_by_param(
      param = "r.squared",
      min_thr = 0.7
    )(data.frame(PPTESTCD = "r.squared", PPORRES = c(1, 1))),
    regexp = "Should not see more than one r.squared (please report this as a bug)",
    fixed = TRUE
  )
})