#' Create a table of model parameter estimates from a NONMEM output object.
#'
#' @param x A NONMEM output object generated using \code{\link{read_nm}}.
#' @param thetaLabels A vector containing labels for THETA parameters.
#' @param omegaLabels A vector containing labels for OMEGA parameters.
#' @param sigmaLabels A vector containing labels for SIGMA parameters.
#' @param sigdig The desired number of significant digits to display.
#'
#' @return A named vector of NONMEM model parameter estimates.
#'
#' @seealso NONMEM (\url{https://www.iconplc.com/innovation/nonmem/})
#' @author Justin Wilkins, \email{justin.wilkins@@occams.com}
#'
#' @examples
#' \dontrun{
#' nmOutput <- read_nm("run315.xml")
#' estTab <- get_est_table(nmOutput)
#' }
#'
#' @export
get_est_table <- function (x, thetaLabels = c(), omegaLabels = c(),
sigmaLabels = c(), sigdig = 3) {
theta <- get_theta(x, sigdig = 3)
thetarse <- get_theta(x, output = "rse", sigdig = 3)
theta95ci <- get_theta(x, output = "95ci", sigdig = 3)
omegaMatrix <- get_omega(x, sigdig = 3)
omegaRSEMatrix <- get_omega(x, sigdig = 3, output = "rse")
omega95CIMatrix <- get_omega(x, sigdig = 3, output = "95ci")
omegaL <- c()
omegaRSEL <- c()
omega95CIL <- c()
omegaLab <- c()
for (n in 1:nrow(omegaMatrix)) {
omegaL <- c(omegaL, omegaMatrix[n, 1:n])
omegaRSEL <- c(omegaRSEL, omegaRSEMatrix[n, 1:n])
omega95CIL <- c(omega95CIL, omega95CIMatrix[n, 1:n])
omegaLab <- c(omegaLab, paste("OM", n, ",", 1:n, sep = ""))
}
sigmaMatrix <- get_sigma(x, sigdig = 3)
sigmaRSEMatrix <- get_sigma(x, sigdig = 3, output = "rse")
sigma95CIMatrix <- get_sigma(x, sigdig = 3, output = "95ci")
sigmaL <- c()
sigmaRSEL <- c()
sigma95CIL <- c()
sigmaLab <- c()
for (n in 1:nrow(sigmaMatrix)) {
sigmaL <- c(sigmaL, sigmaMatrix[n, 1:n])
sigmaRSEL <- c(sigmaRSEL, sigmaRSEMatrix[n, 1:n])
sigma95CIL <- c(sigma95CIL, sigma95CIMatrix[n, 1:n])
sigmaLab <- c(sigmaLab, paste("SI", n, ",", 1:n, sep = ""))
}
labCol <- paste("THETA", 1:length(theta), sep = "")
if (length(thetaLabels) == length(theta)) {
labCol <- thetaLabels
}
idxOmegaDiag <- c()
for (n in 1:nrow(omegaMatrix)) {
idxOmegaDiag <- c(idxOmegaDiag, sum(1:n))
}
idxOmegaOffDiag <- setdiff(1:length(omegaL), idxOmegaDiag)
if (length(omegaLabels) == nrow(omegaMatrix)) {
omegaLab[idxOmegaDiag] <- omegaLabels
} else {
omegaLab[idxOmegaDiag] <- paste("OMEGA", 1:nrow(omegaMatrix),
sep = "")
}
labCol <- c(labCol, omegaLab)
idxSigmaDiag <- c()
for (n in 1:nrow(sigmaMatrix)) {
idxSigmaDiag <- c(idxSigmaDiag, sum(1:n))
}
idxSigmaOffDiag <- setdiff(1:length(sigmaL), idxSigmaDiag)
if (length(sigmaLabels) == nrow(sigmaMatrix)) {
sigmaLab[idxSigmaDiag] <- sigmaLabels
} else {
sigmaLab[idxSigmaDiag] <- paste("SIGMA", 1:nrow(sigmaMatrix),
sep = "")
}
labCol <- c(labCol, sigmaLab)
estCol <- c(as.numeric(theta), as.numeric(omegaL), as.numeric(sigmaL))
rseCol <- c(as.numeric(thetarse), as.numeric(omegaRSEL),
as.numeric(sigmaRSEL))
CI95Col <- c(as.character(theta95ci), as.character(omega95CIL),
as.character(sigma95CIL))
shrEta <- rep("-", times = length(omegaL))
shrEta[idxOmegaDiag] <- as.numeric(get_shrinkage(x))
shrEps <- as.numeric(get_shrinkage(x,
output = "epsilon"))
if(length(sigmaL>1)) {
shrEps <- rep("-", times = length(sigmaL))
shrEps[idxSigmaDiag] <- as.numeric(get_shrinkage(x, output="epsilon"))
}
shrCol <- c(rep("-", times = length(theta)), shrEta, shrEps)
out <- data.frame(Parameter = labCol, Estimate = estCol,
RSE = rseCol, CI95 = CI95Col, Shrinkage = shrCol)
out$CI95[out$CI95=="NA-NA"] <- NA
out
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.