Merge pull request #616 from nlmixr2/autoVarPiping-option

Auto var piping option
nlmixr2 · Dec 1, 2023 · bbc81bd · bbc81bd
2 parents 05916b6 + 2c03cc2
commit bbc81bd
Show file tree

Hide file tree

Showing 2 changed files with 31 additions and 4 deletions.
diff --git a/R/piping-model.R b/R/piping-model.R
@@ -1,6 +1,7 @@
 #' @export
 #' @rdname model
-model.function <- function(x, ..., append=FALSE, auto=TRUE, cov=NULL, envir=parent.frame()) {
+model.function <- function(x, ..., append=FALSE, auto=getOption("rxode2.autoVarPiping", TRUE),
+                           cov=NULL, envir=parent.frame()) {
   .modelLines <- .quoteCallInfoLines(match.call(expand.dots = TRUE)[-(1:2)], envir=envir)
   .ret <- rxUiDecompress(rxode2(x))
   if (length(.modelLines) == 0) return(.ret$modelFun)
@@ -10,7 +11,8 @@ model.function <- function(x, ..., append=FALSE, auto=TRUE, cov=NULL, envir=pare
 
 #' @export
 #' @rdname model
-model.rxUi <- function(x, ..., append=FALSE, auto=TRUE, cov=NULL, envir=parent.frame()) {
+model.rxUi <- function(x, ..., append=FALSE, auto=getOption("rxode2.autoVarPiping", TRUE),
+                       cov=NULL, envir=parent.frame()) {
   .modelLines <- .quoteCallInfoLines(match.call(expand.dots = TRUE)[-(1:2)], envir=envir)
   .ret <- rxUiDecompress(.copyUi(x)) # copy so (as expected) old UI isn't affected by the call
   if (length(.modelLines) == 0) return(.ret$modelFun)
@@ -30,7 +32,8 @@ model.rxUi <- function(x, ..., append=FALSE, auto=TRUE, cov=NULL, envir=parent.f
 
 #' @export
 #' @rdname model
-model.rxode2 <- function(x, ..., append=FALSE, auto=TRUE, cov=NULL, envir=parent.frame()) {
+model.rxode2 <- function(x, ..., append=FALSE, auto=getOption("rxode2.autoVarPiping", TRUE),
+                         cov=NULL, envir=parent.frame()) {
   .modelLines <- .quoteCallInfoLines(match.call(expand.dots = TRUE)[-(1:2)], envir=envir)
   x <- as.function(x)
   .ret <- suppressMessages(rxUiDecompress(rxode2(x)))
@@ -53,7 +56,8 @@ model.rxModelVars <- model.rxode2
 #' @return New UI
 #' @author Matthew L. Fidler
 #' @export
-.modelHandleModelLines <- function(modelLines, rxui, modifyIni=FALSE, append=FALSE, auto=TRUE,
+.modelHandleModelLines <- function(modelLines, rxui, modifyIni=FALSE, append=FALSE,
+                                   auto=getOption("rxode2.autoVarPiping", TRUE),
                                    cov=NULL, envir) {
   checkmate::assertLogical(modifyIni, any.missing=FALSE, len=1)
   ## checkmate::assertLogical(append, any.missing=TRUE, len=1)

diff --git a/tests/testthat/test-ui-piping.R b/tests/testthat/test-ui-piping.R
@@ -2057,4 +2057,27 @@ test_that("piping append", {
       eta.e0 ~ 1
     }))
 
+  # make sure auto model piping turns off
+
+  withr::with_options(list(rxode2.autoVarPiping=FALSE),
+                      mod7 <- mod5 |>
+                        model({
+                          emax <- exp(temax)
+                          e0 <- exp(te0 + eta.e0)
+                          ec50 <- exp(tec50)
+                          kin <- exp(tkin)
+                          kout <- exp(tkout)
+                        }, append=NA))
+
+  expect_equal(mod7$theta,
+               c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7))
+
+  expect_equal(
+    mod7$omega,
+    lotri({
+      eta.cl ~ 0.3
+      eta.v ~ 0.1
+    }))
+
+
 })