RXR-1926 implement infusion duration scaling

NAMESPACE

@@ -14,6 +14,7 @@ export(advan)
 export(advan_create_data)
 export(advan_parse_output)
 export(advan_process_infusion_doses)
+export(apply_duration_scale)
 export(apply_lagtime)
 export(calc_auc_analytic)
 export(calc_ss_analytic)

R/apply_duration_scale.R

@@ -0,0 +1,56 @@
+#' Apply infusion duration scale to a regimen
+#'
+#' E.g. see Centanni et al. Clin Pharmacokinet 2024. An estimated scaling factor
+#' for the length of the infusion was applied there in a model for vincristine.
+#' This is likely most relevant for very short infusions.
+#'
+#' Implementation is similar to handling of `lagtime`, i.e. the regimen that is the
+#' input for the simulation function is updated.
+#'
+#' @param regimen PKPDsim regimen
+#' @param duration_scale infusion length scale.
+#' @param parameters parameter list, required if the duration scale is
+#' specified as a parameter.
+#' @param cmt_mapping map of administration types to compartments, e.g.
+#' `list("oral" = 1, "infusion" = 2, "bolus" = 2)`.
+#'
+#' @export
+#'
+#' @return Original regimen with infusion lengths scaled by a factor
+#'
+apply_duration_scale <- function(
+  regimen,
+  duration_scale = NULL,
+  parameters = NULL,
+  cmt_mapping = NULL
+) {
+  if(is.null(regimen$t_inf) || all(regimen$t_inf == 0)) {
+    warning("`duration_scale` is only relevant for infusion regimens with an infusion length > 0.")
+    return(regimen)
+  }
+  if(!is.null(duration_scale)) {
+    if(class(duration_scale) %in% c("numeric", "integer")) {
+      if(length(duration_scale) == 1) {
+        regimen$t_inf <- regimen$t_inf * duration_scale
+      } else {
+        regimen$t_inf <- regimen$t_inf * duration_scale[regimen$cmt]
+      }
+    } else if(class(duration_scale) %in% c("character")) {
+      if(is.null(regimen$cmt)) {
+        if(!is.null(cmt_mapping)) {
+          regimen$cmt <- as.numeric(cmt_mapping[regimen$type])
+        } else {
+          regimen$cmt <- rep(1, length(regimen$dose_times))
+        }
+      }
+      if(length(duration_scale) == 1) {
+        regimen$t_inf <- regimen$t_inf * parameters[[duration_scale]]
+      } else {
+        regimen$t_inf <- regimen$t_inf * as.numeric(unlist(parameters[duration_scale[regimen$cmt]]))
+      }
+    }
+  } else {
+    warning("Please specify `duration_scale` to apply to regimen.")
+  }
+  return(regimen)
+}

R/new_ode_model.R

@@ -371,6 +371,7 @@ new_ode_model <- function (model = NULL,
                        "\\[COVS\\]", covs,
                        "\\[FIXED\\]", fixed,
                        "\\[LAGTIME\\]", lagtime,
+                       "\\[DURATION_SCALE\\]", deparse(dose$duration_scale),
                        "\\[USE_IOV\\]", as.character(use_iov),
                        "\\[IOV\\]", PKPDsim::print_list(iov, FALSE),
                        "\\[DEVELOPMENT\\]", print_list(development, FALSE),

R/sim.R

@@ -148,6 +148,14 @@ sim <- function (ode = NULL,
   if(!is.null(lagtime)) {
     regimen <- apply_lagtime(regimen, lagtime, parameters, attr(ode, "cmt_mapping"))
   }
+  if(!is.null(attr(ode, "dose")$duration_scale)) {
+    regimen <- apply_duration_scale(
+      regimen,
+      attr(ode, "dose")$duration_scale,
+      parameters,
+      attr(ode, "cmt_mapping")
+    )
+  }
   if(t_init != 0) regimen$dose_times <- regimen$dose_times + t_init
   p <- as.list(parameters)
   if(!is.null(t_obs)) {

inst/template/R/model.R

@@ -4,7 +4,12 @@ model <- function(mod = NULL) {
   attr(ret, "cpp") <- TRUE
   attr(ret, "size") <- [N_COMP]
   attr(ret, "obs") <- list("cmt" = [OBS_COMP], "scale" = "[OBS_SCALE]", "variable" = [OBS_VARIABLE])
-  attr(ret, "dose") <- list("cmt" = [DOSE_COMP], "bioav" = [DOSE_BIOAV], "duplicate" = [DOSE_DUPLICATE] )
+  attr(ret, "dose") <- list(
+    "cmt" = [DOSE_COMP], 
+    "bioav" = [DOSE_BIOAV], 
+    "duplicate" = [DOSE_DUPLICATE],
+    "duration_scale" = [DURATION_SCALE]
+  )
   attr(ret, "code") <- "[CODE]"
   attr(ret, "pk_code") <- "[PK_CODE]"
   attr(ret, "state_init") <- [STATE_INIT]

tests/testthat/test_apply_duration_scale.R

@@ -0,0 +1,104 @@
+reg_oral <- new_regimen(
+  amt = 1000,
+  n = 12,
+  interval = 12,
+  type = "oral"
+)
+reg_iv <- new_regimen(
+  amt = 1000,
+  n = 12,
+  interval = 12,
+  type = "infusion",
+  t_inf = 1,
+  cmt = c(1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2)
+)
+
+reg_combo <- new_regimen(
+  amt = 1000,
+  n = 4,
+  interval = 12,
+  type = c("drug1", "drug2", "oral", "oral"),
+  cmt = c(2, 3, 1, 1),
+  t_inf = c(1, 1, 0, 0)
+)
+
+## null / error checks
+test_that("infusion length NULL warning", {
+  expect_warning(
+    dur0 <- apply_duration_scale(
+      regimen = reg_oral
+    )
+  )
+  expect_equal(dur0, reg_oral)
+})
+test_that("duration scale NULL warning", {
+  expect_warning(
+    dur1 <- apply_duration_scale(
+      regimen = reg_iv
+    )
+  )
+  expect_equal(dur1, reg_iv)
+})
+
+## Check functionality
+test_that("infusion length scaled", {
+  dur2 <- apply_duration_scale(
+    regimen = reg_iv,
+    duration_scale = 1.5
+  )
+  expect_equal(dur2$t_inf, rep(1.5, 12))
+})
+
+test_that("infusion length scaled using vector", {
+  dur3 <- apply_duration_scale(
+    regimen = reg_iv,
+    duration_scale = c(1.5, 1.0) # scale oral "infusions", but not "iv"
+  )
+  expect_equal(dur3$t_inf, rep(c(1.5, 1.0), 6))
+})
+
+test_that("infusion length scaled using parameter", {
+  dur4 <- apply_duration_scale(
+    regimen = reg_iv,
+    duration_scale = "SCALE",
+    parameters = list(CL = 5, V = 50, SCALE = 1.6)
+  )
+  expect_equal(dur4$t_inf, rep(1.6, 12))
+})
+
+test_that("infusion length scaled, multiple cmts", {
+  dur4 <- apply_duration_scale(
+    regimen = reg_combo,
+    duration_scale = c(1, 1.5, 2)
+  )
+  expect_equal(dur4$t_inf, c(1.5, 2, 0, 0))
+})
+
+test_that("infusion length scaled, multiple cmts, no cmt", {
+  reg_combo$cmt <- NULL
+  dur5 <- apply_duration_scale(
+    regimen = reg_combo,
+    duration_scale = "SCALE",
+    parameters = list(CL = 5, V = 50, SCALE = 1.6),
+    cmt_mapping = c("drug1" = 2, "drug2" = 3, "oral" = 1)
+  )
+  dur6 <- apply_duration_scale(
+    regimen = reg_combo,
+    duration_scale = c("SCALE1", "SCALE2", "SCALE3"),
+    parameters = list(CL = 5, V = 50, SCALE1 = 1.6, SCALE2 = 1.7, SCALE3 = 1.8),
+    cmt_mapping = c("drug1" = 2, "drug2" = 3, "oral" = 1)
+  )
+  expect_equal(dur5$t_inf, c(1.6, 1.6, 0, 0))
+  expect_equal(dur6$t_inf, c(1.7, 1.8, 0, 0))
+})
+
+test_that("infusion length scaled, no cmt, no cmt_mapping", {
+  reg_combo$cmt <- NULL
+  dur7 <- apply_duration_scale(
+    regimen = reg_combo,
+    duration_scale = c("SCALE1", "SCALE2", "SCALE3"),
+    parameters = list(CL = 5, V = 50, SCALE1 = 1.6, SCALE2 = 1.7, SCALE3 = 1.8),
+    cmt_mapping = NULL
+  )
+  expect_equal(dur7$t_inf, c(1.6, 1.6, 0, 0))
+})

tests/testthat/test_timevar_cov.R

@@ -16,7 +16,7 @@ mod <- new_ode_model(
   pk_code = "CLi = CL + CRCL",
   obs = list(cmt = 2, scale = "V"),
   covariates = list(CRCL = new_covariate(5)), declare_variables = "CLi",
-  cpp = TRUE
+  cpp = FALSE
 )
 
 test_that("timevarying covariates handled", {
@@ -103,7 +103,7 @@ test_that("timevarying covariates are interpolated and affect PK", {
   ## Check interpolated covariates actually affect simulated conc
   expect_equal(
     round(sim2_inter$y, 3)[1:10],
-    c(0, 0.32, 0.611, 0.788, 1.205, 1.531, 1.708, 2.098, 2.379, 2.503),
+    c(0, 0.32, 0.611, 0.788, 1.205, 1.531, 1.708, 2.098, 2.379, 2.503)
   )
   expect_equal(
     round(sim2_locf$y, 3)[1:10],