Nothing
#' Retrieves the variance-covariance matrix of the estimators and optionally
#' the correlation and inverse correlation matrices of the selected NONMEM run
#' @title Returns variance-covariance matrix, if available, from a NONMEM object
#' @param obj An object of class NMRun or NMBasicModel
#' @param corMatrix TRUE or FALSE. If TRUE, returns correlation matrix as well
#' @param invCorMatrix TRUE or FALSE, Not implemented yet
#' @param pdMatrix TRUE or FALSE. If TRUE, will check that a positive-definite covariance matrix is available.
#' If it is not, it will create one based on sample variances and covariances of estimates. Not implemented yet
#' @param ...
#' @return A matrix if just the covariance matrix is required, a list of matrices otherwise
#' @author Mango Solutions
#'
getEstimateCov <- function(obj, corMatrix = FALSE, invCorMatrix = FALSE, pdMatrix = FALSE, ...)
{
RNMImportStop("getEstimateCov not implemented for this class yet\n", match.call())
}
setGeneric("getEstimateCov")
getEstimateCov.NMRun <- function(obj, corMatrix = FALSE, invCorMatrix = FALSE, pdMatrix = FALSE,
problemNum = 1, method = 1)
{
getEstimateCov(getProblem(obj, problemNum), corMatrix = corMatrix, method = method)
}
setMethod("getEstimateCov", signature(obj = "NMRun"), getEstimateCov.NMRun)
getEstimateCov.NMBasicModel <- function(obj, corMatrix = FALSE, invCorMatrix = FALSE, pdMatrix = FALSE , ...
)
{
parameterCovMatrix <- obj@parameterCovMatrix
# check for missing variance-covariance matrix
if(all(dim(parameterCovMatrix)) == 0)
{
# RNMImportWarning( "Covariance matrix not available, returning NULL\n" )
return(NULL)
}
if(!corMatrix | all(dim(obj@parameterCorMatrix) == 0)) obj@parameterCovMatrix
else list("covariance" = obj@parameterCovMatrix, "correlation" = obj@parameterCorMatrix)
}
setMethod("getEstimateCov", signature(obj = "NMBasicModel"), getEstimateCov.NMBasicModel)
getEstimateCov.NMBasicModelNM7 <- function(obj, corMatrix = FALSE, invCorMatrix = FALSE, pdMatrix = FALSE , method = 1)
{
methodChosen <- .selectMethod(obj@methodNames, method)
parameterCovMatrix <- obj@parameterCovMatrices[[methodChosen]]
parameterCorMatrix <- obj@parameterCorMatrices[[methodChosen]]
# check for missing variance-covariance matrix
if(is.null(parameterCovMatrix))
{
# RNMImportWarning( "Covariance matrix not available, returning NULL\n" )
return(NULL)
}
if(!corMatrix | is.null(parameterCorMatrix)) parameterCovMatrix
else list("covariance" = parameterCovMatrix, "correlation" = parameterCorMatrix )
}
setMethod("getEstimateCov", signature(obj = "NMBasicModelNM7"), getEstimateCov.NMBasicModelNM7)
#' getObjective will access the final value(s) of the objective function. It is a generic function, with inputs/outputs on different classes described below:
#' @param obj NMRun, or problem inheriting from NMProblem
#' @param addMinInfo Logical flag. Should the minimization info be added if it's available?
#' @param ... Additional parameters passed to other methods. \code{problemNum} for NMRun objects
#' \code{subProblems} for NMSim* objects, and \code{method} (numeric vector) for NM7 objects
#' @title Retrieve objective function value
#' @return For x of class \code{NMBasicModel}, a numeric vector with minimization information attached as an attribute.
#' If x is of class \code{NMBasicModelNM7}, a vector with one entry for each method requested, For x of class \code{NMSimModel},
#' a numeric vector with one element for each subproblem chosen. If x is of class \code{NMSimModelNM7}, a vector with each
#' selected subproblem number when only a single method is chosen, or a matrix with a column for each method and row for
#' each sub-problem if multiple methods are selected. If x is of class \code{NMRun}, the output will vary according to the problem selected (as above).
#' @author Mango Solutions
#' @keywords methods
#' @examples
#' \dontrun{
#' x <- importNm("theoph.con", path = "examples/theoph")
#' getObjective(x)
#' }
getObjective <- function(obj, addMinInfo = TRUE, ...)
{
RNMImportStop("getObjective not implemented for this class type")
}
setGeneric("getObjective")
getObjective.NMRun <- function(obj, addMinInfo=TRUE, subProblems=1, problemNum=1, method = 1)
{
getObjective(getProblem(obj, problemNum), addMinInfo, subProblems, method = method)
}
setMethod("getObjective", signature(obj="NMRun"), getObjective.NMRun)
getObjective.NMBasicModel <- function(obj, addMinInfo=TRUE, ...)
{
objective <- obj@objectiveFinal
if(addMinInfo)
{
if(is.null(obj@minInfo))
RNMImportWarning("Minimization data is missing, will not return\n")
else
attr(objective, "minInfo") <- obj@minInfo
}
objective
}
setMethod("getObjective", signature(obj="NMBasicModel"), getObjective.NMBasicModel)
getObjective.NMBasicModelNM7 <- function(obj, addMinInfo=TRUE, method = 1, ...)
{
methodsChosen <- intersect(method, seq_along(obj@methodNames))
if(length(methodsChosen) == 0)
RNMImportStop("No valid method chosen!", call = match.call() )
objective <- obj@objectiveFinal[methodsChosen]
if(addMinInfo)
{
if(length(obj@minInfo) == 0)
RNMImportWarning("Minimization data is missing, will not return\n")
else
{
attr(objective, "minInfo") <- obj@minInfo[methodsChosen]
RNMImportWarning("Only first line of minimization information is available for NONMEM 7 objects")
}
}
objective
}
setMethod("getObjective", signature(obj="NMBasicModelNM7"), getObjective.NMBasicModelNM7)
getObjective.NMSimModel <- function(obj, addMinInfo = TRUE, subProblems = 1,...)
{
obj@objectiveFinal[subProblems]
}
setMethod("getObjective", signature(obj="NMSimModel"), getObjective.NMSimModel)
getObjective.NMSimModelNM7 <- function(obj, addMinInfo = TRUE, subProblems = 1, method = 1, ...)
{
methodsChosen <- intersect(method, seq_along(obj@methodNames))
if(length(methodsChosen) == 0)
RNMImportStop("No valid method chosen!", call = match.call() )
objective <- obj@objectiveFinal[subProblems, methodsChosen]
objective
}
setMethod("getObjective", signature(obj="NMSimModelNM7"), getObjective.NMSimModelNM7)
#' Retrieves information about a run's control and report files as a data.frame
#' @param run Object of class NMRun
#' @title Retrieve file information
#' @return A data.frame with 2 rows, 1 describing the report file and the other the control file
#' @author Mango Solutions
#' @keywords utility
#'
getFileinfo <- function(run)
{
assertClass(run, "NMRun")
rbind("controlFile" = run@controlFileInfo, "reportFile" = run@reportFileInfo)
}
getReporttext <- function(run) run@reportText
getControltext <- function(run) run@controlText
#' Extracts the list of "parsed control statements" associated with a problem or run
#' @param obj NMRun or NMProblem object
#' @param ... Various arguments specific to methods
#' @title Extract list of parsed control statement
#' @return A list with the parsed control statements (e.g. an actual matrix for the Thetas, etc.,
#' @author Mango Solutions
#' @export
#'
getControlStatements <- function(obj, ...)
{
RNMImportStop("This function is not implemented for objects of this class")
}
setGeneric("getControlStatements")
getControlStatements.NMRun <- function(obj, problemNum = 1)
{
getControlStatements(getProblem(obj, problemNum))
}
setMethod("getControlStatements", signature(obj = "NMRun"), getControlStatements.NMRun)
getControlStatements.NMProblem <- function(obj, ...)
{
obj@controlStatements
}
setMethod("getControlStatements", signature(obj = "NMProblem"), getControlStatements.NMProblem)
#' Gets the version of NONMEM used to create compile obj
#' @param obj NMProblem or NMRun
#' @return A named character vector with entries "major" and "minor", corresponding to the major and minor NONMEM
#' version
#' @author Mango Solutions
#' @export
#'
getNmVersion <- function(obj)
{
RNMImportStop("This function is not implemented for objects of this class")
}
setGeneric("getNmVersion")
getNmVersion.NMRunProb <- function(obj)
{
versionInfo <- c(obj@nmVersionMajor, as.character(obj@nmVersionMinor))
names(versionInfo) <- c("major", "minor")
versionInfo
}
setMethod("getNmVersion", signature(obj = "NMRun"), getNmVersion.NMRunProb)
setMethod("getNmVersion", signature(obj = "NMProblem"), getNmVersion.NMRunProb)
#' Extract information simulation information from a simulation problem
#' @param obj Object of class NMRun, or NMSim*
#' @param problemNum Number of problem (applicable only when obj is of class NMRun)
#' @param addRawInfo Should the raw contents of the $SIM statement be added to the returned information?
#' @title Get Simulation Information
#' @return A numeric vector with 3 entries : numSimulations, seed1, and seed2. These are self-explanatory.
#' If addRawInfo is TRUE, the returned result will have an attribute named "rawStatement" that will have the text
#' of the control stream $SIM field.
#' @author Mango Solutions
#' @keywords classes, manip, utilities
#' @export
#'
getSimInfo <- function(obj, problemNum = 1, addRawInfo = TRUE)
{
RNMImportStop("This function is not implemented for objects of this class")
}
setGeneric("getSimInfo")
getSimInfo.NMRun <- function(obj, problemNum = 1, addRawInfo = TRUE)
{
getSimInfo(getProblem(obj, problemNumber = problemNum), addRawInfo = addRawInfo)
}
setMethod("getSimInfo", signature(obj = "NMRun"), getSimInfo.NMRun)
getSimInfo.NMSim <- function(obj, problemNum = 1, addRawInfo = TRUE)
{
# extract the aprsed contgrol statments
controlStatements <- obj@controlStatements
# the raw $SIM statemnet is an attribute of the Sim element
rawSim <- attr(controlStatements$Sim, "rawStatement")
simInfo <- c(obj@numSimulations, obj@seeds)
names(simInfo) <- c( "numSimulations", "seed1", "seed2" )
if(addRawInfo) attr(simInfo, "rawStatement") <- rawSim
simInfo
}
setMethod("getSimInfo", signature(obj = "NMSimModelNM7"), getSimInfo.NMSim)
setMethod("getSimInfo", signature(obj = "NMSimDataGen"), getSimInfo.NMSim)
setMethod("getSimInfo", signature(obj = "NMSimModel"), getSimInfo.NMSim)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.