Nothing
#' Reads .ext files generated by NONMEM
#'
#' @param run run a run number or run identifier
#' @param project project the NONMEM project directory
#' @param file file the `ext` file name
#' @param path path full path and file name for `ext` file
#' @param read_fun read_fun function to read the `ext` file
#' @param quiet Logical, if \code{FALSE} messages are printed to the console.
#'
#' @author This function is based on read_nmext from mrgsolve, Original Author: Kyle T Baron.
#' This function has some changes to the original code:
#'Addition of param, "quiet", (option of pmx_msg function, from xpose package) (Line: 27)
#'The code was slightly adjusted to check for multiple tables and also extract SE (ITERATION == 1000000001) (Line: 44-58, Line: 86-96, respectively)
#'The output was also slightly adjusted to fit ggPMX output (df and df2) (Line: 105,106)
#'as_bmat was replaced by bmat_like to create the diagonal matrix (Line 116:142)
#'
#' @return A list with param, omega, and sigma in a format
#' ready to be used.
#' @export
#'
#' @examples
#' #project <- system.file("nonmem", package = "mrgsolve")
#' #est <- read_nmext(1005, project = project)
read_extfile <- function(run=NA_real_, project = getwd(), file=paste0(run,".ext"),
path=NULL, read_fun = c("data.table","read.table"),quiet) {
if(is.character(path)) {
extfile <- path
} else {
extfile <- file.path(project,run,file)
}
if(!file.exists(extfile)) {
stop("[read_nmext] could not find the requested 'ext' file ",
shQuote(basename(extfile)))
}
read_fun <- match.arg(read_fun)
use_dt <- requireNamespace("data.table",quietly=TRUE) & read_fun=="data.table"
## Check for multiple tables/problems
ext_tmp <- readLines(extfile)
inds <- grep("TABLE",ext_tmp)
last_table <- 0
## Check if multiple Problems are found in .ext file
if (length(inds)!=1){
last_table <- inds[length(inds)]
colon <- regexpr(":",ext_tmp[last_table])[1]
last_table_name <- substr(ext_tmp[last_table],1,colon-1)
last_table <- last_table-1
pmx_msg(paste("Multiple Problems found in",file,"only using",last_table_name,"\n"),quiet) #multiple problems not currently supported, only using last table
}
## Read .ext file
if(use_dt) {
df <- data.table::fread(
file=extfile,
na.strings = '.',
data.table=FALSE,
skip=last_table+1
)
} else {
df <- read.table(
file=extfile,
na.strings='.',
stringsAsFactors=FALSE,
skip=last_table+1,
header=TRUE
)
}
## Get parameters and standard errors
#get parameters
ans <- ""
ans <- df[df[["ITERATION"]] == -1E9,]
bmat_ans <- ans #in order to use bmat_like function
df_ans <- ans
#get standard erros
ans_se <- ""
ans_se <- df[df[["ITERATION"]] == -1000000001,]
df_ans_se <- ans_se
if(nrow(ans)==0) {
stop(
"[read_nmext] could not find final estimates",
" while reading 'ext' file ", shQuote(basename(extfile))
)
}
#get numbers of "OMEGA" or "SIGMA" used in bmat_like
get_num <- function(x,string){ #last_om = x
nums <- gsub(paste0(".*",string,"|[()]"), "", x)
num1 <- as.numeric(gsub(",.*", "", nums))
num2 <- as.numeric(gsub(".*,", "", nums))
num_vec <- c(num1,num2)
return(num_vec)
}
#uses bmat_ans as an input and gives out diagonal matrix
bmat_like <- function(x,string) {
y <- x[grep(string,names(x))]
len_y <- length(y)
nam_last_om <- names(y[len_y])
z <- substring(nam_last_om, regexpr(",", nam_last_om) + 1)
num <- as.numeric(sub(').*', '', z))
pre_mat <- matrix(nrow = num, ncol = num)
mat <- pre_mat
mat[] <- 0
i <- 1
for (i in i:len_y) {
om <- y[i]
nam_om <- names(om)
pos <- get_num(nam_om,string)
mat[pos[1],pos[2]] <- om[[1]]
}
return(mat)
}
ans <- as.list(ans)
names(ans) <- gsub("[[:punct:]]", "", names(ans))
ans <- list(
param = ans[grepl("THETA", names(ans))],
omega = bmat_like(bmat_ans, "OMEGA"),
sigma = bmat_like(bmat_ans, "SIGMA"),
raw = ans,
df = df_ans,
df2 = df_ans_se
)
return(ans)
}
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.