R/xposeNlmeModel.R

In Certara.Xpose.NLME: Enhances 'xpose' Diagnostics for Pharmacometric Models from 'Certara.RsNLME' and Phoenix NLME

#' @title Creates xpose database from Certara.RsNLME objects
#'
#' @description Imports results of an NLME run into xpose database
#' Use to import NLME model object and NLME object output
#' into \code{xpdb} object that is compatible
#' with existing model diagnostic function in \code{Xpose} package.
#'
#' @param model NlmePmlModel model class object generated by \code{Certara.RsNLME}
#' package
#'
#' @param fitmodelOutput the output object of \code{Certara.RsNLME::fitmodel()} run.
#'
#' @inherit xposeNlme details
#'
#' @inherit xposeNlme return
#'
#' @examples
#' \donttest{
#' library(Certara.RsNLME)
#' library(Certara.Xpose.NLME)
#'
#' model <- pkmodel(
#'   parameterization = "Clearance",
#'   numCompartments = 2,
#'   data = pkData,
#'   ID = "Subject",
#'   Time = "Act_Time",
#'   A1 = "Amount",
#'   CObs = "Conc"
#' )
#'
#' fit <- fitmodel(model)
#'
#' xp <- xposeNlmeModel(
#'   model = model,
#'   fitmodelOutput = fit
#' )
#'}
#' @return \code{xpdb} object
#' @export
xposeNlmeModel <-
  function(model,
           fitmodelOutput) {
    stopifnot(inherits(model, "NlmePmlModel"))
    stopifnot(inherits(fitmodelOutput, "list"))

    expectedParts <- c("dmp.txt",
                       "residuals",
                       "nlme7engine.log",
                       "ConvergenceData")
    argsPresence <-
      match(names(fitmodelOutput), expectedParts)
    if (sum(argsPresence, na.rm = TRUE) != 10) {
      argsPresented <- expectedParts[na.omit(argsPresence)]
      argsNotPresented <- expectedParts[!expectedParts %in% argsPresented]
      stop("Please check fitmodeloutput object. ",
           "Not all required list elements are presented: ",
           paste(argsNotPresented, collapse = ", "))
    }

    Units <- attr(model@inputData, "Units")
    InputWithUnitsList <- list(input = tibble::as_tibble(model@inputData),
                       unitsPresent = !is.null(Units),
                       optionalUnits = Units)
    listInput <- create_input(InputWithUnitsList,
                              fitmodelOutput$dmp.txt$cols1.txt)

    # get rid of Scenario
    residuals <- tibble::as_tibble(fitmodelOutput$residuals)
    residuals$Scenario <- NULL
    posthoc <- tibble::as_tibble(fitmodelOutput$posthoc)
    posthoc$Scenario <- NULL
    # adding back huge parts
    dmp.txt <- fitmodelOutput$dmp.txt
    dmp.txt$residuals <- residuals
    dmp.txt$posthoc <- posthoc

    xp <-
      create_xposeNlme(
        modelName = model@modelInfo@modelName,
        dmp.txt = dmp.txt,
        listInput = listInput,
        nlme7engineLines = fitmodelOutput$nlme7engine.log,
        ConvergenceData = fitmodelOutput$ConvergenceData,
        dir = model@modelInfo@workingDir,
        Sort = NULL
      )

    xp
  }