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 \code{data.table::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
    }

    
    ## arg checks
    if(!is.character(file)) stop("file should be a character string",call.=FALSE)
    if(!file.exists(file)) messageWrap(paste("Argument file is not a path to an existing file. Expected to find",file),fun.msg=stop,track.msg = TRUE)

    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) || is.null(skip)){
        firstline <- readLines(file,n=1)
        skip <- 0
        if(grepl(" *TABLE +NO\\.[ \\s]*[0-9]+",firstline)){
            skip <- 1
        }
        ##if(!header) skip <- 0
    }
    dt1 <- fread(file,fill=TRUE,header=header,skip=skip,...)
    ## dt1 <- fread(file,fill=TRUE,...)
    
    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){
        ## putting skipped lines back in so we can count tables
        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))]

    
    
    ### we could remove the table name column if no tables names found. But I'm not sure it's the right thing to do. It's not wrong to leave NA names. The user basically asks for it using the col.table.name arg.
    if(dt1[,all(is.na(get(col.tableno)))]){
        ## dt1[,(col.tableno):=NULL]
        dt1[,(col.tableno):=1]
    }

    
### count table replicates    
    ##    if(header){
    if(col.tableno %in%colnames(dt1) ){
        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)]
    }

    ### we could remove the table name column if no tables names found. But I'm not sure it's the right thing to do. It's not wrong to leave NA names. The user basically asks for it using the col.table.name arg.
    ## if(dt1[,all(is.na(get(col.table.name)))]){
    ##     dt1[,(col.table.name):=NULL]
    ## }
    
    
    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 && col.table.name%in%colnames(dt1)) dt1[,(col.table.name):=NULL]
    if(rm.col.nmrep && col.nmrep%in%colnames(dt1)) dt1[,(col.nmrep):=NULL]
    if(rm.col.tableno && col.tableno%in%colnames(dt1)) 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)
}