Add monolix2rx test

nlmixr2 · Sep 15, 2024 · ea77976 · ea77976
1 parent 3893650
commit ea77976
Show file tree

Hide file tree

Showing 6 changed files with 36 additions and 15 deletions.
diff --git a/R/as.nlmixr2.R b/R/as.nlmixr2.R
@@ -6,6 +6,8 @@
 #' @param rxControl is the `rxode2::rxControl()` options, which is
 #'   generally needed for how `addl` doses are handled in the
 #'   translation
+#' @param ci is the confidence interval of the residual differences
+#'   calculated (by default 0.95)
 #' @return nlmixr2 fit object
 #' @export
 #' @author Matthew L. Fidler
@@ -63,15 +65,15 @@
 #' print(fit)
 #'
 #' }
-as.nlmixr2 <- function(x, ..., table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl()) {
+as.nlmixr2 <- function(x, ..., table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl(), ci=0.95) {
   UseMethod("as.nlmixr2")
 }
 #' @rdname as.nlmixr2
 #' @export
 as.nlmixr <- as.nlmixr2
 
 #' @export
-as.nlmixr2.default <- function(x, ..., table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl()) {
+as.nlmixr2.default <- function(x, ..., table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl(), ci=0.95) {
   stop("cannot figure out how to create an nlmixr2 object from the input",
        call.=FALSE)
 }
diff --git a/R/as.nlmixr2monolixr2rx.R b/R/as.nlmixr2monolixr2rx.R
@@ -42,7 +42,7 @@ nmObjGetControl.monolix2rx <- function(x, ...) {
 }
 
 #' @export
-as.nlmixr2.monolix2rx <- function(x, ..., table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl()) {
+as.nlmixr2.monolix2rx <- function(x, ..., table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl(), ci=0.95) {
   #need x$nonmemData
   # need x to have at least one endpoint
   # The environment needs:
@@ -74,7 +74,7 @@ as.nlmixr2.monolix2rx <- function(x, ..., table=nlmixr2est::tableControl(), rxCo
       }
       .df[["OBJI"]] <- NA_real_
       env$etaObf <- .df
-      warning("since NONMEM did not output between subject variability, assuming all ETA(#) are zero",
+      warning("since Monolix did not output between subject variability, assuming all ETA(#) are zero",
               call.=FALSE)
     }
     # - $cov For covariance
@@ -115,7 +115,9 @@ as.nlmixr2.monolix2rx <- function(x, ..., table=nlmixr2est::tableControl(), rxCo
                                                   control=env$control, table=env$table,
                                                   env=env, est="monolix2rx")
     if (inherits(.ret, "nlmixr2FitData")) {
+      assign("monolixControl", list(ci=ci), .ret$env)
       .msg <- .monolixMergePredsAndCalcRelativeErr(.ret)
+      rm("monolixControl", envir=.ret$env)
       .msg$message <- c(.msg$message)
       .tmp <- .ret$ui$monolixParHistory
       assign("message", paste(.msg$message, collapse="\n    "), envir=.ret$env)

diff --git a/R/as.nlmixr2nonmem2rx.R b/R/as.nlmixr2nonmem2rx.R
@@ -27,11 +27,11 @@ nmObjGetControl.nonmem2rx <- function(x, ...) {
                                             interaction = 1L)
   if (assign)
     env$control <- .foceiControl
-  .foceiControl 
+  .foceiControl
 }
 
 #' @export
-as.nlmixr2.nonmem2rx <- function(x, ..., table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl()) {
+as.nlmixr2.nonmem2rx <- function(x, ..., table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl(), ci=0.95) {
   #need x$nonmemData
   # need x to have at least one endpoint
   # The environment needs:
@@ -105,7 +105,9 @@ as.nlmixr2.nonmem2rx <- function(x, ..., table=nlmixr2est::tableControl(), rxCon
                                                   control=env$control, table=env$table,
                                                   env=env, est="nonmem2rx")
     if (inherits(.ret, "nlmixr2FitData")) {
+      assign("nonmemControl", list(ci=ci), .ret$env)
       .msg <- .nonmemMergePredsAndCalcRelativeErr(.ret)
+      rm("nonmemControl", envir=.ret$env)
       .prderrPath <- file.path(x$nonmemExportPath, "PRDERR")
       .msg$message <- c(.ui$nonmemTransMessage,
                         .ui$nonmemTermMessage,

diff --git a/R/nonmemReadData.R b/R/nonmemReadData.R
@@ -291,7 +291,7 @@ rxUiGet.nonmemPreds <- function(x, ...) {
     .ret <- .ret[.ret$NMREP ==1, names(.ret) != "NMREP"]
     setNames(.ret,
              c("ID", "TIME", "nonmemIPRED", "nonmemPRED", "RXROW"))
-    
+
   }
 }
 
@@ -333,11 +333,7 @@ rxUiGet.nonmemRoundingErrors <- function(x, ...) {
   .tmp$RXROW <- fit$env$.rownum
   .by <- c("ID", "TIME", "RXROW")
   .ret <- merge(.np, .tmp, by=.by)
--  if (!is.numeric(fit$nonmemControl$ci)) {
-    .ci0 <- 0.95
-  } else {
-    .ci0 <- fit$nonmemControl$ci
-  }
+  .ci0 <- fit$nonmemControl$ci
   .ci <- (1 - .ci0) / 2
   .q <- c(0, .ci, 0.5, 1 - .ci, 1)
   .qi <- stats::quantile(with(.ret, 100*abs((IPRED-nonmemIPRED)/nonmemIPRED)), .q, na.rm=TRUE)

diff --git a/man/as.nlmixr2.Rd b/man/as.nlmixr2.Rd
diff --git a/tests/testthat/test-as-nlmixr2.R b/tests/testthat/test-as-nlmixr2.R
@@ -6,7 +6,7 @@
 
 test_that("nlmixr2 translation from nonmem2x", {
   skip_on_cran()
-  
+
   mod <- .nonmem2rx(system.file("mods/cpt/runODE032.ctl", package="nonmem2rx"),
                    determineError=FALSE, lst=".res", save=FALSE)
 
@@ -60,3 +60,17 @@ test_that("nlmixr2 translation from nonmem2x", {
 
 })
 
+.monolix2rx <- function(...) suppressWarnings(suppressMessages(monolix2rx::monolix2rx(...)))
+
+test_that("nlmixr2 translation from monolix2rx", {
+  skip_on_cran()
+
+  pkgTheo <- system.file("theo/theophylline_project.mlxtran", package="monolix2rx")
+
+  mod <- .monolix2rx(pkgTheo)
+
+  fit <- .as.nlmixr2(mod)
+
+  expect_true(inherits(fit, "nlmixr2FitData"))
+
+})