NMreadExt support for SAEM iterations and bugfix with NMreadSection

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: NMdata
 Type: Package
 Title: Preparation, Checking and Post-Processing Data for PK/PD Modeling
-Version: 0.1.2.913
+Version: 0.1.3.901
 Authors@R: c(person("Philip", "Delff", email = "philip@delff.dk", role = c("aut", "cre")))
 Maintainer: Philip Delff <philip@delff.dk>
 Description: Efficient tools for preparation, checking and post-processing of data in PK/PD (pharmacokinetics/pharmacodynamics) modeling, with focus on use of Nonmem. Attention is paid to ensure consistency, traceability, and Nonmem compatibility of Data. Rigorously checks final Nonmem datasets. Implemented in 'data.table', but easily integrated with 'base' and 'tidyverse'.

NEWS.md

@@ -1,3 +1,16 @@
+# 0.1.4
+
+## New features
+NMdata functions will now by default look for input control streams
+with file name extensions either `.mod` or `.ctl`. The user previously
+had to tell NMdata to look for `.ctl` using configuration options or
+function arguments but it will now work either way. An error will be
+thrown if both should be found.
+
+## Bugfixes
+* NMreadText would fail to disregard some comment lines when
+  `keep.comments=FALSE`. Fixed.
+
 # 0.1.3
 * Better support for models with multiple estimation
   steps. Particularly reading output tables now better distinguishes

R/NMcheckData.R

@@ -304,7 +304,7 @@ NMcheckData <- function(data,file,covs,covs.occ,cols.num,col.id="ID",
         }
     }
 
-
+    
     if(!(is.character(col.dv)&&length(col.dv)==1)){
         stop("col.dv must be a character and vector of length 1.")
     }

R/NMdataConf.R

@@ -348,7 +348,17 @@ NMdataConfOptions <- function(name,allow.unknown=TRUE){
         )
        ,
         file.mod=list(
-            default=function(file) fnExtension(file,ext=".mod")
+            ## default=function(file) fnExtension(file,ext=".mod")
+
+            default=function(file) {
+                mod <- fnExtension(file,ext=".mod")
+                ctl <- fnExtension(file,ext=".ctl")
+                if(file.exists(mod)) {
+                    if(file.exists(ctl)) stop("both .mod and .ctl found. Please define file.mod to choose one of them")
+                    return(mod)
+                }
+                ctl
+            }
             ## has to be length 1 character or function
            ,is.allowed=function(x) is.function(x) || (length(x)==1 && is.character(x))
            ,msg.not.allowed="file.mod must be a function or a character of length 1"

R/NMextractText.R

@@ -22,12 +22,13 @@
 ##'     char.section.
 ##' @param return If "text", plain text lines are returned. If "idx",
 ##'     matching line numbers are returned. "text" is default.
-##' @param keep.empty Keep empty lines in output? Default is FALSE.
 ##' @param keep.name Keep the section name in output (say, "$PROBLEM")
 ##'     Default is TRUE. It can only be FALSE, if return="text".
-##' @param keep.comments Keep comment lines? This concerns lines that
-##'     consist of only white space and comments; comments after
-##'     actual contents are not concerned.
+##' @param keep.comments Default is to keep comments. If FALSE, the
+##'     will be removed.
+##' @param keep.empty Keep empty lines in output? Default is
+##'     FALSE. Notice, comments are removed before empty lines are
+##'     handled if `keep.comments=TRUE`.
 ##' @param as.one If multiple hits, concatenate into one. This will
 ##'     most often be relevant with name="TABLE". If FALSE, a list
 ##'     will be returned, each element representing a table. Default
@@ -145,18 +146,20 @@ NMextractText <- function(file, lines, text, section, char.section,
     })
     result <- idx.sections
 
-    if(!keep.empty){
-        result <- lapply(result,function(x)
-            x[!grepl("^ *$",lines[x])]
-            )
-    }
 
     if(!keep.comments){
+        ## result <- lapply(result,function(x)
+        ##     x[!grepl(" *;",lines[x])]
+        ##     )
+        lines <- sub(pattern=" *;.*$",replacement="",x=lines)
+    }
+
+    if(!keep.empty){
         result <- lapply(result,function(x)
-            x[!grepl("^ *;",lines[x])]
+            x[!grepl("^ *$",lines[x])]
             )
-        lines <- sub(pattern=";.*$",replacement="",x=lines)
     }
+
 
     if(return=="text"){
         result <- lapply(result,function(x)lines[x])

R/NMreadExt.R

@@ -21,7 +21,7 @@
 ##' @export
 
 NMreadExt <- function(file.ext,return="pars",as.fun,modelname,col.model){
-
+    
 #### Section start: Dummy variables, only not to get NOTE's in pacakge checks ####
 
     ITERATION <- NULL
@@ -49,7 +49,21 @@ NMreadExt <- function(file.ext,return="pars",as.fun,modelname,col.model){
         stop("Argument return has to be one of: ", paste(allowed.return,collapse =", "))
     }
 
-
+
+    addPartype <- function(pars){
+        pars[,par.type:=NA_character_]
+        pars[grepl("^THETA",parameter),par.type:="THETA"]
+        pars[grepl("^OMEGA",parameter),par.type:="OMEGA"]
+        pars[grepl("^SIGMA",parameter),par.type:="SIGMA"]
+        pars[par.type=="THETA",i:=sub("THETA([0-9]+)","\\1",parameter)]
+        pars[par.type=="OMEGA",i:=sub("OMEGA\\(([0-9]+)\\,([0-9]+)\\)","\\1",parameter)]
+        pars[par.type=="OMEGA",j:=sub("OMEGA\\(([0-9]+)\\,([0-9]+)\\)","\\2",parameter)]
+        pars[par.type=="SIGMA",i:=sub("SIGMA\\(([0-9]+)\\,([0-9]+)\\)","\\1",parameter)]
+        pars[par.type=="SIGMA",j:=sub("SIGMA\\(([0-9]+)\\,([0-9]+)\\)","\\2",parameter)]
+        cols <- cc(i,j)
+        pars[,(cols):=lapply(.SD,as.integer),.SDcols=cols]
+        pars[]
+    }
 
     res.NMdat <- lapply(file.ext,function(file){
         this.model <- modelname(file)
@@ -80,31 +94,20 @@ NMreadExt <- function(file.ext,return="pars",as.fun,modelname,col.model){
     res.NMdat <- mergeCheck(res.NMdat,dt.codes,by=cc(ITERATION),all.x=T,quiet=TRUE)
     ## res.NMdat
 
-
-
     pars <- res.NMdat[variable%in%dt.codes$variable,setdiff(colnames(res.NMdat),"OBJ"),with=FALSE]
-
     pars <- addTableStep(pars,keep.table.name=FALSE)
-
-    pars <- melt(pars,id.vars=cc(model,TABLENO,NMREP,table.step,ITERATION,variable),variable.name="parameter")
-    pars <- dcast(pars,model+TABLENO+NMREP+table.step+parameter~variable,value.var="value")
-
-    pars[,par.type:=NA_character_]
-    pars[grepl("^THETA",parameter),par.type:="THETA"]
-    pars[grepl("^OMEGA",parameter),par.type:="OMEGA"]
-    pars[grepl("^SIGMA",parameter),par.type:="SIGMA"]
-    pars[par.type=="THETA",i:=sub("THETA([0-9]+)","\\1",parameter)]
-    pars[par.type=="OMEGA",i:=sub("OMEGA\\(([0-9]+)\\,([0-9]+)\\)","\\1",parameter)]
-    pars[par.type=="OMEGA",j:=sub("OMEGA\\(([0-9]+)\\,([0-9]+)\\)","\\2",parameter)]
-    pars[par.type=="SIGMA",i:=sub("SIGMA\\(([0-9]+)\\,([0-9]+)\\)","\\1",parameter)]
-    pars[par.type=="SIGMA",j:=sub("SIGMA\\(([0-9]+)\\,([0-9]+)\\)","\\2",parameter)]
-    cols <- cc(i,j)
-    pars[,(cols):=lapply(.SD,as.integer),.SDcols=cols]
+    if(nrow(pars)){
+        pars <- melt(pars,id.vars=cc(model,TABLENO,NMREP,table.step,ITERATION,variable),variable.name="parameter")
+        pars <- dcast(pars,model+TABLENO+NMREP+table.step+parameter~variable,value.var="value")
 
+        pars <- addPartype(pars)
+    }
+
     ## what to do about OBJ? Disregard? And keep in a iteration table instead?
     iterations <- res.NMdat[as.numeric(ITERATION)>(-1e9),!("variable")] 
     iterations <- addTableStep(iterations,keep.table.name=FALSE)
     iterations <- melt(iterations,id.vars=cc(model,TABLENO,NMREP,table.step,ITERATION),variable.name="parameter")
+    iterations <- addPartype(iterations)
 
     res <- list(pars=pars,iterations=iterations)
     res <- lapply(res,as.fun)

R/NMreadSection.R

@@ -17,12 +17,13 @@
 ##'     sensitive.
 ##' @param return If "text", plain text lines are returned. If "idx",
 ##'     matching line numbers are returned. "text" is default.
-##' @param keep.empty Keep empty lines in output? Default is FALSE.
+##' @param keep.comments Default is to keep comments. If FALSE, the
+##'     will be removed.
+##' @param keep.empty Keep empty lines in output? Default is
+##'     FALSE. Notice, comments are removed before empty lines are
+##'     handled if `keep.comments=TRUE`.
 ##' @param keep.name Keep the section name in output (say, "$PROBLEM")
 ##'     Default is FALSE. It can only be FALSE, if return="text".
-##' @param keep.comments Keep comment lines? This concerns lines that
-##'     consist of only white space and comments; comments after
-##'     actual contents are not concerned.
 ##' @param as.one If multiple hits, concatenate into one. This will
 ##'     most often be relevant with name="TABLE". If FALSE, a list
 ##'     will be returned, each element representing a table. Default

R/NMtransInp.R

@@ -17,7 +17,7 @@
 ## don't export. An internal function used by NMscanInput. 
 
 NMtransInp <- function(data,file,translate=TRUE,recover.cols=TRUE){
-
+    
 #### Section start: Dummy variables, only not to get NOTE's in package checks ####
     datafile <- NULL
     DATA <- NULL
@@ -27,7 +27,7 @@ NMtransInp <- function(data,file,translate=TRUE,recover.cols=TRUE){
 ### Section end: Dummy variables, only not to get NOTE's in package checks ####
 
     stopifnot(is.data.table(data))
-
+    
 #### this should be supported now
     ##    if( !translate && !recover.cols ) {messageWrap("recover.rows=FALSE is only allowed when translate=TRUE.",fun.msg=stop)}
 
@@ -37,6 +37,8 @@ NMtransInp <- function(data,file,translate=TRUE,recover.cols=TRUE){
         lines <- NMreadSection(file,section="INPT",keep.name=FALSE,keep.comments=FALSE,clean.spaces=TRUE)
     }
     if(is.null(lines)) {stop("Could not find $INPUT or $INPT section in control stream. Cannot interpret data. Is file really the path to a valid nonmem control stream?")}
+
+    ## drop comments
 
     ## names can be separated by , or " " or both. So one , between alphanumerics is replaced by a single space
     lines <- gsub("([[:alnum:]]) *, *([[:alnum:]])","\\1 \\2",lines)

tests/testthat/test_NMscanData.R

@@ -747,7 +747,8 @@ test_that("Including a redundant output table",{
 test_that("redundant output",{
     NMdataConf(reset=T)
     NMdataConf(as.fun="data.table")
-    NMdataConf(file.mod=function(x)sub("\\.lst$",".ctl",x))
+### ctl file naming is supported by default now
+    ## NMdataConf(file.mod=function(x)sub("\\.lst$",".ctl",x))
     NMdataConf(check.time=FALSE)
 
     fileRef <- "testReference/NMscanData_25.rds"