Merge pull request #128 from InsightRX/RXR-2888

Add compartments cmt to regimens in nm_to_regimen

Author: dominic-irx

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

@@ -6,9 +6,11 @@
 #' @param first_only use only design from first individual in dataset
 #' @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
+) {
   colnames(data) <- tolower(colnames(data))
   if(!"evid" %in% colnames(data)) {
     stop("EVID column is required in source dataset!")
@@ -19,29 +21,60 @@ 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)
+  if (!"cmt" %in% colnames(data)) {
+    warning("CMT column is missing from source dataset!")
+  }
+  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)
+    # use CMT if it exists in input data
+    if (!is.null(tmp$cmt)){
+      # if RATE is given, use to calculate infusion time t_inf
+      if (!is.null(tmp$rate)){
+        suppressWarnings({
+          reg[[i]] <- new_regimen(
+            amt = tmp$amt,
+            times = tmp$time,
+            cmt = tmp$cmt,
+            t_inf = ifelse(tmp$rate == 0, 0, tmp$amt/tmp$rate)
+          )
+        })
+      } else {
+        # if no RATE is given, then assume bolus
+        suppressWarnings({
+          reg[[i]] <- new_regimen(
+            amt = tmp$amt,
+            times = tmp$time,
+            cmt = tmp$cmt
+          )
+        })
+      }
+    } 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

@@ -1,27 +1,21 @@
 test_that("Required column checks occur", {
   expect_error(
-    nm_to_regimen(
-      data.frame(EVID = 0, AMT = 100)
-    ),
+    nm_to_regimen(data.frame(EVID = 0, AMT = 100)),
     "TIME column is required"
   )
 
   expect_error(
-    nm_to_regimen(
-      data.frame(EVID = 0, TIME = 0)
-    ),
+    nm_to_regimen(data.frame(EVID = 0, TIME = 0)),
     "AMT column is required"
   )
 
   expect_error(
-    nm_to_regimen(
-      data.frame(AMT = 100, TIME = 0)
-    ),
+    nm_to_regimen(data.frame(AMT = 100, TIME = 0)),
     "EVID column is required"
   )
 })
 
-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,10 +32,26 @@ test_that("NM-style dataframe for 1 ID converted to regimen", {
   expect_equal(reg1$type, rep("infusion", 4))
 })
 
-test_that("Bolus/oral doses handled", {
+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("Assume bolus and no t_inf if RATE not given", {
   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)
@@ -52,12 +62,14 @@ test_that("Bolus/oral doses handled", {
   expect_equal(reg2$dose_times, c(0, 12, 25, 36))
   expect_equal(reg2$t_inf, rep(0, 4))
   expect_equal(reg2$type, rep("bolus", 4))
+  expect_equal(reg2$cmt, rep(1, 4))
 })
 
 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 = c(1, 1, 1, 1, 2, 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)
@@ -70,4 +82,42 @@ test_that("Multiple regimens from NONMEM-style dataset", {
   expect_equal(multi_regs[[2]]$dose_times, c(0, 24))
   expect_equal(multi_regs[[1]]$dose_amts, c(100, 100))
   expect_equal(multi_regs[[2]]$dose_amts, c(200, 200))
+  expect_equal(multi_regs[[1]]$cmt, c(1, 1))
+  expect_equal(multi_regs[[2]]$cmt, c(1, 2))
+})
+
+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)
+  )
+  reg2 <- nm_to_regimen(pt2)
+  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$cmt, c(2, 2, 2, 2, 1, 1))
+})
+
+test_that("Different rates handled correctly", {
+  pt2 <- data.frame(
+    ID = 1,
+    EVID = c(1, 1, 0),
+    CMT = 2, 
+    AMT = c(100, 200, 0),
+    TIME = c(0, 6, 23),
+    RATE = c(0, 100, 0),
+    DV = c(0, 0, 5)
+  )
+  reg2 <- nm_to_regimen(pt2)
+  expect_true(inherits(reg2, "regimen"))
+  expect_equal(reg2$dose_amts, c(100, 200))
+  expect_equal(reg2$dose_times, c(0, 6))
+  expect_equal(reg2$t_inf, c(0, 2))
+  expect_equal(reg2$cmt, c(2, 2))
 })