R/et.R

In posologyr: Individual Dose Optimization using Population Pharmacokinetics

#-------------------------------------------------------------------------
# posologyr: individual dose optimization using population PK
# Copyright (C) Cyril Leven
#
#  This program is free software: you can redistribute it and/or modify
#  it under the terms of the GNU Affero General Public License as
#  published by the Free Software Foundation, either version 3 of the
#  License, or (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU Affero General Public License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this program. If not, see <https://www.gnu.org/licenses/>.
#-------------------------------------------------------------------------


#' Update a model with events from a new rxode2 event table
#'
#' Update a model with events from a new rxode2 event table, while accounting
#' for and interpolating any covariates or inter-occasion variability.
#'
#' @param target_model Solved rxode2 object. A model generated by one of
#'    posologyr's estimation functions.
#' @param prior_model A \code{posologyr} prior population model.
#' @param event_table An rxode2 event table.
#' @param interpolation Character string. Specifies the interpolation method to
#'    be used for covariates. Choices are "locf" for last observation carried
#'    forward, "nocb" for next observation carried backward, "midpoint", or
#'    "linear".
#'
#' @return A solved rxode2 object, updated with the event table provided.
#'
#' @examples
#' # model
#' mod_run001 <- function() {
#'   ini({
#'     THETA_Cl <- 4.0
#'     THETA_Vc <- 70.0
#'     THETA_Ka <- 1.0
#'     ETA_Cl ~ 0.2
#'     ETA_Vc ~ 0.2
#'     ETA_Ka ~ 0.2
#'     prop.sd <- sqrt(0.05)
#'   })
#'   model({
#'     TVCl <- THETA_Cl
#'     TVVc <- THETA_Vc
#'     TVKa <- THETA_Ka
#'
#'     Cl <- TVCl*exp(ETA_Cl)
#'     Vc <- TVVc*exp(ETA_Vc)
#'     Ka <- TVKa*exp(ETA_Ka)
#'
#'     K20 <- Cl/Vc
#'     Cc <- centr/Vc
#'
#'     d/dt(depot) = -Ka*depot
#'     d/dt(centr) = Ka*depot - K20*centr
#'     Cc ~ prop(prop.sd)
#'   })
#' }
#' # df_patient01: event table for Patient01, following a 30 minutes intravenous
#' # infusion
#' df_patient01 <- data.frame(ID=1,
#'                         TIME=c(0.0,1.0,14.0),
#'                         DV=c(NA,25.0,5.5),
#'                         AMT=c(2000,0,0),
#'                         EVID=c(1,0,0),
#'                         DUR=c(0.5,NA,NA))
#' # estimate the prior distribution of population parameters
#' pop_model <- poso_simu_pop(dat=df_patient01,prior_model=mod_run001,n_simul=100)
#' # create a new rxode2 event table from the initial dataset
#' new_et <- rxode2::as.et(df_patient01)
#' new_et$add_sampling(seq(14,15,by=0.1))
#' # update the model with the new event table
#' poso_replace_et(pop_model$model,mod_run001,event_table=new_et)
#'
#' @export
poso_replace_et <- function(target_model=NULL,prior_model=NULL,
                            event_table=NULL,interpolation="locf"){
  # input validation
  if (is.null(target_model)) stop("argument 'target_model' is missing, with no default")
  if (is.null(prior_model)) stop("argument 'prior_model' is missing, with no default")
  if (is.null(event_table)) stop("argument 'event_table' is missing, with no default")
  prior_model <- get_prior_model(prior_model)
  validate_priormod(prior_model)

  yes_covariates  <- !is.null(prior_model$covariates)
  estim_with_iov <- ifelse(is.null(prior_model$pi_matrix),FALSE,TRUE)

  # translate the interpolation method for approxfun
  if(interpolation == "nocb" | interpolation == "locf" | interpolation == "midpoint"){
    interpolation <- "constant"
  } else if (interpolation != "linear") {
    stop(paste(interpolation,"is not a valid value for 'interpolation'. Choices
               are 'locf', 'nocb', 'midpoint' or 'linear'."))
  }
  # for approxfun, compromise between left- and right-continuous step functions
  if(interpolation == "nocb"){
    left_right_step <- 1
  } else if (interpolation == "midpoint"){
    left_right_step <- 0.5
  } else {
    left_right_step <- 0
  }

  if(estim_with_iov){
    pimat         <- prior_model$pi_matrix
    iov_kappa     <- attr(pimat,"dimnames")[[1]]
    iov_kappa_mat <- sapply(iov_kappa,FUN=extrapol_iov,dat=target_model,
                            iov_kappa=iov_kappa,
                            event_table=event_table)

    event_table <- cbind(event_table,iov_kappa_mat)
  }
  if(yes_covariates){
    covar_mat <- sapply(prior_model$covariates,FUN=extrapol_cov,dat=target_model,
                        covar=prior_model$covariates,
                        interpol_approx=interpolation,
                        f=left_right_step,
                        event_table=event_table)

    event_table <- cbind(event_table,covar_mat)
  }
  updated_model <- rxode2::rxSolve(target_model,event_table,target_model$params)
  return(updated_model)
}