RcppExports.R

# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

#' Event translation for rxode2
#'
#' @param inData Data frame to translate
#'
#' @param obj Model to translate data
#'
#' @param addCmt Add compartment to data frame (default `FALSE`).
#'
#' @param dropUnits Boolean to drop the units (default `FALSE`).
#'
#' @param allTimeVar Treat all covariates as if they were time-varying
#'
#' @param keepDosingOnly keep the individuals who only have dosing records and any
#'   trailing dosing records after the last observation.
#'
#' @param combineDvid is a boolean indicating if rxode2 will use `DVID` on observation
#'     records to change the `cmt` value; Useful for multiple-endpoint nlmixr models.  By default
#'     this is determined by `option("rxode2.combine.dvid")` and if the option has not been set,
#'     this is `TRUE`. This typically does not affect rxode2 simulations.
#'
#' @param keep This is a named vector of items you want to keep in the final rxode2 dataset.
#'     For added rxode2 event records (if seen), last observation carried forward will be used.
#'
#' @inheritParams rxode2parse::etTransParse
#' 
#' @return Object for solving in rxode2
#'
#' @keywords internal
#'
#' @export
etTrans <- function(inData, obj, addCmt = FALSE, dropUnits = FALSE, allTimeVar = FALSE, keepDosingOnly = FALSE, combineDvid = NULL, keep = character(0), addlKeepsCov = FALSE, addlDropSs = TRUE, ssAtDoseTime = TRUE) {
    .Call(`_rxode2_etTrans`, inData, obj, addCmt, dropUnits, allTimeVar, keepDosingOnly, combineDvid, keep, addlKeepsCov, addlDropSs, ssAtDoseTime)
}

#' Expand grid internal function
#'
#' @param c1 character vector of items to be expanded
#' @param c2 second character vector of items to be expanded
#' @param type 0 for a typical data frame, 1 for symengine sensitivity expansion
#' @return data frame (when type = 0) or symengine string (when type=1)
#' @export
#' @keywords internal
rxExpandGrid_ <- function(c1, c2, type) {
    .Call(`_rxode2_rxExpandGrid_`, c1, c2, type)
}

#' Expand sensitivity
#'
#' @param state is the state to expand
#' @param calcSens is the variables to calculate sensitivity
#' @keywords internal
#' @return symengine string for expanded sensitivity
#' @export
rxExpandSens_ <- function(state, calcSens) {
    .Call(`_rxode2_rxExpandSens_`, state, calcSens)
}

#' Expand second order sensitivity
#'
#' @param state is the state to expand
#' @param s1 is the variables to calculate sensitivity
#' @param s2 is the variables to calculate second order sensitivity
#' @keywords internal
#' @return string for symengine second order sensitivity
#' @export
rxExpandSens2_ <- function(state, s1, s2) {
    .Call(`_rxode2_rxExpandSens2_`, state, s1, s2)
}

#' Expand d(f)/d(eta)
#'
#' @param state is the state to expand
#' @param neta is the number of etas
#' @param pred type of prediction
#' @param isTheta logical, is the expansion actually for thetas instead of etas
#' @keywords internal
#' @return String of symengine expressions to evaluate to calculate df/deta
#' @export
rxExpandFEta_ <- function(state, neta, pred, isTheta = FALSE) {
    .Call(`_rxode2_rxExpandFEta_`, state, neta, pred, isTheta)
}

#' Rep R0 for foce
#'
#' @param neta ETA to substitute
#'
#' @return Returns a string of R code to substitute the rx_r expression in the symengine environment .s
#'
#' @keywords internal
#'
#' @export
rxRepR0_ <- function(neta) {
    .Call(`_rxode2_rxRepR0_`, neta)
}

rxExpandNesting <- function(obj, nestingInfo, compile = FALSE) {
    .Call(`_rxode2_rxExpandNesting`, obj, nestingInfo, compile)
}

#' Inductive linearization solver
#'
#' @param cSub = Current subject number
#' @param op - rxode2 solving options
#' @param tp - Prior time point/time zero
#' @param yp - Prior state;  vector size = neq; Final state is updated here
#' @param tf - Final Time
#' @param InfusionRate = Rates of each compartment;  vector size = neq
#' @param on Indicator for if the compartment is "on"
#' @param cache
#'    0 = no Cache
#'    When doIndLin == 0, cache > 0 = nInf-1
#' @param ME the rxode2 matrix exponential function
#' @param IndF The rxode2 Inductive Linearization function F
#' 
#' @return Returns a status for solving
#' 
#'   1 = Successful solve
#' 
#'   -1 = Maximum number of iterations reached when doing
#'        inductive linearization
#' @name rxIndLin_
NULL

rxIndLin_ <- function(states) {
    .Call(`_rxode2_rxIndLin_`, states)
}

#' Check the type of an object using Rcpp
#'
#' @param obj Object to check
#' @param cls Type of class.  Only s3 classes for lists/environments and primitive classes are checked.
#'    For matrix types they are distinguished as `numeric.matrix`, `integer.matrix`,
#'    `logical.matrix`, and `character.matrix` as well as the traditional `matrix`
#'    class. Additionally checks for `event.data.frame` which is an `data.frame` object
#'    with `time`,  `evid` and `amt`. (UPPER, lower or Title cases accepted)
#'
#' @return A boolean indicating if the object is a member of the class.
#'
#' @keywords internal
#'
#' @author Matthew L. Fidler
#'
#' @export
#'
rxIs <- function(obj, cls) {
    .Call(`_rxode2_rxIs`, obj, cls)
}

getRxFn <- function(name) {
    .Call(`_rxode2_getRxFn`, name)
}

dynLoad <- function(dll) {
    .Call(`_rxode2_dynLoad`, dll)
}

rxModelVars_ <- function(obj) {
    .Call(`_rxode2_rxModelVars_`, obj)
}

#' State variables
#'
#' This returns the model's compartments or states.
#'
#' @inheritParams rxModelVars
#'
#' @param state is a string indicating the state or compartment that
#'     you would like to lookup.
#'
#' @return If state is missing, return a character vector of all the states.
#'
#' If state is a string, return the compartment number of the named state.
#'
#' @seealso [rxode2()]
#' @family Query model information
#' @author Matthew L.Fidler
#' @export
rxState <- function(obj = NULL, state = NULL) {
    .Call(`_rxode2_rxState`, obj, state)
}

rxParams_ <- function(obj) {
    .Call(`_rxode2_rxParams_`, obj)
}

#' Jacobian and parameter derivatives
#'
#' Return Jacobain and parameter derivatives
#'
#' @inheritParams rxModelVars
#'
#' @return A list of the jacobian parameters defined in this rxode2
#'     object.
#'
#' @author Matthew L. Fidler
#'
#' @family Query model information
#' @export
rxDfdy <- function(obj) {
    .Call(`_rxode2_rxDfdy`, obj)
}

#' Left handed Variables
#'
#' This returns the model calculated variables
#'
#' @inheritParams rxModelVars
#'
#' @return a character vector listing the calculated parameters
#' @seealso \code{\link{rxode2}}
#' @family Query model information
#' @author Matthew L.Fidler
#' @export
rxLhs <- function(obj) {
    .Call(`_rxode2_rxLhs`, obj)
}

#' Initial Values and State values for a rxode2 object
#'
#' Returns the initial values of the rxDll object
#'
#' @param obj rxDll, rxode2, or named vector representing default
#'     initial arguments
#'
#' @param vec If supplied, named vector for the model.
#'
#' @param req Required names, and the required order for the ODE solver
#'
#' @param defaultValue a number or NA representing the default value for
#'     parameters missing in `vec`, but required in `req`.
#'
#' @param noerror is a boolean specifying if an error should be thrown
#'     for missing parameter values when `default` = `NA`
#'
#' @return Initial values of the rxDll object
#'
#' @keywords internal
#' @family Query model information
#' @author Matthew L.Fidler
#' @export
rxInits <- function(obj, vec = NULL, req = NULL, defaultValue = 0, noerror = FALSE, noini = FALSE, rxLines = FALSE) {
    .Call(`_rxode2_rxInits`, obj, vec, req, defaultValue, noerror, noini, rxLines)
}

#' Setup the initial conditions.
#'
#' @param obj rxode2 object
#' @param inits A numeric vector of initial conditions.
#' @return initial conditions that were setup
#' @author Matthew L. Fidler
#' @keywords internal
#' @export
rxSetupIni <- function(obj, inits = NULL) {
    .Call(`_rxode2_rxSetupIni`, obj, inits)
}

#' Setup the initial conditions.
#'
#' @param obj rxode2 object
#'
#' @param scale A numeric vector scales
#'
#' @param extraArgs A list of extra args to parse for initial conditions.
#'
#' @author Matthew L. Fidler
#'
#' @keywords internal
#'
#' @return setup scale for changing compartment values
#'
#' @export
rxSetupScale <- function(obj, scale = NULL, extraArgs = NULL) {
    .Call(`_rxode2_rxSetupScale`, obj, scale, extraArgs)
}

atolRtolFactor_ <- function(factor) {
    invisible(.Call(`_rxode2_atolRtolFactor_`, factor))
}

#' Simulate Parameters from a Theta/Omega specification
#'
#' @param params Named Vector of rxode2 model parameters
#'
#' @param nObs Number of observations to simulate (with `sigma` matrix)
#'
#' @inheritParams rxSolve
#'
#' @param simSubjects boolean indicated rxode2 should simulate subjects in studies (`TRUE`,
#'         default) or studies (`FALSE`)
#'
#' @return a data frame with the simulated subjects
#'
#' @author Matthew L.Fidler
#'
#' @export
rxSimThetaOmega <- function(params = NULL, omega = NULL, omegaDf = NULL, omegaLower = as.numeric( c(R_NegInf)), omegaUpper = as.numeric( c(R_PosInf)), omegaIsChol = FALSE, omegaSeparation = "auto", omegaXform = 1L, nSub = 1L, thetaMat = NULL, thetaLower = as.numeric( c(R_NegInf)), thetaUpper = as.numeric( c(R_PosInf)), thetaDf = NULL, thetaIsChol = FALSE, nStud = 1L, sigma = NULL, sigmaLower = as.numeric( c(R_NegInf)), sigmaUpper = as.numeric( c(R_PosInf)), sigmaDf = NULL, sigmaIsChol = FALSE, sigmaSeparation = "auto", sigmaXform = 1L, nCoresRV = 1L, nObs = 1L, dfSub = 0, dfObs = 0, simSubjects = TRUE, simVariability = as.logical( c(NA_LOGICAL))) {
    .Call(`_rxode2_rxSimThetaOmega`, params, omega, omegaDf, omegaLower, omegaUpper, omegaIsChol, omegaSeparation, omegaXform, nSub, thetaMat, thetaLower, thetaUpper, thetaDf, thetaIsChol, nStud, sigma, sigmaLower, sigmaUpper, sigmaDf, sigmaIsChol, sigmaSeparation, sigmaXform, nCoresRV, nObs, dfSub, dfObs, simSubjects, simVariability)
}

#' Free the C solving/parsing information.
#'
#' Take the ODE C system and free it.
#'
#' @keywords internal
#' @return logical indicating if the memory was successfully freed
#' @export
rxSolveFree <- function() {
    .Call(`_rxode2_rxSolveFree`)
}

#' See if the memory is installed for a solve
#'
#' @return boolean saying if the memnory is currently free for rxode2
#' @keywords internal
#' @export
#' @author Matthew L. Fidler
rxSolveSetup <- function() {
    .Call(`_rxode2_rxSolveSetup`)
}

rxSolve_ <- function(obj, rxControl, specParams, extraArgs, params, events, inits, setupOnly) {
    .Call(`_rxode2_rxSolve_`, obj, rxControl, specParams, extraArgs, params, events, inits, setupOnly)
}

rxSolveDollarNames <- function(obj) {
    .Call(`_rxode2_rxSolveDollarNames`, obj)
}

rxSolveGet <- function(obj, arg, exact = TRUE) {
    .Call(`_rxode2_rxSolveGet`, obj, arg, exact)
}

rxSolveUpdate <- function(obj, arg = NULL, value = NULL) {
    .Call(`_rxode2_rxSolveUpdate`, obj, arg, value)
}

rxSolveSEXP <- function(objS, rxControlS, specParamsS, extraArgsS, paramsS, eventsS, initsS, setupOnlyS) {
    .Call(`_rxode2_rxSolveSEXP`, objS, rxControlS, specParamsS, extraArgsS, paramsS, eventsS, initsS, setupOnlyS)
}

rxRmModelLib_ <- function(str) {
    invisible(.Call(`_rxode2_rxRmModelLib_`, str))
}

#' Get rxode2 model from object
#' @param obj rxode2 family of objects
#' @return rxode2 model
#' @export
rxGetrxode2 <- function(obj) {
    .Call(`_rxode2_rxGetrxode2`, obj)
}

#' Checks if the rxode2 object was built with the current build
#'
#' @inheritParams rxModelVars
#'
#' @return boolean indicating if this was built with current rxode2
#'
#' @export
rxIsCurrent <- function(obj) {
    .Call(`_rxode2_rxIsCurrent`, obj)
}

#' Assign pointer based on model variables
#' @param object rxode2 family of objects
#' @return nothing, called for side effects
#' @export
rxAssignPtr <- function(object = NULL) {
    invisible(.Call(`_rxode2_rxAssignPtr`, object))
}

#' Return the DLL associated with the rxode2 object
#'
#' This will return the dynamic load library or shared object used to
#' run the C code for rxode2.
#'
#' @param obj A rxode2 family of objects or a character string of the
#'     model specification or location of a file with a model
#'     specification.
#'
#' @return a path of the library
#'
#' @keywords internal
#' @author Matthew L.Fidler
#' @export
rxDll <- function(obj) {
    .Call(`_rxode2_rxDll`, obj)
}

#' Return the C file associated with the rxode2 object
#'
#' This will return C code for generating the rxode2 DLL.
#'
#' @param obj A rxode2 family of objects or a character string of the
#'     model specification or location of a file with a model
#'     specification.
#'
#' @return a path of the library
#'
#' @keywords internal
#' @author Matthew L.Fidler
#' @export
rxC <- function(obj) {
    .Call(`_rxode2_rxC`, obj)
}

#' Determine if the DLL associated with the rxode2 object is loaded
#'
#' @param obj A rxode2 family of objects
#'
#' @return Boolean returning if the rxode2 library is loaded.
#'
#' @keywords internal
#' @author Matthew L.Fidler
#' @export
rxIsLoaded <- function(obj) {
    .Call(`_rxode2_rxIsLoaded`, obj)
}

#' Load rxode2 object
#'
#' @param obj A rxode2 family of objects
#'
#' @return Boolean returning if the rxode2 library is loaded.
#'
#' @keywords internal
#' @author Matthew L.Fidler
#' @export
rxDynLoad <- function(obj) {
    .Call(`_rxode2_rxDynLoad`, obj)
}

#' Lock/unlocking of rxode2 dll file
#'
#' @param obj A rxode2 family of objects
#'
#' @return nothing; called for side effects
#'
#' @export
rxLock <- function(obj) {
    .Call(`_rxode2_rxLock`, obj)
}

#' @rdname rxLock
#' @export
rxUnlock <- function(obj) {
    .Call(`_rxode2_rxUnlock`, obj)
}

#' Allow unloading of dlls
#'
#' @param allow boolean indicating if garbage collection will unload of rxode2 dlls.
#'
#' @return Boolean allow; called for side effects
#'
#' @examples
#'
#' # Garbage collection will not unload un-used rxode2 dlls
#' rxAllowUnload(FALSE);
#'
#' # Garbage collection will unload unused rxode2 dlls
#' rxAllowUnload(TRUE);
#' @export
#' @author Matthew Fidler
rxAllowUnload <- function(allow) {
    .Call(`_rxode2_rxAllowUnload`, allow)
}

rxUnloadAll_ <- function() {
    .Call(`_rxode2_rxUnloadAll_`)
}

#' Unload rxode2 object
#'
#' @param obj A rxode2 family of objects
#'
#' @return Boolean returning if the rxode2 library is loaded.
#'
#' @keywords internal
#' @author Matthew L.Fidler
#' @export
rxDynUnload <- function(obj) {
    .Call(`_rxode2_rxDynUnload`, obj)
}

#' Delete the DLL for the model
#'
#' This function deletes the DLL, but doesn't delete the model
#' information in the object.
#'
#' @param obj rxode2 family of objects
#'
#' @return A boolean stating if the operation was successful.
#'
#' @author Matthew L.Fidler
#' @export
rxDelete <- function(obj) {
    .Call(`_rxode2_rxDelete`, obj)
}

setRstudio <- function(isRstudio = FALSE) {
    .Call(`_rxode2_setRstudio`, isRstudio)
}

setProgSupported <- function(isSupported = 1L) {
    .Call(`_rxode2_setProgSupported`, isSupported)
}

getProgSupported <- function() {
    .Call(`_rxode2_getProgSupported`)
}

rxUpdateTrans_ <- function(ret, prefix, libName) {
    .Call(`_rxode2_rxUpdateTrans_`, ret, prefix, libName)
}

dropUnitsRxSolve <- function(x) {
    .Call(`_rxode2_dropUnitsRxSolve`, x)
}

#' Silence some of rxode2's C/C++ messages
#'
#' @param silent can be 0L "noisy"  or 1L "silent"
#'
#' @keywords internal
#' @return TRUE; called for side effects
#' @export
rxSetSilentErr <- function(silent) {
    .Call(`_rxode2_rxSetSilentErr`, silent)
}

#' Invert matrix using RcppArmadillo.
#'
#' @param matrix matrix to be inverted.
#'
#' @return inverse or pseudo inverse of matrix.
#'
#' @export
rxInv <- function(matrix) {
    .Call(`_rxode2_rxInv`, matrix)
}

#' Get Omega^-1 and derivatives
#'
#' @param invObjOrMatrix Object for inverse-type calculations.  If
#'   this is a matrix, setup the object for inversion
#'   [rxSymInvCholCreate()] with the default arguments and return a
#'   reactive s3 object.  Otherwise, use the inversion object to
#'   calculate the requested derivative/inverse.
#'
#' @param theta Thetas to be used for calculation.  If missing (`NULL`), a
#'     special s3 class is created and returned to access `Omega^1`
#'     objects as needed and cache them based on the theta that is
#'     used.
#'
#' @param type The type of object.  Currently the following types are
#'     supported:
#'
#' * `cholOmegaInv` gives the
#'     Cholesky decomposition of the Omega Inverse matrix.
#' * `omegaInv` gives the Omega Inverse matrix.
#' * `d(omegaInv)` gives the `d(Omega^-1)` withe respect to the
#'     theta parameter specified in `thetaNumber`.
#' * `d(D)` gives the `d(diagonal(Omega^-1))` with respect to
#'     the theta parameter specified in the `thetaNumber`
#'     parameter
#'
#' @param thetaNumber For types `d(omegaInv)` and `d(D)`,
#'     the theta number that the derivative is taken against.  This
#'     must be positive from 1 to the number of thetas defining the
#'     Omega matrix.
#'
#' @return Matrix based on parameters or environment with all the
#'     matrixes calculated in variables `omega`, `omegaInv`, `dOmega`,
#'     `dOmegaInv`.
#'
#' @author Matthew L. Fidler
#'
#' @export
rxSymInvChol <- function(invObjOrMatrix, theta = NULL, type = "cholOmegaInv", thetaNumber = 0L) {
    .Call(`_rxode2_rxSymInvChol`, invObjOrMatrix, theta, type, thetaNumber)
}

rxSymInvCholEnvCalculate <- function(obj, what, theta = NULL) {
    .Call(`_rxode2_rxSymInvCholEnvCalculate`, obj, what, theta)
}

rxOptRep_ <- function(input) {
    .Call(`_rxode2_rxOptRep_`, input)
}

isNullZero <- function(obj) {
    .Call(`_rxode2_isNullZero`, obj)
}

rxErf <- function(v) {
    .Call(`_rxode2_rxErf`, v)
}

binomProbsPredVec_ <- function(n, m, Y, M, doP = TRUE, tol = 1e-7) {
    .Call(`_rxode2_binomProbsPredVec_`, n, m, Y, M, doP, tol)
}

binomProbs_ <- function(x, probs, naRm, nIn, cont) {
    .Call(`_rxode2_binomProbs_`, x, probs, naRm, nIn, cont)
}

meanProbs_ <- function(x, probs, naRm, useT, pred, nIn) {
    .Call(`_rxode2_meanProbs_`, x, probs, naRm, useT, pred, nIn)
}