R/NMreadTab.R

In NMdata: Preparation, Checking and Post-Processing Data for PK/PD Modeling

##' Read an output table file from Nonmem
##'
##' Read a table generated by a $TABLE statement in Nonmem. Generally,
##' these files cannot be read by read.table or similar because
##' formatting depends on options in the $TABLE statement, and because
##' Nonmem sometimes includes extra lines in the output that have to
##' be filtered out. NMreadTab can do this automatically based on the
##' table file alone.
##'
##' @param file path to Nonmem table file
##' @param col.tableno In case of simulations where tables are being
##'     repeated, a counter of the repetition number can be useful to
##'     include in the output. For now, this will only work if the
##'     NOHEADER option is not used. This is because NMreadTab
##'     searches for the "TABLE NO..." strings in Nonmem output
##'     tables. If col.tableno is TRUE (default), a counter of tables
##'     is included as a column called NMREP. Notice, the table
##'     numbers in NMREP are cumulatively counting the number of
##'     tables reported in the file. NMREP is not the actual table
##'     number as given by Nonmem.
##' @param col.nmrep col.nmrep If tables are repeated, include a
##'     counter? It does not relate to the order of the $TABLE
##'     statements but to cases where a $TABLE statement is run
##'     repeatedly. E.g., in combination with the SUBPROBLEMS feature
##'     in Nonmem, it is useful to keep track of the table
##'     (repetition) number. If col.nmrep is TRUE, this will be
##'     carried forward and added as a column called NMREP. This is
##'     default behavior when more than one $TABLE repetition is found
##'     in data. Set it to a different string to request the column
##'     with a different name. The argument is passed to NMscanTables.
##' @param col.table.name The name of a column containing the name or
##'     description of the table (generated by Nonmem). The default is
##'     "table.name". Use FALSE not to include this column.
##' @param header Use header=FALSE if table was created with NOHEADER
##'     option in $TABLE.
##' @param skip The number of rows to skip. The default is skip=1 if
##'     header==TRUE and skip=0 if header==FALSE.
##' @param quiet logical stating whether or not information is printed
##'     about what is being done. Default can be configured using
##'     NMdataConf.
##' @param as.fun The default is to return data as a data.frame. Pass
##'     a function (say tibble::as_tibble) in as.fun to convert to
##'     something else. If data.tables are wanted, use
##'     as.fun="data.table". The default can be configured using
##'     NMdataConf.
##' @param ... Arguments passed to fread.
##' @return The Nonmem table data.
##' @details The actual reading of data is based on
##'     data.table::fread. Generally, the function is fast thanks to
##'     data.table.
##' @import data.table
##' @family DataRead
##' @export


NMreadTab <- function(file,col.tableno,col.nmrep,col.table.name,header=TRUE,skip,quiet=TRUE,as.fun,...) {

#### Section start: Dummy variables, only not to get NOTE's in pacakge checks ####

    TABLE <- NULL
    NMREP <- NULL
    nmrep.min <- NULL

### Section end: Dummy variables, only not to get NOTE's in pacakge checks

### todo: Keep track of whether to keep col.nmrep and col.table.name

### Default is to keep TABLENO
    if(missing(col.nmrep) || is.null(col.nmrep) || isTRUE(col.nmrep) ){
        col.nmrep <- "NMREP"
    }
    rm.col.nmrep <- FALSE
    if(isFALSE(col.nmrep)){
        col.nmrep <- "NMREP"
        rm.col.nmrep <- TRUE
    }

    
### default is not to keep table.name
    rm.col.table.name <- FALSE
    if(missing(col.table.name) || is.null(col.table.name) || isFALSE(col.table.name) ){
        col.table.name <- "table.name"
        rm.col.table.name <- TRUE
    }
    if(isTRUE(col.table.name)){
        col.table.name <- "table.name"
    }

### Default is to keep TABLENO
    if(missing(col.tableno) || is.null(col.tableno) || isTRUE(col.tableno) ){
        col.tableno <- "TABLENO"
    }
    rm.col.tableno <- FALSE
    if(isFALSE(col.tableno)){
        col.tableno <- "TABLENO"
        rm.col.tableno <- TRUE
    }


    ## function to strip strings from leading, trailing and duplicate spaces
    cleanSpaces <- function(x){
        x <- sub("^ +","",x)
        x <- sub(" +$","",x)
        x <- gsub(" +"," ",x)
        x
    }
    
    ## arg checks
    if(!is.character(file)) stop("file should be a character string",call.=FALSE)
    if(!file.exists(file)) stop("argument file is not a path to an existing file.",call.=FALSE)

    if(missing(as.fun)) as.fun <- NULL
    as.fun <- NMdataDecideOption("as.fun",as.fun)

    if(missing(quiet)) quiet <- NULL
    quiet <- NMdataDecideOption("quiet",quiet)

    if(missing(skip)){
        skip <- 1
        if(!header) skip <- 0
    }
    dt1 <- fread(file,fill=TRUE,header=header,skip=skip,...)
    
    cnames <- copy(colnames(dt1))
    if(!quiet){
        message("Adding table numbers to data")
    }
    
    
    ## if(col.nmrep){
    ## find table numbers

    col.table.name.text <- tmpcol(dt1,base="tabtext")
    

    
    if(skip==1){
        title.tab1 <- data.table(readLines(file,n=1))
        colnames(title.tab1) <- colnames(dt1)[1]
        dt1 <- rbind(title.tab1,dt1,fill=TRUE)
        ## dt1[1,(col.table.name.text):=title.tab1]
    }
    col.row.tmp <- tmpcol(dt1)
    dt1[,(col.row.tmp):=.I]

    mypaste <- function(x) {
        x <- paste(unlist(x)[!is.na(x)],collapse=" ")
        x <- cleanSpaces(x)
        x
    }
    
    dt1[grep("^TABLE",as.character(get(cnames[1])),perl=TRUE),(col.table.name.text):=mypaste(.SD),by=col.row.tmp]
    
    
    dt1[grepl("^TABLE",as.character(get(cnames[1])),perl=TRUE),
    (col.tableno):=as.numeric(sub("^ *TABLE NO\\. *([0-9]+).*","\\1",get(col.table.name.text))),by=col.row.tmp]
    dt1[grepl("^TABLE",as.character(get(cnames[1])),perl=TRUE),
    (col.table.name):=sub("^ *TABLE NO\\. *([1-9][0-9]+) *: *(.*)$","\\2",get(col.table.name.text)),
    by=col.row.tmp]
    ## getting rid of trailing spaces
    dt1[,(col.table.name):=sub(" *$","",get(col.table.name))]
    
### count table replicates    
    ##    if(header){
    
    dt1[,(col.tableno):=nafill(get(col.tableno),type="locf")]
    dt1[,(col.nmrep):=cumsum(!is.na(get(col.table.name))),by=col.tableno]
    ## if no header was found nmrep starts at zero. That should be one.
    dt1[,nmrep.min:=min(c(get(col.nmrep),1),na.rm=TRUE),by=col.tableno]
    dt1[nmrep.min==0,(col.nmrep):=get(col.nmrep)+1]
    dt1[,nmrep.min:=NULL]
    ## carry non-missing to missing values
    
    dt1[,(col.table.name):=get(col.table.name)[!is.na(get(col.table.name))],by=c(col.tableno,col.nmrep)]
    ##    }
    
    if(!quiet){
        message("getting rid of non-data rows")
    }
    dt1 <- dt1[grep("^ *[[:alpha:]]",as.character(get(cnames[1])),invert=TRUE,perl=TRUE)]

    cols.dup <- duplicated(colnames(dt1))
    if(any(cols.dup)){
        messageWrap(paste0("Cleaned duplicated column names: ",paste(colnames(dt1)[cols.dup],collapse=",")),fun.msg=message)
        dt1 <- dt1[,unique(colnames(dt1)),with=FALSE]
        
    }

    dt1[,(col.row.tmp):=NULL]
    dt1[,(col.table.name.text):=NULL]
    if(rm.col.table.name) dt1[,(col.table.name):=NULL]
    if(rm.col.nmrep) dt1[,(col.nmrep):=NULL]
    if(rm.col.tableno) dt1[,(col.tableno):=NULL]
    
    ## columns added and clened since cnames was created.
    cnames <- setdiff(colnames(dt1),c(col.table.name,col.nmrep))
    dt1[,(cnames):=lapply(.SD,as.numeric),.SDcols=cnames]

    
    dt1 <- as.fun(dt1)
    
    return(dt1)
}