tests/testthat/test-check.intervals.R

In billdenney/pknca: Perform Pharmacokinetic Non-Compartmental Analysis

test_that("check.interval.specification", {

  # Get the current name order of the expected results
  nameorder <- names(check.interval.deps(data.frame(start=0, end=1, cmax=TRUE)))

  d1 <- data.frame(start=0, end=1)
  r1 <- data.frame(start=0, end=1)
  r1[,setdiff(nameorder, names(r1))] <- FALSE
  expect_warning(expect_warning(
    check.interval.specification(as.matrix(d1)),
    regexp="Interval specification must be a data.frame",
    info="Interval must be a data.frame or coercable into a data frame"),
    regexp="Nothing to be calculated in interval specification number\\(s\\): 1"
  )
  expect_warning(
    d1.check <- check.interval.specification(d1),
    regexp="Nothing to be calculated in interval specification number\\(s\\): 1",
    info="Warn if nothing is to be calculated in an interval specification"
  )
  expect_equal(
    d1.check, r1[,nameorder],
    info="Expand a minimal data frame for interval specification"
  )

  # Giving one parameter will fill in everything else as false
  d2 <- data.frame(start=0, end=1, auclast=TRUE)
  r2 <- data.frame(start=0, end=1, auclast=TRUE)
  r2[,setdiff(nameorder, names(r2))] <- FALSE
  expect_equal(
    check.interval.specification(d2),
    r2[,nameorder],
    info="Expand a data frame interval specification with only one request given"
  )

  # start and end must both be specified
  d3 <- data.frame(start=0)
  expect_error(
    check.interval.specification(d3),
    regexp="Column\\(s\\) 'end' missing from interval specification",
    info="Confirm end column is in interval specification"
  )
  d4 <- data.frame(end=1)
  expect_error(
    check.interval.specification(d4),
    regexp="Column\\(s\\) 'start' missing from interval specification",
    info="Confirm start column is in interval specification"
  )
  d5 <- data.frame(blah=5)
  expect_error(
    check.interval.specification(d5),
    regexp="Column\\(s\\) 'start', 'end' missing from interval specification",
    info="Confirm start and end columns are in interval specification"
  )

  # Ensure that there are data
  d6 <- data.frame()
  expect_error(
    check.interval.specification(d6),
    regexp="interval specification has no rows",
    info="It is an error to have an interval specification with no rows"
  )

  # Confirm specific column values required
  d7 <- data.frame(start=as.numeric(NA), end=1)
  expect_error(
    check.interval.specification(d7),
    regexp="Interval specification may not have NA for the starting time",
    info="Interval specification may not have NA for the starting time"
  )
  d8 <- data.frame(start=0, end=as.numeric(NA))
  expect_error(
    check.interval.specification(d8),
    regexp="Interval specification may not have NA for the end time",
    info="Interval specification may not have NA for the end time"
  )
  d9 <- data.frame(start=1, end=1)
  expect_error(
    check.interval.specification(d9),
    regexp="start must be < end",
    info="In interval specification, start must be < end (they are equal)."
  )
  d10 <- data.frame(start=1, end=0)
  expect_error(
    check.interval.specification(d10),
    regexp="start must be < end",
    info="In interval specification, start must be < end (end is less)."
  )
  d11 <- data.frame(start=Inf, end=1)
  expect_error(
    check.interval.specification(d11),
    regexp="start may not be infinite",
    info="In interval specification, start may not be infinite (positive infinity)."
  )

  d12 <- data.frame(start=-Inf, end=1)
  expect_error(
    check.interval.specification(d12),
    regexp="start may not be infinite",
    info="In interval specification, start may not be infinite (negative infinity)."
  )

  # But it is OK to have an infinite end
  d13 <- data.frame(start=0, end=Inf)
  r13 <- data.frame(start=0, end=Inf)
  r13[,setdiff(nameorder, names(r13))] <- FALSE
  expect_warning(d13.check <- check.interval.specification(d13))
  expect_equal(
    d13.check, r13[,nameorder],
    info="In interval specification, end may be infinite (positive infinity)."
  )
  expect_error(
    check.interval.specification(data.frame(start=0, end=-Inf)),
    info="In interval specification, end may not be negative infinity (start is 0)."
  )
  expect_error(
    check.interval.specification(data.frame(start=-Inf, end=-Inf)),
    info="In interval specification, end may not be negative infinity (start is -Inf)."
  )

  # When the no-calculation interval specification is not the first,
  # ensure that is warned correctly
  d14 <- data.frame(start=0, end=24, auclast=c(rep(FALSE, 3), TRUE))
  expect_warning(
    check.interval.specification(d14),
    regexp="Nothing to be calculated in interval specification number\\(s\\): 1, 2, 3",
    info="Warn when nothing is to be calculated in all rows of the specification."
  )

  d14 <- data.frame(start=0, end=24, auclast=c(rep(TRUE, 3), FALSE))
  expect_warning(
    check.interval.specification(d14),
    regexp="Nothing to be calculated in interval specification number\\(s\\): 4",
    info="Warn when nothing is to be calculated in one but not all rows of the specification."
  )

  # Other information is passed through untouched after all the
  # calculation columns
  d15 <- data.frame(start=0, end=Inf, treatment="foo")
  r15 <- data.frame(start=0, end=Inf, treatment="foo")
  r15[,setdiff(nameorder, names(r15))] <- FALSE
  expect_warning(v15 <- check.interval.specification(d15))
  expect_equal(
    v15, r15[,c(nameorder, "treatment")],
    info="Extra information is maintained in the interval specification."
  )

  d16 <- data.frame(start=factor(0), end=1)
  expect_error(
    check.interval.specification(d16),
    regexp="Interval column 'start' should not be a factor",
    info="Start must be numeric and not a factor."
  )

  d17 <- data.frame(start=0, end=factor(1))
  expect_error(
    check.interval.specification(d17),
    regexp="Interval column 'end' should not be a factor",
    info="End must be numeric and not a factor."
  )
})

test_that("check.interval.deps", {
  # Get the current name order of the expected results
  nameorder <- names(check.interval.deps(data.frame(start=0, end=1, cmax=TRUE)))

  r1 <- data.frame(
    start = 0,
    end = 24,
    lambda.z = TRUE,
    clast.obs = TRUE,
    aucinf.obs = TRUE
  )
  r1[,setdiff(nameorder, names(r1))] <- FALSE
  expect_equal(
    check.interval.deps(data.frame(start=0, end=24, aucinf.obs=TRUE)),
    r1[,nameorder],
    info="Confirm that the interval dependencies are accurately added"
  )
})

test_that("get.parameter.deps", {
  expect_error(
    get.parameter.deps("foo"),
    regexp="`x` must be the name of an NCA parameter listed by the function `get.interval.cols()`",
    info="The argument must be a parameter.",
    fixed=TRUE
  )
  expect_equal(
    get.parameter.deps("kel.obs"),
    "kel.obs",
    info="Parameters that have nothing that depend on them return themselves only."
  )
  expect_equal(
    get.parameter.deps("ctrough"),
    c("aucabove.trough.all", "ctrough", "ctrough.dn", "ptr"),
    info="Parameters with formalsmap-related dependencies return themselves and the formalsmap-related dependencies."
  )
  expect_equal(
    get.parameter.deps("start"),
    character(0),
    info="Special columns that are not actually parameters have no dependencies (including themselves)."
  )
  expect_equal(
    get.parameter.deps("cl.obs"),
    c("cl.obs", "vss.iv.obs", "vss.obs", "vz.obs"),
    info="Parameters with dependencies return them."
  )
})

test_that("check.intervals requires a valid value", {
  expect_error(
    check.interval.specification(data.frame(start=0, end=1, cmax="A")),
    regexp="Invalid value(s) in column cmax:A",
    fixed=TRUE
  )
})

test_that("check.intervals works with tibble input (fix #141)", {
  d_dat <-
    data.frame(
      conc = c(
        0.5, 2, 5, 9.2, 12, 2, 1.85, 1.08, 0.5, 0.3, 2.4, 4.5, 10.2, 15, 2.6, 1.65, 1.1,
        0.5, 2, 5, 9.2, 12, 2, 1.85, 1.08, NA, 0.3, 2.4, 4.5, 10.2, 15, 2.6, 1.65, 1.1
      ),
      time = c(seq(264.2, 312.2, 3), seq(264, 312, 3)),
      ARM = rep(c(rep(1, 8), rep(2, 9)), 2),
      SUBJ = c(rep(1, 17), rep(2, 17)),
      Dose = c(rep(5, 17)), rep(5, 17)
    )

  intervals_manual_first <-
    d_dat %>%
    dplyr::group_by(SUBJ) %>%
    dplyr::summarize(
      start=time[dplyr::between(time, 264, 265)],
      end=time[dplyr::between(time, 288, 289)]
    )
  intervals_manual_second <-
    d_dat %>%
    dplyr::group_by(SUBJ) %>%
    dplyr::summarize(
      start=time[dplyr::between(time, 288, 289)],
      end=time[dplyr::between(time, 312, 313)]
    )
  intervals_manual <-
    dplyr::bind_rows(
      intervals_manual_first,
      intervals_manual_second
    ) %>%
    dplyr::mutate(
      auclast=TRUE,
      aucall=TRUE,
      tlast=TRUE
    )
  # There is some other issue here where intervals are having an issue being a tibble
  expect_equal(
    check.interval.specification(intervals_manual)$start,
    intervals_manual$start
  )
})