correction of check tables, docu and test

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: NMdata
 Type: Package
 Title: Preparation, Checking and Post-Processing Data for PK/PD Modeling
-Version: 0.1.8.933
+Version: 0.1.8.941
 Authors@R:
   c(person(given="Philip", family="Delff",email = "[email protected]",role = c("aut", "cre")),
     person("Brian", "Reilly", email = "[email protected]",role = c("ctb")),

R/NMcheckData.R

@@ -472,7 +472,11 @@ NMcheckData <- function(data,file,covs,covs.occ,cols.num,col.id="ID",
             setorderv(findings,c(c.row,"column","check"))
 
 
-            summary.findings <- findings[,.(.N,Nid=uniqueN(get(col.id)[!is.na(get(col.id))])),by=.(column,check)]
+            summary.findings <- findings[,.(Nids=uniqueN(get(col.id)[!is.na(get(col.id))]),Nrows=.N),by=.(level,check,column)]
+            summary.findings[level=="column",Nids:=NA]
+            summary.findings[level=="column",Nrows:=NA]
+            summary.findings[level=="ID",Nrows:=NA]
+            summary.findings[,level:=NULL]
 
             if(!quiet) print(summary.findings,row.names=FALSE)
 

R/NMreadInits.R

@@ -209,7 +209,12 @@ count_ij <- function(res){
 ##' @param section The section to read. Typically, "theta", "omega",
 ##'     or "sigma". Default is those three.
 ##' @param as.fun See ?NMscanData
-##' @keywords internal
+##' @return By default (when \code{return="pars"}, a parameter table
+##'     with initial values, FIX, lower and upper bounds etc. In most
+##'     cases, that is what is needed to derive information about
+##'     parameter definitions. If \code{return="all"}, two additional
+##'     tables are returned which can be used if the aim is to modify
+##'     and write the resulting parameters to a control stream.
 ##' @export
 NMreadInits <- function(file,lines,section,return="pars",as.fun) {
 

R/NMwriteData.R

@@ -44,8 +44,8 @@
 ##'     removed. RData is not a adequate format for a dataset (but is
 ##'     for environments). Please use write.rds instead.
 ##' @param genText Run and report results of NMgenText? Default is
-##'     TRUE. You may want to disable this if data set is not for
-##'     Nonmem.
+##'     `TRUE` if a csv file is written, otherwise `FALSE`. You may
+##'     want to disable this if data set is not for Nonmem.
 ##' @param save Save defined files? Default is TRUE. If a variable is
 ##'     used to control whether a script generates outputs (say
 ##'     \code{writeOutputs=TRUE/FALSE)}, if you use
@@ -104,7 +104,7 @@ NMwriteData <- function(data,file,formats.write=c("csv","rds"),
                         script,args.stamp,
                         args.fwrite, args.rds, args.RData, args.write_fst,
                         quiet,args.NMgenText,csv.trunc.as.nm=FALSE,
-                        genText=TRUE,
+                        genText,
                         save=TRUE,
 ### deprecated write.xxx arguments
                         write.csv,write.rds,
@@ -172,6 +172,9 @@ NMwriteData <- function(data,file,formats.write=c("csv","rds"),
     write.csv <- "csv" %in% formats.write
     write.RData <- "rdata" %in% formats.write
     write.fst <- "fst" %in% formats.write
+
+    if(missing(genText)) genText <- NULL
+    if(is.null(genText)) genText <- "csv"%in%formats.write
 
     name.data <- deparse(substitute(data))
 
@@ -291,6 +294,7 @@ NMwriteData <- function(data,file,formats.write=c("csv","rds"),
         }
     }
 
+
 ### csv.trunc.as.nm
     if(csv.trunc.as.nm && !genText){
         messageWrap("when csv.trunc.as.nm==TRUE, genText must be TRUE too. Use quiet=TRUE to avoid text in console.",fun.msg=stop)

R/NMwriteSectionOne.R

@@ -42,7 +42,7 @@ NMwriteSectionOne <- function(file0,lines,section,location=c("replace","before",
     ## put this part in a function to be sequentially applied for all elements in list.
     replaceOnePart <- function(lines,section,newlines,quiet=FALSE){
 
-        if(!quiet && !is.null(newfile)) message(paste("Writing",newfile))
+        if(!quiet && write) message(paste("Writing",newfile))
 
         ## make sure section is capital and does not start with $.
         section <- gsub(" ","",section)

tests/testthat/test_NMcheckData.R

@@ -32,21 +32,24 @@ fix.time <- function(x,meta=T){
     x
 }
 
+quiet <- TRUE
 
 test_that("basic",{
     fileRef <- "testReference/NMcheckData_1.rds"
 
     pk <- readRDS(file="testData/data/xgxr2.rds")
-    res <- NMcheckData(pk, quiet=TRUE)
+    res <- NMcheckData(pk, quiet=quiet)
 
     expect_equal_to_reference(res,fileRef,version=2)
 })
 
+
+
 test_that("No col.flagn",{
     fileRef <- "testReference/NMcheckData_2.rds"
 
     pk <- readRDS(file="testData/data/xgxr2.rds")
-    res <- NMcheckData(pk,col.flagn=FALSE, quiet=TRUE)
+    res <- NMcheckData(pk,col.flagn=FALSE, quiet=quiet)
     expect_equal_to_reference(res,fileRef,version=2)
 })
 
@@ -59,7 +62,7 @@ test_that("Misc findings",{
     ## a comma in a string - but with FLAG>0
     pk[2,ret.4:="3,mg"]
 
-    res <- NMcheckData(pk, quiet=TRUE)
+    res <- NMcheckData(pk, quiet=quiet)
     expect_equal_to_reference(res,fileRef,version=2)
 
 })
@@ -73,7 +76,7 @@ test_that("TIME with characters",{
     pk[,TIME:=as.character(TIME)]
     pk[ROW==204,TIME:=paste0(TIME,"p")]
 
-    res <- NMcheckData(pk, quiet=TRUE)
+    res <- NMcheckData(pk, quiet=quiet)
     expect_equal_to_reference(res,fileRef,version=2)
 
 })
@@ -90,7 +93,7 @@ test_that("Misc findings and dup colname",{
     colnames(pk)[22] <- "NAME"
     pk[2,ret.4:="3,mg"]
 
-    res <- expect_warning(NMcheckData(pk, quiet=TRUE))
+    res <- expect_warning(NMcheckData(pk, quiet=quiet))
     expect_equal_to_reference(res,fileRef,version=2)
 
 })
@@ -101,7 +104,7 @@ test_that("missing EVID",{
     pk <- readRDS(file="testData/data/xgxr2.rds")
     pk[,EVID:=NULL]
 
-    res <- NMcheckData(pk, quiet=TRUE)
+    res <- NMcheckData(pk, quiet=quiet)
     expect_equal_to_reference(res,fileRef,version=2)
 
 })
@@ -112,7 +115,7 @@ test_that("missing ID",{
     pk <- readRDS(file="testData/data/xgxr2.rds")
     pk[,ID:=NULL]
 
-    expect_error( NMcheckData(pk, quiet=TRUE))
+    expect_error( NMcheckData(pk, quiet=quiet))
 })
 
 test_that("missing MDV",{
@@ -121,7 +124,7 @@ test_that("missing MDV",{
     pk <- readRDS(file="testData/data/xgxr2.rds")
     pk[,MDV:=1]
 
-    res <- NMcheckData(pk, quiet=TRUE)
+    res <- NMcheckData(pk, quiet=quiet)
     expect_equal_to_reference(res,fileRef,version=2)
     ##         expect_equal(as.data.table(res)[level=="row"],as.data.table(readRDS(fileRef))[level=="row"])
 })
@@ -133,7 +136,7 @@ test_that("With ADDL, no II",{
     pk <- readRDS(file="testData/data/xgxr2.rds")
     pk[EVID==1,ADDL:=1]
 
-    res <- NMcheckData(pk, quiet=TRUE)
+    res <- NMcheckData(pk, quiet=quiet)
     expect_equal_to_reference(res,fileRef,version=2)
 })
 
@@ -144,7 +147,7 @@ test_that("With II, no ADDL",{
     pk <- readRDS(file="testData/data/xgxr2.rds")
     pk[EVID==1,II:=24]
 
-    res <- NMcheckData(pk, quiet=TRUE)
+    res <- NMcheckData(pk, quiet=quiet)
     expect_equal_to_reference(res,fileRef,version=2)
 })
 
@@ -166,7 +169,7 @@ test_that("ID and row with leading 0",{
 
 
 
-    res <- NMcheckData(pk, quiet=TRUE)
+    res <- NMcheckData(pk, quiet=quiet)
     ## res
     expect_equal_to_reference(res,fileRef,version=2)
 })
@@ -183,7 +186,7 @@ test_that("One covariate varying within ID",{
     pk <- readRDS(file="testData/data/xgxr2.rds")    
 
     pk[1500,WEIGHTB:=30]  
-    res <- NMcheckData(pk,covs=c("trtact","WEIGHTB","CYCLE","DOSE"), quiet=TRUE)
+    res <- NMcheckData(pk,covs=c("trtact","WEIGHTB","CYCLE","DOSE"), quiet=quiet)
     ## res
     expect_equal_to_reference(res,fileRef,version=2)
 })
@@ -204,7 +207,7 @@ test_that("with IOV",{
                  pk.fed)
     pk2[,ROW:=.I]
 
-    res <- NMcheckData(pk2,covs.occ=list(PERIOD=c("FED")),cols.num="REE", quiet=TRUE)
+    res <- NMcheckData(pk2,covs.occ=list(PERIOD=c("FED")),cols.num="REE", quiet=quiet)
     expect_equal_to_reference(res,fileRef,version=2)
 
 })
@@ -221,7 +224,7 @@ test_that("covariates within subsets",{
     pk[EVID==1,ASSAY:=c(rep(NA,3),1,rep(NA,.N-4))]
 
     ## it finds way too many for ASSAY. Should only find 1.
-    res <- NMcheckData(pk,cols.num=list("EVID==0"=c("LLOQ","ASSAY"),"EVID==1"=c("site"),"WEIGHTB"), quiet=TRUE)
+    res <- NMcheckData(pk,cols.num=list("EVID==0"=c("LLOQ","ASSAY"),"EVID==1"=c("site"),"WEIGHTB"), quiet=quiet)
     expect_equal_to_reference(res,fileRef,version=2)
 
 })
@@ -235,7 +238,7 @@ test_that("numerical coded as char and NA as .",{
     pk <- readRDS(file="testData/data/xgxr5.rds")
 
     ## it finds way too many for ASSAY. Should only find 1.
-    res <- NMcheckData(pk,na.strings=NULL, quiet=TRUE)
+    res <- NMcheckData(pk,na.strings=NULL, quiet=quiet)
     expect_equal_to_reference(res,fileRef,version=2)
 
 })
@@ -249,7 +252,7 @@ test_that("usubjid OK",{
     pk[,usubjid:=paste0("100-",ID)]
 
     ## it finds way too many for ASSAY. Should only find 1.
-    res <- NMcheckData(pk,col.usubjid="usubjid", quiet=TRUE)
+    res <- NMcheckData(pk,col.usubjid="usubjid", quiet=quiet)
     expect_equal_to_reference(res,fileRef,version=2)
 
 
@@ -267,7 +270,7 @@ test_that("ID not unique",{
 
 
     ## it finds way too many for ASSAY. Should only find 1.
-    res <- NMcheckData(pk,col.usubjid="usubjid", quiet=TRUE)
+    res <- NMcheckData(pk,col.usubjid="usubjid", quiet=quiet)
     expect_equal_to_reference(res,fileRef,version=2)
 
 
@@ -286,7 +289,7 @@ test_that("usubjid not unique",{
 
 
     ## it finds way too many for ASSAY. Should only find 1.
-    res <- NMcheckData(pk,col.usubjid="usubjid", quiet=TRUE)
+    res <- NMcheckData(pk,col.usubjid="usubjid", quiet=quiet)
     expect_equal_to_reference(res,fileRef,version=2)
 })
 
@@ -295,10 +298,10 @@ test_that("no col.flagn",{
 
     pk <- readRDS(file="testData/data/xgxr2.rds")
     pk <- pk[FLAG==0]
-    res1 <- NMcheckData(pk, quiet=TRUE)
+    res1 <- NMcheckData(pk, quiet=quiet)
 
     pk[,FLAG:=NULL]
-    res2 <- NMcheckData(pk, quiet=TRUE)
+    res2 <- NMcheckData(pk, quiet=quiet)
     expect_equal(res1,res2)
 })
 
@@ -316,8 +319,8 @@ dups_data <- data.frame(
 
 
 test_that("check data files without cols.dup, but passed with it",{
-    no_dup_specified <- NMcheckData(dups_data, quiet=TRUE)
-    dup_specified <- NMcheckData(dups_data, cols.dup = "DVID", quiet=TRUE)
+    no_dup_specified <- NMcheckData(dups_data, quiet=quiet)
+    dup_specified <- NMcheckData(dups_data, cols.dup = "DVID", quiet=quiet)
 
     expect_equal(nrow(no_dup_specified), 2)
     expect_equal(nrow(dup_specified), 0)
@@ -332,7 +335,7 @@ test_that("simulation data",{
 
     dt.all <- rbind(dt.dos,dt.sim,fill=T)
 
-    res <- NMcheckData(dt.all, quiet=TRUE,type.data="sim")
+    res <- NMcheckData(dt.all, quiet=quiet,type.data="sim")
     ## nrow(res)
     expect_equal(nrow(res),0)
 
@@ -349,7 +352,7 @@ test_that("empty data set",{
 
 
     ## it finds way too many for ASSAY. Should only find 1.
-    res <- NMcheckData(pk,col.usubjid="usubjid", quiet=TRUE)
+    res <- NMcheckData(pk,col.usubjid="usubjid", quiet=quiet)
 
     expect_equal_to_reference(res,fileRef)
 })
@@ -360,8 +363,19 @@ test_that("disable column",{
 
     pk <- readRDS(file="testData/data/xgxr2.rds")
     pk$CMT <- NULL
-    res <- NMcheckData(pk, quiet=TRUE,cols.disable="CMT")
+    res <- NMcheckData(pk, quiet=quiet,cols.disable="CMT")
 
     res
     expect_equal_to_reference(res,fileRef,version=2)
 })
+
+test_that("ID-level",{
+    fileRef <- "testReference/NMcheckData_22.rds"
+
+    pk <- readRDS(file="testData/data/xgxr2.rds")
+    pk2 <- pk[TRTACT!="3 mg"]
+    pk3 <- pk2[!(ID<100&EVID==1)]
+    res <- NMcheckData(pk3, quiet=quiet)
+
+    expect_equal_to_reference(res,fileRef,version=2)
+})

tests/testthat/test_NMwriteData.R

@@ -40,6 +40,7 @@ test_that("nm.drop is an empty string - not allowed",{
                           ,file="testOutput/NMwriteDataTmp.csv"
                           ,write.rds=F,write.csv=F
                           ,nm.drop=""
+                          ,genText=TRUE
                            ## ,args.rds=list(version=2)
                            )
     )
@@ -50,9 +51,10 @@ test_that("Dropping a column in Nonmem",{
     fileRef <- "testReference/NMwriteData_2.rds"
     pk <- readRDS(file=system.file("examples/data/xgxr2.rds",package="NMdata"))
     res2 <- NMwriteData(pk,file="testOutput/NMwriteDataTmp.csv",
-                        write.rds=F,write.csv=F,
-                        nm.drop="PART",
-                        nmdir.data="/example")
+                        save=FALSE,
+                        nm.drop="PART"
+                       ,genText=TRUE
+                       ,nmdir.data="/example")
     res2 <- fix.input(res2)
 
     expect_equal_to_reference(
@@ -64,8 +66,9 @@ test_that("Dropping a column in Nonmem",{
     fileRef <- "testReference/NMwriteData_3.rds"
 
     res2b <- NMwriteData(pk,file="testOutput/NMwriteDataTmp.csv",
-                         write.rds=F,write.csv=F,
-                         nm.drop="CYCLE",
+                         save=FALSE,
+                        ,genText=TRUE
+                        ,nm.drop="CYCLE",
                          nmdir.data="/example")
     res2b <- fix.input(res2b)
 
@@ -112,7 +115,8 @@ test_that("nm.copy, nm.rename, drop",{
     ##    pk <- readRDS(system.file("examples/data/xgxr1.rds",package="NMdata"))
     pk <- readRDS(file=system.file("examples/data/xgxr2.rds",package="NMdata"))
     nmCode <- NMwriteData(pk,file="testOutput/NMwriteDataTmp.csv",
-                          write.csv=FALSE,
+                          write.csv=FALSE
+                         ,genText=TRUE,
 ### arguments that tailors text for Nonmem
                           ## PSN compatibility
                           args.NMgenText=list(dir.data="../derived",drop="PROFDAY",copy=c(CONC="DV"),rename=c(BBW="WEIGHTB"),capitalize=TRUE,width=80),args.rds=list(version=2))
@@ -152,12 +156,18 @@ test_that("with stamp",{
     pk <- readRDS(file=system.file("examples/data/xgxr2.rds",package="NMdata"))
 
     res1 <- NMwriteData(pk,file=NULL,
-                        write.rds=F,write.csv=F,nmdir.data="/example",script="A simple test")
+                        save=FALSE,
+                        genText=T,
+                        nmdir.data="/example",script="A simple test")
     res1 <- fix.input(res1)
 
     expect_equal_to_reference(
         res1
        ,fileRef,version=2)
+
+    if(F){
+        readRDS(fileRef)
+    }
 })
 
 test_that("with stamp on csv",{
@@ -336,6 +346,6 @@ test_that("Non-numeric DATE and TIME",{
     if(F){
         ref <- readRDS(fileRef)
         compareCols(res,ref)
-}
+    }
 
 })