NMscanInput: all combinations of translate and recover.cols supported

NEWS.md

@@ -3,11 +3,14 @@
 * NMreadExt is a new function that reads parameter estimates,
   uncertainties if available, estimation iterations and other
   information from .ext files. 
+* NMscanInput now supports all combinations of `translate` and
+  `recover.cols`.
 
 ## Other improvements
 * NMreadCsv supports multiple prioritized formats in the `format`
   arguments.
 
+
 # 0.1.1
 ## New features
 * NMwriteSection can now handle functions to perform control stream

R/NMgenText.R

@@ -58,7 +58,8 @@
 ##'     text. If missing or NULL, strwrap will be called with default
 ##'     value. If negative or zero, strwrap will not be called.
 ##' @param quiet Hold messages back? Default is defined by NMdataConf.
-##' @return Text for inclusion in Nonmem control stream, invisibly.
+##' @return Text for inclusion in Nonmem control stream, invisibly. A
+##'     list with elements `DATA` and `INPUT`.
 ##' @family Nonmem
 ##' @export
 

R/NMscanInput.R

@@ -4,15 +4,11 @@
 ##' This function finds and reads the input data based on a control
 ##' stream file path. It can align the column names to the definitions
 ##' in $INPUT in the control stream, and it can subset the data based
-##' on ACCEPT/IGNORE statements in $DATA. I supports a few other ways
+##' on ACCEPT/IGNORE statements in $DATA. It supports a few other ways
 ##' to identify the input data file than reading the control stream,
-##' and it can also read an rds file instead of the delimited text
-##' file used by Nonmem.
+##' and it can also read an rds or fst file instead of the delimited
+##' text file used by Nonmem.
 ##' 
-##' @description Based on a Nonmem run (lst and/or mod file), this
-##'     function finds the input data and reads it. It reads the data
-##'     like the Nonmem run by applying DROP/SKIP arguments and
-##'     alternative naming of columns in the Nonmem run.
 ##' @param file a .lst (output) or a .mod (input) control stream
 ##'     file. The filename does not need to end in .lst. It is
 ##'     recommended to use the output control stream because it
@@ -175,22 +171,6 @@ NMscanInput <- function(file, formats.read, file.mod, dir.data=NULL,
 
     data.input <- NMreadCsv(path.data.input,as.fun="data.table",args.fread=args.fread,args.fst=args.fst,format=type.file)
 
-    ## type.file <- NA_character_
-    ## if(use.rds && info.datafile$exists.file.rds){
-    ##     type.file <- "rds"
-    ##     if(!quiet) message(paste0("Read rds input data file:\n",info.datafile$path.rds,"."))
-    ##     path.data.input <- info.datafile$path.rds
-    ##     data.input <- as.data.table(readRDS(path.data.input))
-    ## } else {
-    ##     if(file.exists(info.datafile$path)){
-    ##         type.file <- "text"
-    ##         if(!quiet) message(paste0("Read delimited text input data file:\n",info.datafile$path,"."))
-    ##         path.data.input <- info.datafile$path
-    ##         data.input <- NMreadCsv(path.data.input,args.fread=args.fread,as.fun="data.table")
-    ##     } else {
-    ##         stop(paste("Input data file not found. Was expecting to find",info.datafile$path))
-    ##     }
-    ## }
 
     ## keeping a backup before translating column names and filtering
     ## rows. This is used for very litle which should be done here

R/NMtransInp.R

@@ -17,9 +17,6 @@
 ## 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
@@ -31,7 +28,8 @@ NMtransInp <- function(data,file,translate=TRUE,recover.cols=TRUE){
 
     stopifnot(is.data.table(data))
 
-    if( !translate && !recover.cols ) {messageWrap("recover.rows=FALSE is only allowed when translate=TRUE.",fun.msg=stop)}
+#### this should be supported now
+    ##    if( !translate && !recover.cols ) {messageWrap("recover.rows=FALSE is only allowed when translate=TRUE.",fun.msg=stop)}
 
     ## According to NM manual IV-1, $INPUT and $INFILE are the same thing.    
     lines <- NMreadSection(file,section="INPUT",keep.name=FALSE,keep.comments=FALSE,clean.spaces=TRUE)
@@ -48,14 +46,18 @@ NMtransInp <- function(data,file,translate=TRUE,recover.cols=TRUE){
     line <- gsub(" +"," ",paste(lines,collapse=" "))
     line <- sub("^ ","",line)
     line <- sub(" $","",line)
+    ## not sure what DV =A would do but it may be valid, so reduce to DV=A
+    line <- sub(" *= *","=",line)
+
 
 ### nms is the names of columns as in nonmem control stream
     nms <- strsplit(line," ")[[1]]
     nms0 <- nms
 
 
 ### this is to keep even dropped columns
-    nms <- sub("(.*) *= *(DROP|SKIP)","\\1",nms)
+    idx.drop <- grep("=(DROP|SKIP)",nms0)
+    nms <- sub("(.*)=(DROP|SKIP)","\\1",nms)
     ## For now, we just take the first name used in A=B labeling. 
     renamed.from <- NULL
     renamed.to <- NULL
@@ -83,7 +85,6 @@ NMtransInp <- function(data,file,translate=TRUE,recover.cols=TRUE){
             data <- data[,1:length(nms)]
             cnames.input <- cnames.input[1:length(nms)]
         }
-
         colnames(data) <- cnames.input
 
         ## add the synononyms
@@ -111,10 +112,16 @@ NMtransInp <- function(data,file,translate=TRUE,recover.cols=TRUE){
 
             data <- data[,unique(cnames.input),with=FALSE]
         }
-        
+    }
 
+    ## if(!translate && !recover.cols){
+    ##     data <- data[,1:length(nms)]
+    ## }
+    if(!recover.cols){
+        data <- data[,1:length(nms)]
     }
-
+
+
     length.max <- max(length(cnames.input.0), ## datafile
                       length(nms0),       ## DATA
                       length(nms1),       ## nonmem

devel/todo.org

@@ -10,6 +10,9 @@
     has no benefit over NULL, so redundant and prevents the use of "default" as an actual param value.
 *** DONE Allow for say input.txt/output.txt
 **** NMtransInput
+*** TODO Support a drop argument
+It has been initiated in the code. I believe it can be finished after
+the translate part. The colnames table is the trickier part to update.
 *** DONE Support for return as tibble or whatever
 Could we use an option, NMdata.return="dplyr::as.tibble" which could then be
 reached and applied from within NMdata? It would have to not create extra
@@ -476,6 +479,13 @@ A way to limit rows read into nonmem
 ***** tolower(nonmem)==tolower(input) OK
 ***** diff
 ***** off
+*** NMreadExt
+**** DONE Include model column same way as NMscanData
+**** DONE Support multiple files
+**** DONE Intro arg return
+Something like
+if return="estimates" only return pars
+if return="iterations" only return iterations
 *** NMreadTab
 **** TODO [#B] Include metadata
 ***** TODO Include path to file

tests/testthat/test_NMscanInput.R

@@ -54,7 +54,7 @@ test_that("input has NMdata meta data",{
     fix.time(res)
     nm1 <- NMinfo(res)
     expect_equal_to_reference(nm1,fileRef,version=2)
-## readRDS(fileRef)$tables; nm1$tables    
+    ## readRDS(fileRef)$tables; nm1$tables    
 
 })
 
@@ -198,3 +198,72 @@ test_that("Missing control stream",{
     expect_error(NMscanInput("testData/nonmem/doesnotexist.mod"))
 })
 
+test_that("apply.filters=F and recover.rows=FALSE",{
+
+    fileRef <- "testReference/NMscanInput_11.rds"
+    file.lst <- system.file("examples/nonmem/xgxr002.lst",package="NMdata")
+
+    ## res <- NMscanInput(file=file.lst,applyFilters = T,as.fun="none")
+### using as.data.table for as.fun is not recommended but still allowed
+    res <-
+        NMscanInput(file=file.lst,apply.filters = F,as.fun="data.table",recover.cols=FALSE)
+
+    fix.time(res)
+    nm1 <- NMinfo(res)
+    expect_equal_to_reference(nm1,fileRef,version=2)
+})
+
+test_that("Space CYCLE =DROP",{
+    NMdataConf(reset=TRUE)
+    fileRef <- "testReference/NMscanInput_12.rds"
+    file.mod <- "testData/nonmem/xgxr030.mod"
+
+    ## res <- NMscanInput(file=file.lst,applyFilters = T,as.fun="none")
+### using as.data.table for as.fun is not recommended but still allowed
+    res <-
+        NMscanInput(file=file.mod,file.mod=identity,apply.filters = F,as.fun="data.table",recover.cols=FALSE)
+
+    fix.time(res)
+    nm1 <- NMinfo(res)
+    expect_equal_to_reference(nm1,fileRef,version=2)
+})
+
+
+test_that("Combinations of translate and recover.cols",{
+    NMdataConf(reset=TRUE)
+    fileRef <- "testReference/NMscanInput_13.rds"
+    file.mod <- "testData/nonmem/xgxr030.mod"
+
+### using as.data.table for as.fun is not recommended but still allowed
+    res1 <-
+        NMscanInput(file=file.mod,file.mod=identity,apply.filters = F,as.fun="data.table",
+                    translate=FALSE,recover.cols=FALSE)
+    ## colnames(res1)
+    ## NMinfo(res1,"input.colnames")
+
+    res2 <-
+        NMscanInput(file=file.mod,file.mod=identity,apply.filters = F,as.fun="data.table",
+                    translate=FALSE,recover.cols=TRUE)
+    ## colnames(res2)
+    ## NMinfo(res2,"input.colnames")
+
+    res3 <-
+        NMscanInput(file=file.mod,file.mod=identity,apply.filters = F,as.fun="data.table",
+                    translate=TRUE,recover.cols=FALSE)
+    ## colnames(res3)
+    ## NMinfo(res3,"input.colnames")
+
+
+    res4 <-
+        NMscanInput(file=file.mod,file.mod=identity,apply.filters = F,as.fun="data.table",
+                    translate=TRUE,recover.cols=TRUE)
+    ## colnames(res4)
+    ## NMinfo(res4,"input.colnames")
+
+
+    all.res <- list(res1,res2,res3,res4)
+    all.res <- lapply(all.res,fix.time)
+
+    expect_equal_to_reference(res,fileRef,version=2)
+})
+