Merge pull request #172 from nlmixr2/vanco

Vanco

Author: mattfidler

.github/workflows/R-CMD-check.yaml

@@ -50,6 +50,7 @@ jobs:
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
+          cache-version: 3
           pak-version: devel
           extra-packages: |
             any::rcmdcheck

.github/workflows/pkgdown.yaml

@@ -29,6 +29,7 @@ jobs:
           use-public-rspm: true
 
       - uses: r-lib/actions/setup-r-dependencies@v2
+        cache-version: 2
         with:
           extra-packages: |
             any::pkgdown

.github/workflows/test-coverage.yaml

@@ -23,6 +23,7 @@ jobs:
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
+          cache-version: 2
           pak-version: devel
           extra-packages: |
             any::covr

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: nonmem2rx
 Type: Package
 Title: 'nonmem2rx' Converts 'NONMEM' Models to 'rxode2'
-Version: 0.1.3
+Version: 0.1.3.9000
 Maintainer: Matthew Fidler <matthew.fidler@gmail.com>
 Authors@R: c(person("Matthew","Fidler", role = c("aut", "cre"), email = "matthew.fidler@gmail.com", comment=c(ORCID="0000-0001-8538-6691")),
     person("Philip", "Delff", email = "philip@delff.dk",role = c("ctb")),
@@ -63,7 +63,7 @@ Suggests:
     rmarkdown,
     spelling
 Config/testthat/edition: 3
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Roxygen: list(markdown = TRUE)
 VignetteBuilder: knitr
 Language: en-US

NEWS.md

@@ -1,3 +1,24 @@
+# nonmem2rx (development version)
+
+* Read all NONMEM files using latin1 encoding to allow single byte
+  parser to work
+
+* When lines in the NONMEM input dataset start with `#` they are now
+  ignored.
+
+* When all IDs are zero, NONMEM assumes restarting
+  time gives different IDs; this is now reflected in NONMEM
+  translation of IDs.
+
+* With `linCmt()` parsing, expand the scope of conflicting parameters
+  that will be renamed with an import.
+
+* Added better parsing for `ELSE` where there is another `IF` on the
+  next line.
+
+* Prefixed conflicting `VP` with `rxm.` when `linCmt()` models to be
+  more accommodating when importing linear compartment models.
+
 # nonmem2rx 0.1.3
 
 * Added explicit requirement for rxode2 2.0.13

R/RcppExports.R

@@ -1,7 +1,7 @@
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 
-fromNonmemToRxId <- function(nonmemId) {
-    .Call(`_nonmem2rx_fromNonmemToRxId`, nonmemId)
+fromNonmemToRxId_ <- function(nonmemId, time) {
+    .Call(`_nonmem2rx_fromNonmemToRxId_`, nonmemId, time)
 }
 

R/asNonmem2rx.R

@@ -88,7 +88,7 @@ as.nonmem2rx <- function(model1, model2, compress=TRUE) {
   if (length(.w) == 1L) {
     .wcmt <- which(tolower(names(.nonmemData)) == "cmt")
     .wevid <- which(tolower(names(.nonmemData)) == "evid")
-    if (length(.wcmt) == 1L && length(.wevid) == 1L) {
+    if (length(.wcmt) == 1L && length(.wevid) == 1L) {e
       .minfo("merging 'dvid' with nlmixr2 'cmt' definition")
       .nonmemData[,.wcmt] <- ifelse(.nonmemData[, .wevid] != 0, .nonmemData[,.wcmt],
                                     length(.ui$mv0$state) + .nonmemData[, .w])

R/fromNonmemToRxId.R

@@ -0,0 +1,13 @@
+#' Converts to NONMEM id based on ID and time
+#'
+#' @param id identifier
+#' @param time time
+#' @return nothing, called for side effects
+#' @noRd
+#' @author Matthew L. Fidler
+fromNonmemToRxId <- function(id, time=NULL) {
+  if (is.null(time)) {
+    time <- as.double(seq_along(id))
+  }
+  .Call(`_nonmem2rx_fromNonmemToRxId_`, as.integer(id), as.double(time))
+}

R/linCmt.R

@@ -1,6 +1,6 @@
 
 # comes from rxDerived regexp
-.linCmtParReg <- "^(?:(?:(?:V|Q|VP|VT|CLD)[[:digit:]])|KA|VP|VT|CLD|V|VC|CL|VSS|K|KE|KEL|Q|VT|(?:K[[:digit:]][[:digit:]])|AOB|ALPHA|BETA|GAMMA|A|B|C)$"
+.linCmtParReg <- "^(?:(?:(?:V|Q|VP|VT|CLD)[[:digit:]])|KA|VP|VT|CLD|V|VC|CL|VSS|K|KE|KEL|Q|VT|(?:K[[:digit:]][[:digit:]])|AOB|ALPHA|BETA|GAMMA|A|B|C).*$"
 
 # translations to rxode2
 
@@ -80,14 +80,14 @@
           if (length(.w2) == 1) {
             names(.rep)[.w] <- paste0("V", .nonmem2rx$abbrevLin)
           } else if (length(.nonmem2rx$allVol) > 0) {
-            .nchar <- vapply(.nonmem2rx$allVol, function(i){
+            .nchar <- vapply(.nonmem2rx$allVol, function(i) {
               nchar(.nonmem2rx$allVol[i])
             }, integer(1), USE.NAMES=FALSE)
             .min <- min(.nchar)
             .w2 <- which(.nchar == .min)[1]
             names(.rep)[.w] <- .nonmem2rx$allVol[.w2]
           } else {
-           stop("can't figure out volume for linCmt() model", call.=FALSE) #nocov
+            stop("can't figure out volume for linCmt() model", call.=FALSE) #nocov
           }
         }
       }
@@ -97,9 +97,7 @@
   # specified and could be different
   .mv <- rxode2::rxModelVars(model)
   .lhs <- toupper(.mv$lhs)
-  .rest <- setdiff(.lhs, names(.rep))
-  .w <- which(.rest %in% toupper(.lhs))
-  .lhsIn <- .mv$lhs[.w]
+  .lhsIn <- .mv$lhs
   .lhsOut <- vapply(.lhsIn, function(x) {
     .up <- toupper(x)
     if (.up %in% names(.rep)) return(.rep[.up])
@@ -111,6 +109,7 @@
   .w <- which(.lhsIn != .lhsOut)
   .lhsIn <- .lhsIn[.w]
   .lhsOut <- .lhsOut[.w]
+
   .ret <- eval(parse(text=paste0("rxode2::rxRename(model,",paste(paste0(.lhsOut, "=", .lhsIn), collapse=", "),")")))
   .ret <- rxode2::rxUiDecompress(.ret)
   .lstExpr <- .ret$lstExpr
@@ -149,5 +148,13 @@
   .fun0 <- as.call(c(list(quote(`{`)), .ini, .model))
   .fun <- function() {}
   body(.fun) <- .fun0
-  .fun()
+  .ret <- try(.fun(), silent=TRUE)
+  if (inherits(.ret, "try-error")) {
+    message(paste(deparse(.fun), collapse="\n"))
+    stop("error parsing linCmt() translation:\n",
+         attr(.ret, "condition")$message,
+         "\ntranslation printed out so far",
+         call.=FALSE)
+  }
+  .ret
 }

R/lst.R

@@ -60,7 +60,7 @@
       return(NULL)
     }
   }
-  return(.nmlst$section)
+  .nmlst$section
 }
 
 .nmlstVersion <- function(line) {
@@ -232,7 +232,7 @@
     }
     return(NULL)
   }
-  return(TRUE)
+  TRUE
 }
 
 
@@ -259,7 +259,7 @@
     }
     return(NULL)
   }
-  return(TRUE)
+  TRUE
 }
 
 .prepareEst <- function() {
@@ -371,9 +371,7 @@
   if (is.null(.nmlstObj(line))) return(NULL)
   if (is.null(.nmlstEst(line))) return(NULL)
   if (is.null(.nmlstCov(line))) return(NULL)
-
-  return(NULL)
-
+  NULL
 }
 
 .resetLst <- function(strictLst) {
@@ -421,7 +419,7 @@ nmlst <- function(file, strictLst=FALSE) {
   # run time
   # nmtran message
   if (length(file) == 1L) {
-    .lst <- suppressWarnings(readLines(file))
+    .lst <- suppressWarnings(readLines(file, encoding="latin1"))
   } else {
     .lst <-file
   }

R/nminfo.R

@@ -146,7 +146,7 @@ nminfo <- function(file,
     if (!file.exists(.lstFile)) {
       if (file.exists(file)) {
         if (verbose) .minfo("seeing if file argument is actually lst file")
-        .fileLines <- suppressWarnings(readLines(file))
+        .fileLines <- suppressWarnings(readLines(file, encoding="latin1"))
         .w <- which(regexpr("^( *NM-TRAN +MESSAGES *| *1NONLINEAR *MIXED|License +Registered +to: +)", .fileLines)!=-1)
         if (length(.w) == 0L) {
           .wpro <- which(regexpr("^ *[$][Pp][Rr][Oo]", .fileLines) != -1)
@@ -173,7 +173,7 @@ nminfo <- function(file,
         .nmlst$section <- .nmlst.tere
         .nmlst$tereOnly <- TRUE
         if (length(.lstFile) == 1L) {
-          .l <- suppressWarnings(readLines(.lstFile))
+          .l <- suppressWarnings(readLines(.lstFile, encoding="latin1"))
         } else {
           .l <- .lstFile
         }
@@ -220,7 +220,7 @@ nminfo <- function(file,
     # lonely control stream?
     if (file.exists(file)) {
       if (verbose) .minfo("is file actually control stream")
-      .fileLines <- suppressWarnings(readLines(file))
+      .fileLines <- suppressWarnings(readLines(file, encoding="latin1"))
       .wpro <- which(regexpr("^ *[$][Pp][Rr][Oo]", .fileLines) != -1)
       if (length(.wpro) != 0L) {
         .control <- .fileLines[seq(.wpro[1], length(.fileLines))]
@@ -239,7 +239,7 @@ nminfo <- function(file,
     .ctl <- paste0(.base, mod)
     if (verbose) .minfo("looking for control stream")
     if (file.exists(.ctl)) {
-      .fileLines <- suppressWarnings(readLines(file))
+      .fileLines <- suppressWarnings(readLines(file, encoding="latin1"))
       .wpro <- which(regexpr("^ *[$][Pp][Rr][Oo]", .fileLines) != -1)
       if (length(.wpro) != 0L) {
         .control <- .fileLines[seq(.wpro[1], length(.fileLines))]

R/nmtab.R

@@ -1,45 +1,45 @@
 #' Read nonmem table file
 #'
-#'  
+#'
 #' @param file file name to read the results from
 #' @param ... other parameters passed to `data.table::fread`
 #' @return data frame of the read table
-#' @export 
+#' @export
 #' @author Philip Delff, Matthew L. Fidler
 #' @examples
 #' nmtab(system.file("mods/cpt/runODE032.csv", package="nonmem2rx"))
-nmtab <- function (file, ...) 
+nmtab <- function (file, ...)
 {
   checkmate::assertFileExists(file)
   TABLE <- NULL
   NMREP <- NULL
-  colnames <- readLines(file, n=2)[2]
+  colnames <- readLines(file, n=2, encoding="latin1")[2]
   if (grepl(", *OMEGA\\( *1 *, *1\\)", colnames)) {
     col.names <- gsub(" ", "",strsplit(colnames, " +,")[[1]])
     dt1 <- fread(file, fill = TRUE, header = TRUE, skip = 1,
                  ...)
     dt1 <- dt1[,seq_along(col.names), with=FALSE]
     setnames(dt1, col.names)
   } else {
-    dt1 <- fread(file, fill = TRUE, header = TRUE, skip = 1, 
+    dt1 <- fread(file, fill = TRUE, header = TRUE, skip = 1,
                  ...)
   }
   cnames <- colnames(dt1)
   if (length(cnames) == 0L) return(NULL)
-  dt1[grep("^TABLE", as.character(get(cnames[1])), invert = FALSE, 
+  dt1[grep("^TABLE", as.character(get(cnames[1])), invert = FALSE,
            perl = TRUE), `:=`(TABLE, get(cnames[1]))]
   dt1[, `:=`(NMREP, cumsum(!is.na(TABLE)) + 1)]
   dt1[, `:=`(TABLE, NULL)]
-  dt1 <- dt1[grep("^ *[[:alpha:]]", as.character(get(cnames[1])), 
+  dt1 <- dt1[grep("^ *[[:alpha:]]", as.character(get(cnames[1])),
                   invert = TRUE, perl = TRUE)]
   cols.dup <- duplicated(colnames(dt1))
   if (any(cols.dup)) {
-    .minfo(paste0("Cleaned duplicated column names: ", 
+    .minfo(paste0("Cleaned duplicated column names: ",
                   paste(colnames(dt1)[cols.dup], collapse = ",")))
     dt1 <- dt1[, unique(cnames), with = FALSE]
   }
   cnames <- colnames(dt1)
   dt1[, `:=`((cnames), lapply(.SD, as.numeric))]
   dt1 <- as.data.frame(dt1)
-  return(dt1)
+  dt1
 }

R/nonmem2rx.R

@@ -744,7 +744,11 @@ nonmem2rx <- function(file, inputData=NULL, nonmemOutputDir=NULL,
                   .advan5odes(),
                    "\n})",
                    "}")
-    .fun <- eval(parse(text=.txt))
+    .fun <- try(eval(parse(text=.txt)), silent=TRUE)
+    if (inherits(.fun, "try-error")) {
+      message(.txt)
+      stop("error translating NONMEM, model translation so far echoed above", call.=FALSE)
+    }
     .rx <- .fun()
     .rx <- .getLinCmtModel(.rx, advan=.nonmem2rx$advan, trans=.nonmem2rx$trans)
     .update <- FALSE
@@ -778,7 +782,7 @@ nonmem2rx <- function(file, inputData=NULL, nonmemOutputDir=NULL,
       .in <-c(.mv$params, .mv$state, .mv$lhs)
       .w <- which(vapply(.r,
                          function(v) {
-                           return(v %in% .in)
+                           v %in% .in
                          }, logical(1), USE.NAMES=FALSE))
       if (length(.w) > 0) {
         .r <- .r[.w]

R/readCov.R

@@ -1,39 +1,39 @@
 #' Read in data file
-#'  
+#'
 #' @inheritParams nmtab
-#' 
+#'
 #' @return A matrix with covariance step from NONMEM
-#' 
+#'
 #' @export
-#' 
+#'
 #' @author Philip Delff and Matthew L. Fidler
-#' 
+#'
 #' @examples
-#' 
+#'
 #' nmcov(system.file("mods/cpt/runODE032.cov", package="nonmem2rx"))
 nmcov <- function (file, ...) {
   checkmate::assertFileExists(file)
   TABLE <- NULL
   NMREP <- NULL
   NAME <- NULL
-  colnames <- readLines(file, n=2)[2]
+  colnames <- readLines(file, n=2, encoding = "latin1")[2]
   if (grepl(", *OMEGA\\( *1 *, *1\\)", colnames)) {
     # in this case the NAME also has commas
-    lines <- readLines(file)
+    lines <- readLines(file, encoding="latin1")
     lines <- gsub("(OMEGA|SIGMA)[(]([0-9]+),([0-9]+)[)]", "\\1\\2AAAAAAAAA\\3", lines)
     file2 <- tempfile()
     writeLines(lines, file2)
-    dt1 <- fread(file2, fill = TRUE, header = TRUE, skip = 1, sep=",", 
+    dt1 <- fread(file2, fill = TRUE, header = TRUE, skip = 1, sep=",",
                  ...)
     unlink(file2)
     dt1$NAME <- gsub("[A]([0-9]+)AAAAAAAAA([0-9]+)", "A(\\1,\\2)", dt1$NAME)
     setnames(dt1, gsub("[A]([0-9]+)AAAAAAAAA([0-9]+)", "A(\\1,\\2)", names(dt1)))
   } else {
-    dt1 <- fread(file, fill = TRUE, header = TRUE, skip = 1, 
+    dt1 <- fread(file, fill = TRUE, header = TRUE, skip = 1,
                  ...)
   }
   cnames <- colnames(dt1)
-  dt1[grep("^TABLE", as.character(get(cnames[1])), invert = FALSE, 
+  dt1[grep("^TABLE", as.character(get(cnames[1])), invert = FALSE,
            perl = TRUE), `:=`(TABLE, get(cnames[1]))]
   dt1[, `:=`(NMREP, cumsum(!is.na(TABLE)) + 1)]
   dt1[, `:=`(TABLE, NULL)]
@@ -48,5 +48,5 @@ nmcov <- function (file, ...) {
   dn <- dimnames(dt1)
   dn[[1]] <- dn[[2]]
   dimnames(dt1) <- dn
-  return(dt1)
+  dt1
 }