Merge pull request #169 from nlmixr2/167-cran-maintainence

167 cran maintainence
nlmixr2 · Dec 9, 2023 · 61897c7 · 61897c7
2 parents fa5b0d0 + e4c5d41
commit 61897c7
Show file tree

Hide file tree

Showing 22 changed files with 329 additions and 136 deletions.
diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
@@ -2,9 +2,9 @@
 # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
 on:
   push:
-    branches: [main, master]
+    branches: main
   pull_request:
-    branches: [main, master]
+    branches: main
 
 name: R-CMD-check
 
@@ -61,7 +61,6 @@ jobs:
             nlmixr2/rxode2et
             nlmixr2/rxode2
           needs: check
-
       - uses: r-lib/actions/check-r-package@v2
         with:
           upload-snapshots: true
diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml
@@ -39,6 +39,10 @@ jobs:
             nlmixr2/rxode2random
             nlmixr2/rxode2et
             nlmixr2/rxode2
+            nlmixr2/nlmixr2est
+            nlmixr2/nlmixr2extra
+            nlmixr2/nlmixr2plot
+            nlmixr2/nlmixr2
             nlmixr2/babelmixr2
             nlmixr2/nlmixr2rpt
             lixoftConnectors=?ignore

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: nonmem2rx
 Type: Package
 Title: 'nonmem2rx' Converts 'NONMEM' Models to 'rxode2'
-Version: 0.1.2.9000
+Version: 0.1.3
 Maintainer: Matthew Fidler <matt.fidler@novartis.com>
 Authors@R: c(person("Matthew","Fidler", role = c("aut", "cre"), email = "matt.fidler@novartis.com", comment=c(ORCID="0000-0001-8538-6691")),
     person("Philip", "Delff", email = "philip@delff.dk",role = c("ctb")),
@@ -24,14 +24,14 @@ Description: 'NONMEM' has been a tool for running nonlinear mixed
     matrix) with a 'rxode2' model.  This is complementary to the
     'babelmixr2' package that translates 'nlmixr2' models to 'NONMEM' and can
     convert the objects converted from 'nonmem2rx' to a full 'nlmixr2' fit.
-License: GPL (>= 3) 
+License: GPL (>= 3)
 URL: https://nlmixr2.github.io/nonmem2rx/, https://github.com/nlmixr2/nonmem2rx/
 Encoding: UTF-8
-LinkingTo: 
+LinkingTo:
     dparser,
     Rcpp,
     rxode2parse
-Imports: 
+Imports:
     checkmate,
     digest,
     dparser,
@@ -48,7 +48,7 @@ Imports:
     ggplot2,
     ggforce,
     crayon
-Suggests: 
+Suggests:
     devtools,
     testthat (>= 3.0.0),
     nonmemica,

diff --git a/NAMESPACE b/NAMESPACE
@@ -18,7 +18,6 @@ S3method(nonmem2rxRec,sub)
 S3method(nonmem2rxRec,tab)
 S3method(nonmem2rxRec,the)
 S3method(print,nonmem2rx)
-S3method(rxRename,nonmem2rx)
 S3method(rxSolve,nonmem2rx)
 export("%>%")
 export("model<-")

diff --git a/NEWS.md b/NEWS.md
@@ -1,6 +1,6 @@
-# nonmem2rx (development version)
+# nonmem2rx 0.1.3
 
-* Added explicit requirement for rxode2 2.0.12
+* Added explicit requirement for rxode2 2.0.13
 
 * Added support of `DADT(#)` statements on the right side of the
   equation, i.e. `DADT(3) = DADT(1) + DADT(2)` (#164)
@@ -9,6 +9,16 @@
 
 * Added more NONMEM-specific solving options
 
+* Fixed security related format issues as requested by CRAN #167
+
+* Now `omega`, `thetaMat`, `dfObs` and `dfSub` are incorporated into
+  model function (by default).  You can change this with the
+  `nonmem2rx` `keep` argument
+
+* Using the `rxode2` 2.0.13 makes sure that the solves for models
+  where the endpoint is not determined in the typical `nlmixr2` style
+  will validate more often (due to a bug in solving in `rxode2`).
+
 # nonmem2rx 0.1.2
 
 * Added support for `ADVAN5` and `ADVAN7` models

diff --git a/R/asNonmem2rx.R b/R/asNonmem2rx.R
@@ -9,7 +9,7 @@
 #' @examples
 #'
 #' \donttest{
-#' 
+#'
 #'  mod <- nonmem2rx(system.file("mods/cpt/runODE032.ctl", package="nonmem2rx"),
 #'                   determineError=FALSE, lst=".res", save=FALSE)
 #'
@@ -66,10 +66,22 @@ as.nonmem2rx <- function(model1, model2, compress=TRUE) {
   .cp <- c("sticky", "nonmemData", "atol", "rtol", "ssAtol", "ssRtol", "etaData",
            "ipredData", "predData", "sigmaNames", "dfSub", "thetaMat", "dfObs",
            "file", "outputExtension")
+  .meta <- new.env(parent=emptyenv())
+  if (exists("meta", envir=.nm2rx)) {
+    .meta <- get("meta", envir=.nm2rx)
+  }
+  .metaRx <- new.env(parent=emptyenv())
+  if (exists("meta", envir=.rx)) {
+    .metaRx <- get("meta", envir=.rx)
+  }
   lapply(.cp, function(x) {
     if (exists(x, envir=.nm2rx)) {
       assign(x, get(x, envir=.nm2rx), envir=.rx)
     }
+    if (exists(x, envir=.meta) && !exists(x, envir=.metaRx)) {
+      .minfo(paste0("copy '", x, "' to nonmem2rx model"))
+      assign(x, get(x, envir=.meta), envir=.metaRx)
+    }
   })
   .nonmemData <- .rx$nonmemData
   .w <- which(names(.nonmemData) == "nmdvid")
@@ -132,7 +144,11 @@ as.nonmem2rx <- function(model1, model2, compress=TRUE) {
   if (length(.nonmem2rx$modelDesc) > 0) {
     .rx$meta$description <- .nm2rx$meta$description
   }
-  .rx$thetaMat <- .thetaMat
+  if (exists("thetaMat", .rx$meta)) {
+    assign("thetaMat", .thetaMat, envir=.rx$meta)
+  } else {
+    assign("thetaMat", .thetaMat, envir=.rx)
+  }
   if (compress) {
     .ret <- rxode2::rxUiCompress(.rx)
   } else {

diff --git a/R/buildParser.R b/R/buildParser.R
@@ -99,6 +99,9 @@
   .args[1] <- paste0("rxSolve.nonmem2rx <-", .args[1])
   .args <- .args[-length(.args)]
   .extra <- quote({
+    if (missing(cores)) {
+      cores <- 0L
+    }
     if (missing(covsInterpolation)) {
       covsInterpolation <- "nocb"
       .minfo("using nocb interpolation like NONMEM, specify directly to change")
@@ -125,20 +128,30 @@
     }
     if (!missing(nStud)) {
       if (missing(dfSub)) {
-        if (!is.null(object$dfSub)){
+        if (!is.null(object$meta$dfSub)){
+          dfSub <- object$meta$dfSub
+          .minfo(paste0("using dfSub=", dfSub, " from NONMEM"))
+        } else if (!is.null(object$dfSub)) {
           dfSub <- object$dfSub
           .minfo(paste0("using dfSub=", dfSub, " from NONMEM"))
         }
       }
       if (missing(dfObs)) {
-        if (!is.null(object$dfObs)){
+        if (!is.null(object$meta$dfObs)) {
+          dfObs <- object$meta$dfObs
+          .minfo(paste0("using dfObs=", dfObs, " from NONMEM"))
+        } else if (!is.null(object$dfObs)) {
           dfObs <- object$dfObs
+          dfObs <- object$meta$dfObs
           .minfo(paste0("using dfObs=", dfObs, " from NONMEM"))
         }
       }
       if (missing(thetaMat)) {
-        if (!is.null(object$thetaMat)){
-          thetaMat <- object$thetaMat
+        if (!is.null(object$meta$thetaMat)) {
+          thetaMat <- object$meta$thetaMat
+          .minfo(paste0("using thetaMat from NONMEM"))
+        } else if (!is.null(object$thetaMat)) {
+          thetaMat <- object$meta$thetaMat
           .minfo(paste0("using thetaMat from NONMEM"))
         }
       }
@@ -147,8 +160,11 @@
     if (missing(sigma)) {
       if (is.null(object$predDf)) {
         # if a true nlmixr2 model, this is not needed
-        if (!is.null(object$sigma)){
-          sigma <- object$sigma
+        if (!is.null(object$meta$sigma)){
+          sigma <- object$meta$sigma
+          .minfo(paste0("using sigma from NONMEM"))
+        } else if (!is.null(object$sigma)) {
+          sigma <- object$meta$sigma
           .minfo(paste0("using sigma from NONMEM"))
         }
       }
@@ -160,20 +176,40 @@
       }
     }
     if (missing(atol)) {
-      atol <- object$atol
-      .minfo(paste0("using NONMEM specified atol=", atol))
+      if (!is.null(object$meta$atol)) {
+        atol <- object$meta$atol
+        .minfo(paste0("using NONMEM specified atol=", atol))
+      } else if (!is.null(object$atol)) {
+        atol <- object$atol
+        .minfo(paste0("using NONMEM specified atol=", atol))
+      }
     }
     if (missing(rtol)) {
-      rtol <- object$rtol
-      .minfo(paste0("using NONMEM specified rtol=", rtol))
+      if (!is.null(object$meta$atol)) {
+        rtol <- object$meta$rtol
+        .minfo(paste0("using NONMEM specified rtol=", rtol))
+      } else if (!is.null(object$atol)) {
+        rtol <- object$rtol
+        .minfo(paste0("using NONMEM specified rtol=", rtol))
+      }
     }
     if (missing(ssRtol)) {
-      ssRtol <- object$ssRtol
-      .minfo(paste0("using NONMEM specified ssRtol=", ssRtol))
+      if (!is.null(object$meta$ssRtol)) {
+        ssRtol <- object$meta$ssRtol
+        .minfo(paste0("using NONMEM specified ssRtol=", ssRtol))
+      } else if (!is.null(object$meta$ssRtol)) {
+        ssRtol <- object$meta$ssRtol
+        .minfo(paste0("using NONMEM specified ssRtol=", ssRtol))
+      }
     }
     if (missing(ssAtol)) {
-      ssAtol <- object$ssAtol
-      .minfo(paste0("using NONMEM specified ssAtol=", ssAtol))
+      if (!is.null(object$meta$ssAtol)) {
+        ssAtol <- object$meta$ssAtol
+        .minfo(paste0("using NONMEM specified ssAtol=", ssAtol))
+      } else if (!is.null(object$ssAtol)) {
+        ssAtol <- object$ssAtol
+        .minfo(paste0("using NONMEM specified ssAtol=", ssAtol))
+      }
     }
     .cls <- class(object)
     class(object) <- .cls[-which(.cls == "nonmem2rx")]
@@ -229,10 +265,13 @@
                     .desc <- setNames(.meth[i], NULL)
                     .ret <- c("",
                               sprintf("rxUiGet.%s <- function(x, ...) {", .name),
+                              "  .meta <- new.env(parent=emptyenv())",
+                              "  if (exists(\"meta\", envir=x[[1]])) .meta <- get(\"meta\", envir=x[[1]])",
+                              sprintf("  if (exists(\"%s\", envir=.meta)) return(get(\"%s\", envir=.meta))", .name, .name),
                               sprintf("  if (!exists(\"%s\", envir=x[[1]])) return(NULL)", .name),
                               sprintf("  get(\"%s\", envir=x[[1]])", .name),
                               "}",
-                              sprintf("attr(rxUiGet.%s, \"desc=\") <- %s", .name, deparse1(.desc)))
+                              sprintf("attr(rxUiGet.%s, \"desc\") <- %s", .name, deparse1(.desc)))
                     .ret <- paste(.ret, collapse="\n")
                   }, character(1), USE.NAMES=TRUE),
                   ".rxUiGetRegister <- function() {",