wrap reg type logic into function; use throughout code

Author: jasmineirx

R/advan_create_data.R

@@ -18,7 +18,7 @@ advan_create_data <- function(
   covariate_model = NULL) {
 
   ## Set up basic structure
-  is_bolus <- regimen$type == "bolus" | grepl("oral", regimen$type)
+  is_bolus <- is_bolus_or_oral(regimen)
   data <- data.frame(
     ID = 1,
     TIME = regimen$dose_times,

R/create_event_table.R

@@ -122,7 +122,7 @@ create_event_table <- function(
   # parse list to a design (data.frame)
   # For boluses, oral, and covariates, set infusion time to 0. For all
   # other methods, assume infusion time was provided correctly
-  is_bolus <- regimen$type %in% c("bolus", "covariate") | grepl("oral", regimen$type)
+  is_bolus <- regimen$type %in% c("covariate") | is_bolus_or_oral(regimen)
   regimen$t_inf[is_bolus] <- 0
   dos <- data.frame(cbind(t = regimen$dose_times,
                   dose = regimen$dose_amts,

R/new_regimen.R

@@ -127,20 +127,20 @@ new_regimen <- function(
   if(length(reg$type) != length(reg$dose_times)) {
     reg$type <- rep(reg$type[1], length(reg$dose_times))
   }
-  if(any(reg$type %in% c("infusion", "sc", "im"))) {
-    if(any(reg$t_inf == 0)) {
-      reg$t_inf[reg$t_inf == 0] <- 1/60
-      reg$rate[reg$t_inf == 0] <- 60
+  # set oral/bolus t_inf to zero, and non-oral/bolus t_inf to minimum 1 minute
+  idx_bolus_oral <- is_bolus_or_oral(reg)
+  if (!all(idx_bolus_oral)) {
+    idx_infusion_0length <- reg$t_inf == 0 & !idx_bolus_oral
+    if (any(idx_infusion_0length)) {
+      reg$t_inf[idx_infusion_0length] <- 1/60
+      reg$rate[idx_infusion_0length] <- 60
     }
   }
-  if(any(reg$type == "bolus")) {
-    reg$t_inf[reg$type == "bolus"] <- 0
-    reg$rate[reg$type == "bolus"] <- 0
-  }
-  if(any(grepl("oral", reg$type))) {
-    reg$t_inf[grepl("oral", reg$type)] <- 0
-    reg$rate[grepl("oral", reg$type)] <- 0
+  if(any(is_bolus_or_oral(reg))) {
+    reg$t_inf[is_bolus_or_oral(reg)] <- 0
+    reg$rate[is_bolus_or_oral(reg)] <- 0
   }
+  
   if(!is.null(cmt)) {
     if(length(cmt) != length(reg$dose_times)) {
       cmt <- rep(cmt[1], length(reg$dose_times))
@@ -160,3 +160,17 @@ new_regimen <- function(
   }
   return(reg)
 }
+
+#' Is regimen type oral or bolus? (i.e., treat t_inf as zero)
+#' 
+#' Any regimen matching exactly the string 'bolus' or containing the string 
+#' 'oral' will return `TRUE`, otherwise `FALSE`. Bolus/oral regimens are 
+#' generally treated as having an infusion duration of zero.
+#' 
+#' @param regimen object of class "regimen"`
+#' @returns Returns a logical vector of length equal to the number of doses in 
+#'   the regimen
+
+is_bolus_or_oral <- function(regimen) {
+   regimen$type == "bolus" | grepl("oral", regimen$type)
+}

man/is_bolus_or_oral.Rd

@@ -121,3 +121,17 @@ test_that("t_inf imputed correctly", {
   expect_equal(reg5$t_inf, c(2/60, 2.5, 3/60, 1))
 })
 
+test_that("regimens of type bolus/oral are recognized as such", {
+  expect_equal(
+    is_bolus_or_oral(
+      new_regimen(interval = 24, type = c("oral_x", "infusion", "sc"))
+    ),
+    c(TRUE, FALSE, FALSE)
+  )
+  expect_equal(
+    is_bolus_or_oral(
+      new_regimen(interval = 24, type = c("bolus_unknown", "infusion", "oral"))
+    ),
+    c(FALSE, FALSE, TRUE)
+  )
+})