Merge pull request #146 from billdenney/fix-141

Fix 141

NEWS.md

@@ -11,6 +11,7 @@ the dosing including dose amount and route.
   are given for first, middle, and last (related to #145).  This only affects
   datasets where BLQ is being replaced with a nonzero value (not a common
   scenario).
+* Fix issue where intervals could not be tibbles (#141)
 
 # PKNCA 0.9.4
 

R/check.intervals.R

@@ -24,20 +24,22 @@ check.interval.specification <- function(x) {
     warning("Interval specification must be a data.frame")
     x <- as.data.frame(x, stringsAsFactors=FALSE)
   }
-  if (nrow(x) == 0)
+  if (nrow(x) == 0) {
     stop("interval specification has no rows")
+  }
   # Confirm that the minimal columns (start and end) exist
-  if (length(missing.required.cols <- setdiff(c("start", "end"), names(x))) > 0)
+  if (length(missing.required.cols <- setdiff(c("start", "end"), names(x))) > 0) {
     stop(sprintf("Column(s) %s missing from interval specification",
                  paste0("'", missing.required.cols, "'",
                         collapse=", ")))
+  }
   interval_cols <- get.interval.cols()
   # Check the edit of each column
-  for (n in names(interval_cols))
+  for (n in names(interval_cols)) {
     if (!(n %in% names(x))) {
       if (is.vector(interval_cols[[n]]$values)) {
         ## Set missing columns to the default value
-        x[,n] <- interval_cols[[n]]$values[1]
+        x[[n]] <- interval_cols[[n]]$values[1]
       } else {
         # It would probably take malicious code to get here (altering
         # the intervals without using add.interval.col
@@ -46,18 +48,20 @@ check.interval.specification <- function(x) {
     } else {
       ## Confirm the edits of the given columns
       if (is.vector(interval_cols[[n]]$values)) {
-        if (!all(x[,n] %in% interval_cols[[n]]$values))
+        if (!all(x[[n]] %in% interval_cols[[n]]$values))
           stop(sprintf("Invalid value(s) in column %s:", n),
-               paste(unique(setdiff(x[,n], interval_cols[[n]]$values)),
+               paste(unique(setdiff(x[[n]], interval_cols[[n]]$values)),
                      collapse=", "))
       } else if (is.function(interval_cols[[n]]$values)) {
-        if (is.factor(x[,n]))
+        if (is.factor(x[[n]])) {
           stop(sprintf("Interval column '%s' should not be a factor", n))
-        interval_cols[[n]]$values(x[,n])
+        }
+        interval_cols[[n]]$values(x[[n]])
       } else {
         stop("Invalid 'values' for column specification ", n, " (please report this as a bug).") # nocov
       }
     }
+  }
   ## Now check specific columns
   ## ##############################
   ## start and end
@@ -75,7 +79,7 @@ check.interval.specification <- function(x) {
   for (n in setdiff(names(interval_cols), c("start", "end")))
     mask_calculated <-
       (mask_calculated |
-       !(x[,n] %in% c(NA, FALSE)))
+       !(x[[n]] %in% c(NA, FALSE)))
   if (any(!mask_calculated))
     warning("Nothing to be calculated in interval specification number(s): ",
             paste((1:nrow(x))[!mask_calculated], collapse=", "))

R/class-PKNCAdata.R

@@ -58,8 +58,9 @@ PKNCAdata.default <- function(data.conc, data.dose, ...,
   ret <- list()
   ## Generate the conc element
   if (inherits(data.conc, "PKNCAconc")) {
-    if (!missing(formula.conc))
+    if (!missing(formula.conc)) {
       warning("data.conc was given as a PKNCAconc object.  Ignoring formula.conc")
+    }
     ret$conc <- data.conc
   } else {
     ret$conc <- PKNCAconc(data.conc, formula=formula.conc)
@@ -77,8 +78,9 @@ PKNCAdata.default <- function(data.conc, data.dose, ...,
     ret$dose <- PKNCAdose(data.dose, formula.dose)
   }
   ## Check the options
-  if (!is.list(options))
+  if (!is.list(options)) {
     stop("options must be a list.")
+  }
   if (length(options) > 0) {
     if (is.null(names(options)))
       stop("options must have names.")

tests/testthat/test-check.intervals.R

@@ -179,3 +179,45 @@ test_that("check.intervals requires a valid value", {
     fixed=TRUE
   )
 })
+
+test_that("check.intervals works with tibble input (fix #141)", {
+  e.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 <-
+    e.dat %>%
+    dplyr::group_by(SUBJ) %>%
+    dplyr::summarize(
+      start=time[dplyr::between(time, 264, 265)],
+      end=time[dplyr::between(time, 288, 289)]
+    )
+  intervals_manual_second <-
+    e.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
+  )
+})