Creation of functions to set intervals after verification

NAMESPACE

@@ -105,6 +105,7 @@ export(as_PKNCAdata)
 export(as_PKNCAdose)
 export(as_PKNCAresults)
 export(as_sparse_pk)
+export(assert_intervals)
 export(business.cv)
 export(business.geocv)
 export(business.geomean)
@@ -215,6 +216,7 @@ export(roundString)
 export(roundingSummarize)
 export(setDuration)
 export(setRoute)
+export(set_intervals)
 export(signifString)
 export(sparse_auc_weight_linear)
 export(sparse_mean)

NEWS.md

@@ -5,6 +5,10 @@ the inclusion of IV NCA parameters and additional specifications of
 the dosing including dose amount and route.
 
 # PKNCA 0.11.0.9000
+* PKNCA will now make verifications on the `intervals` object within the
+  creation of PKNCAdata. This will return errors, or create the `PKNCAdata`
+  object as intended when no errors are present. Some of the verifications include
+  checking of intended column naming and ensuring the correct data type.
 * PKNCA now contains a `getGroups.PKNCAdata` function to capture grouping columns.
 * Duplicate data checks now account for excluded rows.  So, if a row is
   duplicated and all but one of the duplicated rows is excluded, it is not an

R/001-add.interval.col.R

@@ -253,3 +253,11 @@ add.interval.col(
   pretty_name="Interval End",
   desc = "Ending time of the interval (potentially infinity)"
 )
+# add.interval.col(
+#   "impute",
+#   FUN = NA,
+#   values = as.character,
+#   unit_type="time",
+#   pretty_name="Interval Imputation",
+#   desc = "Imputation method parameters"
+# )

R/class-PKNCAdata.R

@@ -100,6 +100,10 @@ PKNCAdata.default <- function(data.conc, data.dose, ...,
     }
   }
   ret$options <- options
+
+  # Assign the class and give it all back to the user.
+  class(ret) <- c("PKNCAdata", class(ret))
+
   # Check the intervals
   if (missing(intervals) & identical(ret$dose, NA)) {
     stop("If data.dose is not given, intervals must be given")
@@ -158,6 +162,7 @@ PKNCAdata.default <- function(data.conc, data.dose, ...,
         cols="data_intervals"
       )
   }
+  ret <- set_intervals(ret, intervals)
   ret$intervals <- check.interval.specification(intervals)
   # Verify that either everything or nothing is using units
   units_interval_start <- inherits(ret$intervals$start, "units")
@@ -179,9 +184,7 @@ PKNCAdata.default <- function(data.conc, data.dose, ...,
     checkmate::assert_character(impute, len = 1)
     ret$impute <- impute
   }
-
-  # Assign the class and give it all back to the user.
-  class(ret) <- c("PKNCAdata", class(ret))
+
   ret
 }
 

R/set_and_assert_intervals.R

@@ -0,0 +1,69 @@
+#'  Set Intervals
+#'
+#'  Takes in two objects, the PKNCAdata object and the proposed intervals.
+#'  It will then check that the intervals are valid, given the data object.
+#'  If the intervals are valid, it will set them in the object.
+#'  It will return the data object with the intervals set.
+#'  
+#' @param data PKNCAdata object
+#' @param intervals Proposed intervals
+#' @returns The data object with the intervals set.
+#'   
+#' @export
+set_intervals <- function(data, intervals) {
+  valid_intervals <- assert_intervals(intervals, data)
+
+  data$intervals <- valid_intervals
+
+  data
+}
+
+#'  Assert Intervals
+#'
+#'  Verifies that an interval definition is valid for a PKNCAdata object.
+#'  Valid means that intervals are a data.frame (or data.frame-like object), 
+#'  that the column names are either the groupings of the PKNCAconc part of 
+#'  the PKNCAdata object or that they are one of the NCA parameters allowed 
+#'  (i.e. names(get.interval.cols())). 
+#'  It will return the intervals argument unchanged, or it will raise an error.
+#'  
+#' @param intervals Proposed intervals
+#' @param data PKNCAdata object
+#' @returns The intervals argument unchanged, or it will raise an error.
+#'   
+#' @export
+assert_intervals <- function(intervals, data) {
+  if (!is.data.frame(intervals)) {
+    stop("The 'intervals' argument must be a data frame or a data frame-like object.")
+  }
+
+  if (class(data)[1] != "PKNCAdata") {
+    stop("The 'data' argument must be a PKNCAdata object.")
+  }
+
+  ifelse("keep_interval_cols" %in% names(data$options),
+  allowed_columns <- c(
+    names(getGroups.PKNCAdata(data)),
+    names(get.interval.cols()),
+    "conc_above",
+    "time_above",
+    "impute",
+    data$options$keep_interval_cols
+  ),
+    allowed_columns <- c(
+    names(getGroups.PKNCAdata(data)),
+    names(get.interval.cols()),
+    "conc_above",
+    "time_above",
+    "impute"
+  )
+  )
+
+  invalid_columns <- setdiff(names(intervals), allowed_columns)
+
+  if (length(invalid_columns) > 0) {
+    stop("The following columns in 'intervals' are not allowed: ", paste(invalid_columns, collapse = ", "))
+  }
+
+  intervals
+}

tests/testthat/test-pk.calc.all.R

@@ -587,7 +587,7 @@ test_that("calculate with sparse data", {
   # Correct detection of mixed doses within a sparse dose group when there are no groups
 })
 
-test_that("Unexpected interval columns do not cause an error (#238)", {
+test_that("Unexpected interval columns now not cause an error (#238)", {
   d_conc <-
     data.frame(
       ID = 1L,
@@ -598,8 +598,9 @@ test_that("Unexpected interval columns do not cause an error (#238)", {
   d_intervals <- data.frame(start = 0, end = 6, cmax = TRUE, aucinf = TRUE)
   o_conc <- PKNCAconc(d_conc, formula = conc~time|ID)
   o_dose <- PKNCAdose(d_dose, formula = dose~.)
-  o_data <- PKNCAdata(o_conc, o_dose, intervals = d_intervals)
-  expect_s3_class(pk.nca(o_data), "PKNCAresults")
+  expect_error(PKNCAdata(o_conc, o_dose, intervals = d_intervals),
+               "The following columns in 'intervals' are not allowed:"
+  )
 })
 
 test_that("aucint works within pk.calc.all for all zero concentrations with interpolated or extrapolated concentrations", {
@@ -641,12 +642,8 @@ test_that("The option keep_interval_cols is respected", {
   d_interval <- data.frame(start = 0, end = 4, cmax = TRUE, foo = "A")
   d_conctime <- data.frame(conc = c(0, 0, 0, 0), time = 0:3)
   o_conc <- PKNCAconc(d_conctime, conc~time)
-  o_data <- PKNCAdata(o_conc, intervals = d_interval)
-  suppressWarnings(suppressMessages(
-    o_nca <- pk.nca(o_data)
-  ))
-  expect_false("foo" %in% names(o_nca$result))
-  expect_false("foo" %in% names(summary(o_nca)))
+ expect_error(PKNCAdata(o_conc, intervals = d_interval),
+              "The following columns in 'intervals' are not allowed:")
 
   o_data <- PKNCAdata(o_conc, intervals = d_interval, options = list(keep_interval_cols = "foo"))
   suppressWarnings(suppressMessages(

tests/testthat/test-set_and_assert_intervals.R

@@ -0,0 +1,100 @@
+test_that("assert_intervals works with valid intervals", {
+  o_conc <- PKNCAconc(as.data.frame(datasets::Theoph), conc~Time|Subject)
+  o_data <- PKNCAdata(o_conc, intervals = data.frame(start = 0, end = 1, cmax = TRUE))
+
+  result <- assert_intervals(intervals = data.frame(start = 0, end = 1, cmax = TRUE), o_data)
+  expect_equal(result, expected = data.frame(start = 0, end = 1, cmax = TRUE))
+})
+
+test_that("assert_intervals works with valid intervals (ungrouped)", {
+  o_conc <- PKNCAconc(as.data.frame(datasets::Theoph)[datasets::Theoph$Subject == 1,], conc~Time)
+  o_data <- PKNCAdata(o_conc, intervals = data.frame(start = 0, end = 1, cmax = TRUE))
+
+  result <- assert_intervals(intervals = data.frame(start = 0, end = 1, cmax = TRUE), o_data)
+  expect_equal(result, expected = data.frame(start = 0, end = 1, cmax = TRUE))
+})
+
+
+test_that("assert_intervals errors with non-data frame intervals", {
+  o_conc <- PKNCAconc(as.data.frame(datasets::Theoph), conc~Time|Subject)
+  o_data <- PKNCAdata(o_conc, intervals = data.frame(start = 0, end = 1, cmax = TRUE))
+  non_df_intervals <- list(a = 1, b = 2)
+
+  expect_error(assert_intervals(non_df_intervals, o_data), 
+               "The 'intervals' argument must be a data frame or a data frame-like object.")
+})
+
+test_that("assert_intervals errors with non-data frame intervals (ungrouped)", {
+  o_conc <- PKNCAconc(as.data.frame(datasets::Theoph)[datasets::Theoph$Subject == 1,], conc~Time)
+  o_data <- PKNCAdata(o_conc, intervals = data.frame(start = 0, end = 1, cmax = TRUE))
+  non_df_intervals <- list(a = 1, b = 2)
+
+  expect_error(assert_intervals(non_df_intervals, o_data), 
+               "The 'intervals' argument must be a data frame or a data frame-like object.")
+})
+
+test_that("assert_intervals errors with non-PKNCAdata data object", {
+  expect_error(assert_intervals(intervals = data.frame(start = 0, end = 1, cmax = TRUE), 
+               data = data.frame(a = 1, b = 2)),
+               "The 'data' argument must be a PKNCAdata object.")
+})
+
+test_that("assert_intervals errors with invalid columns", {
+  o_conc <- PKNCAconc(as.data.frame(datasets::Theoph), conc~Time|Subject)
+  o_data <- PKNCAdata(o_conc, intervals = data.frame(start = 0, end = 1, cmax = TRUE))
+
+  invalid_intervals <- data.frame(
+    mean = TRUE,  # Not allowed NCA params
+    median = TRUE
+  )
+
+  expect_error(assert_intervals(invalid_intervals, o_data), 
+               "The following columns in 'intervals' are not allowed:")
+})
+
+test_that("assert_intervals errors with invalid columns", {
+  o_conc <- PKNCAconc(as.data.frame(datasets::Theoph)[datasets::Theoph$Subject == 1,], conc~Time)
+  o_data <- PKNCAdata(o_conc, intervals = data.frame(start = 0, end = 1, cmax = TRUE))
+
+  invalid_intervals <- data.frame(
+    mean = TRUE,  # Not allowed NCA params
+    median = TRUE
+  )
+
+  expect_error(assert_intervals(invalid_intervals, o_data), 
+               "The following columns in 'intervals' are not allowed:")
+})
+
+test_that("set_intervals works with valid intervals", {
+  o_conc <- PKNCAconc(as.data.frame(datasets::Theoph), conc~Time|Subject)
+  o_data <- PKNCAdata(o_conc, intervals = data.frame(start = 0, end = 1, cmax = TRUE))
+
+  result <- set_intervals(o_data, intervals = data.frame(start = 0, end = 1, cmin = TRUE))
+
+  expect_equal(result$intervals, data.frame(start = 0, end = 1, cmin = TRUE))
+})
+
+test_that("set_intervals works with valid intervals (ungrouped)", {
+  o_conc <- PKNCAconc(as.data.frame(datasets::Theoph)[datasets::Theoph$Subject == 1,], conc~Time)
+  o_data <- PKNCAdata(o_conc, intervals = data.frame(start = 0, end = 1, cmax = TRUE))
+
+  result <- set_intervals(o_data, intervals = data.frame(start = 0, end = 1, cmin = TRUE))
+
+  expect_equal(result$intervals, data.frame(start = 0, end = 1, cmin = TRUE))
+})
+
+test_that("set_intervals fails with invalid intervals", {
+  o_conc <- PKNCAconc(as.data.frame(datasets::Theoph), conc~Time|Subject)
+  o_data <- PKNCAdata(o_conc, intervals = data.frame(start = 0, end = 1, cmax = TRUE))
+
+  expect_error(set_intervals(o_data, intervals = data.frame(start = 0, end = 1, cmedian = TRUE)), 
+               "The following columns in 'intervals' are not allowed:")
+})
+
+test_that("set_intervals fails when not using PKNCAdata", {
+  o_conc <- PKNCAconc(as.data.frame(datasets::Theoph), conc~Time|Subject)
+  o_data <- PKNCAdata(o_conc, intervals = data.frame(start = 0, end = 1, cmax = TRUE))
+
+  expect_error(set_intervals(o_conc, intervals = data.frame(start = 0, end = 1, cmin = TRUE)), 
+               "The 'data' argument must be a PKNCAdata object.")
+})