Merge pull request #8 from InsightRX/add_trough_exposure_temporary

Add LLOQ to sampling design and add trough as exposure metric

DESCRIPTION

@@ -12,7 +12,7 @@ Description: Functions for simulating dose adjustments given PKPD models,
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Suggests: 
     dplyr,
     ggplot2,

NAMESPACE

@@ -2,6 +2,7 @@
 
 export(calc_auc_from_regimen)
 export(calc_auc_from_sim)
+export(calc_concentration_from_regimen)
 export(collect_tdms)
 export(create_cov_object)
 export(create_regimen_update_design)

R/create_sampling_design.R

@@ -12,6 +12,7 @@
 #' sample, use the `offset` parameter to sample e.g. an hour post-peak, or
 #' shortly before true troughs.
 #'
+#' @param lloq lower limit of quantification for TDMs
 #' @inheritParams create_design
 #'
 #' @examples
@@ -46,17 +47,22 @@ create_sampling_design <- function(
     offset = NULL,
     scatter = NULL,
     at = NULL,
+    lloq = 0,
     anchor = c("dose", "day")
 ) {
   if(is.null(time)) {
     if(is.null(when)) when <- "dose"
   }
-  create_design(
+  scheme <- create_design(
     time = time,
     when = when,
     offset = offset,
     scatter = scatter,
     at = at,
     anchor = anchor
   )
+  list(
+    lloq = lloq,
+    scheme = scheme
+  )
 }

R/exposure_metrics.R

@@ -1,10 +1,24 @@
+#' Calculate exposure metrics
+#'
+#' Calculates drug concentration or area under the curve (AUC) for a MIPD
+#' trial run.
+#'
+#' This family of functions calculates the exposure metric for a given regimen,
+#' model, model parameters, and target design. Supply the final regimen and the
+#' final parameter estimates to get the final estimated exposure metric. Supply
+#' the final regimen and the true individual parameter estimates to get the
+#' final true exposure metric.
+#'
+#' @name exposure_metrics
+NULL
+
 #' Get AUC from a simulation
 #'
 #' @param sim_output output of a `PKPDsim::sim` call
 #' @param auc_comp auc compartment
-#' @returns numeric vector of AUCs between each simulated time point. Control
-#'   time period over which AUC should be calculated using `target_time`
-#'   argument to `PKPDsim::sim`.
+#' @returns `calc_auc_from_sim` returns a numeric vector of AUCs between each
+#'   simulated time point. Control time period over which AUC should be
+#'   calculated using `target_time` argument to `PKPDsim::sim`.
 #' @export
 
 calc_auc_from_sim <- function(sim_output, auc_comp) {
@@ -16,23 +30,61 @@ calc_auc_from_sim <- function(sim_output, auc_comp) {
   }
 }
 
-#' Get AUC from a regimen
-#'
-#' Supply the final regimen and the final parameter estimates to get the final
-#' estimated AUC. Supply the final regimen and the true individual parameter
-#' estimates to get the final true AUC.
+#' Get concentration from a regimen
 #'
 #' @param regimen PKPDsim regimen object
-#' @param parameters use MAP estimation to get estimated AUC, use true patient
-#'   parameters to get true AUC. Parameters must correspond to the model used.
-#'   Accepts parameters supplied as a data frame row, a named vector or as a
-#'   list.
-#' @param model model to use for AUC calculations.
+#' @param parameters use MAP estimation to get estimated exposure, use true
+#'   patient parameters to get true exposure. Parameters must correspond to the
+#'   model used. Accepts parameters supplied as a data frame row, a named vector
+#'   or as a list.
+#' @param model model to use for exposure calculations.
 #' @param target_design target design, created using `create_target_design()`
 #' @param ... arguments passed on to PKPDsim::sim. Typical arguments include
 #'   `covariates` or `iov_bins`
-#' @returns numeric vector of AUCs between each simulated time point. Control
-#'   time period over which AUC should be calculated using `target_time`.
+#' @returns `calc_concentration_from_regimen` returns a numeric vector of
+#' concentrations between each simulated time point. Control when concentration
+#' is estimated using `target_time`.
+#' @rdname exposure_metrics
+#' @export
+calc_concentration_from_regimen <- function(
+    regimen,
+    parameters,
+    model,
+    target_design,
+    ...
+){
+  if (!all(attr(model, "parameters") %in% names(parameters))) {
+    stop("Model/parameter mismatch")
+  }
+  if (inherits(parameters, "data.frame") || is.atomic(parameters)) {
+    parameters <- as.list(parameters)
+  }
+
+  iov <- PKPDsim::get_model_iov(model)
+  if (is.null(iov[["bins"]])) iov[["bins"]] <- c(0, 9999)
+
+  target_time <- get_sampling_times_from_scheme(
+    target_design$scheme,
+    regimen
+  )
+  sim_output <- PKPDsim::sim(
+    model,
+    parameters = parameters,
+    regimen = regimen,
+    t_obs = target_time,
+    iov_bins = iov[["bins"]],
+    ...
+  )
+  sim_output[sim_output$comp == "obs",]$y
+}
+
+#' Get AUC from a regimen
+#'
+#' @returns `calc_auc_from_regimen` returns a numeric vector of AUCs between
+#'   each simulated time point. Control time period over which AUC should be
+#'   calculated using `target_time`.
+#'
+#' @rdname exposure_metrics
 #' @export
 
 calc_auc_from_regimen <- function(

R/sample_and_adjust.R

@@ -54,7 +54,7 @@ sample_and_adjust_by_dose <- function(
 
   adjust_at_dose <- get_dose_update_numbers_from_design(regimen_update_design, regimen)
   first_adjust_time <- regimen$dose_times[adjust_at_dose[1]]
-  tdm_times <- get_sampling_times_from_scheme(sampling_design, regimen)
+  tdm_times <- get_sampling_times_from_scheme(sampling_design$scheme, regimen)
   if (!any(tdm_times < first_adjust_time)) {
     stop("At least one TDM must be collected before dose adjustment")
   }
@@ -87,7 +87,7 @@ sample_and_adjust_by_dose <- function(
     if(verbose) message("Adjustment of dose# ", adjust_at_dose[j])
     # collect TDMs from today (use model for simulation!)
     adjust_time <- regimen$dose_times[adjust_at_dose[j]]
-    tdm_times <- get_sampling_times_from_scheme(sampling_design, regimen)
+    tdm_times <- get_sampling_times_from_scheme(sampling_design$scheme, regimen)
     collect_idx <- (tdm_times >= last_adjust_time & tdm_times < adjust_time)
     if(!any(collect_idx)) {
       stop("No new samples in current adjustment interval, check target and sampling settings.")
@@ -102,7 +102,8 @@ sample_and_adjust_by_dose <- function(
       res_var = ruv_i[collect_idx,],
       pars_i = pars_true_i,
       regimen = regimen,
-      covariates = covariates
+      covariates = covariates,
+      lloq = sampling_design$lloq
     )
     auc_current_regimen <- calc_auc_from_regimen(
       regimen = regimen,
@@ -111,6 +112,13 @@ sample_and_adjust_by_dose <- function(
       target_design = target_design,
       covariates = covariates
     )
+    trough_current_regimen <- calc_concentration_from_regimen(
+      regimen = regimen,
+      parameters = pars_true_i, # true patient parameters
+      model = sim_model,
+      target_design = target_design,
+      covariates = covariates
+    )
     if(verbose) {
       message("TDMs: ", paste(round(new_tdms$y, 1), collapse=", "))
     }
@@ -127,7 +135,8 @@ sample_and_adjust_by_dose <- function(
         t_adjust = regimen$dose_times[adjust_at_dose[j]],
         dose_before_update = regimen$dose_amts[adjust_at_dose[j]], # previous dose
         interval_before_update = regimen$interval, # previous interval
-        auc_before_update = auc_current_regimen
+        auc_before_update = auc_current_regimen,
+        trough_before_update = trough_current_regimen
       )
     )
 
@@ -166,6 +175,13 @@ sample_and_adjust_by_dose <- function(
     target_design = target_design,
     covariates = covariates
   )
+  trough_final <- calc_concentration_from_regimen(
+    regimen = regimen,
+    parameters = pars_true_i, # true patient parameters
+    model = sim_model,
+    target_design = target_design,
+    covariates = covariates
+  )
   dose_updates <- dplyr::bind_rows(
     dose_updates,
     data.frame(
@@ -174,7 +190,8 @@ sample_and_adjust_by_dose <- function(
       t_adjust = NA,
       dose_before_update = out$new_dose,
       interval_before_update = out$new_interval,
-      auc_before_update = auc_final
+      auc_before_update = auc_final,
+      trough_before_update = trough_final
     )
   )