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,47 @@
+#' 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.
+#'
+#' @export
+#'
+#' @return Original regimen with infusion lengths scaled by a factor
+#'
+apply_duration_scale <- function(
+  regimen,
+  duration_scale = NULL,
+  parameters = 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(length(duration_scale) == 1) {
+        regimen$t_inf <- regimen$t_inf * parameters[[duration_scale]]
+      } else {
+        par_tmp <- parameters
+        regimen$t_inf <- regimen$t_inf + as.numeric(unlist(par_tmp[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,49 @@
+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
+)
+
+## 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 parameter", {
+  dur3 <- apply_duration_scale(
+    regimen = reg_iv,
+    duration_scale = "SCALE",
+    parameters = list(CL = 5, V = 50, SCALE = 1.6)
+  )
+  expect_equal(dur3$t_inf, rep(1.6, 12))
+})