Add compartments cmt to regimens in nm_to_regimen

DESCRIPTION

@@ -30,7 +30,7 @@ URL: https://github.com/InsightRX/PKPDsim,
 Language: en-US
 LazyData: TRUE
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3
 Config/testthat/edition: 3
 Config/Needs/website: tidyverse, nlmixr2
 Encoding: UTF-8

R/nm_to_regimen.R

@@ -4,11 +4,15 @@
 #' @param data NONMEM-type dataset
 #' @param reset_time start time for each simulated patient at 0, irrespective of design in dataset
 #' @param first_only use only design from first individual in dataset
+#' @param dose_cmts map from compartment number to dose type, defaults to compartment 1 being an infusion dose
 #' @export
 #' @return Regimen object
-nm_to_regimen <- function(data,
-                          reset_time = TRUE,
-                          first_only = FALSE) {
+nm_to_regimen <- function(
+  data,
+  reset_time = TRUE,
+  first_only = FALSE,
+  dose_cmts = NULL
+) {
   colnames(data) <- tolower(colnames(data))
   if(!"evid" %in% colnames(data)) {
     stop("EVID column is required in source dataset!")
@@ -19,29 +23,44 @@ nm_to_regimen <- function(data,
   if(! "time" %in% colnames(data)) {
     stop("TIME column is required in source dataset!")
   }
-  m <- match(c("id", "mdv", "evid", "amt", "time", "rate"), colnames(data), 0)
+  m <- match(c("id", "mdv", "evid", "amt", "time", "rate", "cmt"), colnames(data), 0)
   m <- m[m>0]
   data <- data[,m]
   doses <- data[data$evid == 1,]
-  dum <- data[data$evid == 2,]
   ids <- unique(doses$id)
   if(first_only) {
     ids <- ids[1]
   }
-  type <- "bolus"
-  if("rate" %in% colnames(doses) &! 0 %in% doses$rate) {
-    type <- "infusion"
-  }
   reg <- list()
   for(i in 1:length(ids)) {
     tmp <- doses[doses$id == ids[i],]
     if(reset_time) {
       tmp$time <- tmp$time - min(tmp$time)
     }
-    if(type == "infusion") {
-      reg[[i]] <- new_regimen(amt = tmp$amt, times = tmp$time, type = "infusion", t_inf = tmp$amt / tmp$rate)
+    if (!is.null(dose_cmts)){
+      # map cmt to dose type
+      reg[[i]] <- new_regimen(
+        amt = tmp$amt,
+        times = tmp$time,
+        cmt = tmp$cmt,
+        type = unname(unlist(dose_cmts[as.character(tmp$cmt)])),
+        t_inf = ifelse(is.na(tmp$rate), NA, tmp$amt / tmp$rate)
+      )
+    } else if ("rate" %in% colnames(doses) &! 0 %in% doses$rate){
+      # if rate exists and is non-zero, assume infusion
+      reg[[i]] <- new_regimen(
+        amt = tmp$amt, 
+        times = tmp$time,
+        type = "infusion",
+        t_inf = tmp$amt / tmp$rate
+      )
     } else {
-      reg[[i]] <- new_regimen(amt = tmp$amt, times = tmp$time, type = "bolus")
+      # assume bolus
+      reg[[i]] <- new_regimen(
+        amt = tmp$amt, 
+        times = tmp$time,
+         type = "bolus"
+      )
     }
   }
   if(length(ids) == 1) {

tests/testthat/test_nm_to_regimen.R

@@ -21,7 +21,7 @@ test_that("Required column checks occur", {
   )
 })
 
-test_that("NM-style dataframe for 1 ID converted to regimen", {
+test_that("Assume infusion if no compartment but RATE given", {
   pt1 <- data.frame(
     ID = 1,
     EVID = c(1, 1, 0, 1, 1, 0),
@@ -38,15 +38,31 @@ test_that("NM-style dataframe for 1 ID converted to regimen", {
   expect_equal(reg1$type, rep("infusion", 4))
 })
 
+test_that("Assume bolus if no compartment and no RATE given", {
+  pt1 <- data.frame(
+    ID = 1,
+    EVID = c(1, 1, 0, 1, 1, 0),
+    AMT = c(100, 100, 0, 200, 200, 0),
+    TIME = c(0, 12, 23, 25, 36, 47),
+    DV = c(0, 0, 5, 0, 0, 12)
+  )
+  reg1 <- nm_to_regimen(pt1)
+  expect_true(inherits(reg1, "regimen"))
+  expect_equal(reg1$dose_amts, c(100, 100, 200, 200))
+  expect_equal(reg1$dose_times, c(0, 12, 25, 36))
+  expect_equal(reg1$type, rep("bolus", 4))
+})
+
 test_that("Bolus/oral doses handled", {
   pt2 <- data.frame(
     ID = 1,
     EVID = c(1, 1, 0, 1, 1, 0),
+    CMT = 1,
     AMT = c(100, 100, 0, 200, 200, 0),
     TIME = c(0, 12, 23, 25, 36, 47),
     DV = c(0, 0, 5, 0, 0, 12)
   )
-  reg2 <- nm_to_regimen(pt2)
+  reg2 <- nm_to_regimen(pt2, dose_cmts = c("1" = "bolus"))
   expect_true(inherits(reg2, "regimen"))
   expect_equal(reg2$dose_amts, c(100, 100, 200, 200))
   expect_equal(reg2$dose_times, c(0, 12, 25, 36))
@@ -58,6 +74,7 @@ test_that("Multiple regimens from NONMEM-style dataset", {
   nm <- data.frame(
     ID = c(1, 1, 1, 2, 2, 2),
     EVID = c(1, 1, 0, 1, 1, 0),
+    CMT = 1,
     AMT = c(100, 100, 0, 200, 200, 0),
     TIME = c(0, 12, 23, 0, 24, 47),
     DV = c(0, 0, 5, 0, 0, 12)
@@ -71,3 +88,25 @@ test_that("Multiple regimens from NONMEM-style dataset", {
   expect_equal(multi_regs[[1]]$dose_amts, c(100, 100))
   expect_equal(multi_regs[[2]]$dose_amts, c(200, 200))
 })
+
+test_that("Doses in different compartments handled", {
+  pt2 <- data.frame(
+    ID = 1,
+    EVID = c(1, 1, 0, 1, 1, 0, 1, 1, 0),
+    CMT = c(2, 2, 2, 2, 2, 2, 1, 1, 2), # last two doses are oral
+    AMT = c(100, 100, 0, 200, 200, 0, 150, 150, 0),
+    TIME = c(0, 12, 23, 25, 36, 47, 48, 60, 71),
+    RATE = c(100, 100, 0, 200, 400, 0, 0, 0, 0),
+    DV = c(0, 0, 5, 0, 0, 12, 0, 0, 14)
+  )
+  cmt_mapping <- c(
+    "1" = "oral",
+    "2" = "infusion"
+  )
+  reg2 <- nm_to_regimen(pt2, dose_cmts = cmt_mapping)
+  expect_true(inherits(reg2, "regimen"))
+  expect_equal(reg2$dose_amts, c(100, 100, 200, 200, 150, 150))
+  expect_equal(reg2$dose_times, c(0, 12, 25, 36, 48, 60))
+  expect_equal(reg2$t_inf, c(1, 1, 1, 0.5, 0, 0))
+  expect_equal(reg2$type, c(rep("infusion", 4), rep("oral", 2)))
+})