Merge pull request #797 from nlmixr2/797-rxode2.verbose.pipe

`rxode2.verbose.pipe`
nlmixr2 · Oct 3, 2024 · 6f106a9 · 6f106a9
2 parents 0ca4eaf + ceb56a1
commit 6f106a9
Show file tree

Hide file tree

Showing 5 changed files with 31 additions and 26 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,12 @@
 # rxode2 (development version)
 
+- Query `rxode2.verbose.pipe` at run time instead of requiring it to
+  be set before loading `rxode2`.
+
+- Have correct values at boundaries for `logit`, `expit`, `probit`,
+  and `probitInv` (instead of `NA`). For most cases this does not
+  break anything.
+
 # rxode2 3.0.1
 
 - Explicitly initialize the order vector to stop valgrind warning

diff --git a/R/mu.R b/R/mu.R
@@ -212,7 +212,7 @@
     .lhs <- deparse1(env$curLhs)
     if (any(.n == env$info$theta)) {
       return(.n)
-    } 
+    }
     return(NULL)
   } else if (is.call(x)) {
     return(do.call(`c`, lapply(x[-1], .muRefExtractTheta, env=env)))
@@ -260,7 +260,7 @@
 #' @return A list of covariates with estimates attached
 #'
 #' @author Matthew Fidler
-#' 
+#'
 #' @noRd
 .muRefExtractMultiplyMuCovariates <- function(x, doubleNames, env) {
   c(doubleNames, do.call(`c`, lapply(x, function(y) {
@@ -935,15 +935,15 @@
                             .est, ") needs to be below ", .range[2]))
       }
       if (.lower < .range[1]) {
-        if (rxode2.verbose.pipe && is.finite(.lower)) {
+        if (isTRUE(getOption("rxode2.verbose.pipe", TRUE)) && is.finite(.lower)) {
           .minfo(paste0("'", .name, "' lower bound (",
                         .lower, ") needs to be equal or above ", .range[1],
                         "; adjusting"))
         }
         .lower <- .range[1]
       }
       if (.upper > .range[2]) {
-        if (rxode2.verbose.pipe && is.finite(.upper)) {
+        if (isTRUE(getOption("rxode2.verbose.pipe", TRUE)) && is.finite(.upper)) {
           .minfo(paste0("'", .name, "' upper bound (", .upper,
                         ") needs to be equal or below ", .range[2],
                         "; adjusting"))

diff --git a/R/piping-ini.R b/R/piping-ini.R
@@ -31,7 +31,7 @@
 #' @noRd
 #' @author Matthew L. Fidler
 .iniModifyFixedForThetaOrEtablock <- function(ini, w, fixedValue) {
-  if (rxode2.verbose.pipe) {
+  if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
     .msgFix(ini, w, fixedValue)
   }
   ini$fix[w] <- fixedValue
@@ -42,7 +42,7 @@
     while (length(.etas) > 0) {
       .neta <- .etas[1]
       w <- which(ini$neta1 == .neta | ini$neta2 == .neta)
-      if (rxode2.verbose.pipe) {
+      if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
         .msgFix(ini, w, fixedValue)
       }
       ini$fix[w] <- fixedValue
@@ -90,20 +90,20 @@
   if (is.null(rhs)) {
   } else if (length(rhs) == 1)  {
     ini$est[.w] <- rhs
-    if (rxode2.verbose.pipe) {
+    if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
       .minfo(paste0("change initial estimate of {.code ", ini$name[.w], "} to {.code ", ini$est[.w], "}"))
     }
     .lower <- ini$lower[.w]
     .upper <- ini$upper[.w]
     if (.lower >= rhs) {
       ini$lower[.w] <- -Inf
-      if (rxode2.verbose.pipe) {
+      if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
         .minfo(paste0("lower bound of  {.code ", ini$name[.w], "} reset to {.code -Inf}"))
       }
     }
     if (.upper <= rhs) {
       ini$upper[.w] <- Inf
-      if (rxode2.verbose.pipe) {
+      if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
         .minfo(paste0("upper bound of  {.code ", ini$name[.w], "} reset to {.code Inf}"))
       }
     }
@@ -114,22 +114,22 @@
     } else if (length(rhs) == 2) {
       ini$lower[.w] <- rhs[1]
       ini$est[.w] <- rhs[2]
-      if (rxode2.verbose.pipe) {
+      if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
         .minfo(paste0("change initial estimate (", ini$est[.w], ") and lower bound (", ini$lower[.w], ") of {.code ", ini$name[.w], "}"))
       }
       # now check/change upper if needed
       .upper <- ini$upper[.w]
       if (.upper <= rhs[1] || .upper <= rhs[2]) {
         ini$upper[.w] <- Inf
-        if (rxode2.verbose.pipe) {
+        if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
           .minfo(paste0("upper bound for initial estimate (", ini$name[.w], ") reset to Inf"))
         }
       }
     } else if (length(rhs) == 3) {
       ini$lower[.w] <- rhs[1]
       ini$est[.w] <- rhs[2]
       ini$upper[.w] <- rhs[3]
-      if (rxode2.verbose.pipe) {
+      if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
         .minfo(paste0("change initial estimate (", ini$est[.w], ") and upper/lower bound (", ini$lower[.w], " to ", ini$upper[.w], ") of {.code ", ini$name[.w], "}"))
       }
     }
@@ -229,7 +229,7 @@
                       name=paste0("(", neta2, ",", neta1, ")"), lower= -Inf, est=est, upper=Inf,
                       fix=.fix, label=NA_character_, backTransform=NA_character_, condition="id",
                       err=NA_character_)
-  if (rxode2.verbose.pipe) {
+  if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
     .minfo(paste0("add covariance between {.code ", ini$name[.w1], "} and {.code ", ini$name[.w2], "} with initial estimate {.code ", est, "}"))
   }
   rbind(ini,.ini2)
@@ -277,7 +277,7 @@
       }
     }
   }
-  if (rxode2.verbose.pipe && .drop) {
+  if (isTRUE(getOption("rxode2.verbose.pipe", TRUE)) && .drop) {
     .minfo(paste0("some correlations may have been dropped for the variables: {.code ", paste(.dn, collapse="}, {.code "), "}"))
     .minfo("the piping should specify the needed covariances directly")
   }
@@ -981,7 +981,7 @@ zeroRe <- function(object, which = c("omega", "sigma"), fix = TRUE) {
     .eta$err <- NA_character_
     .iniDf <- rbind(.theta, .eta)
   }
-  if (rxode2.verbose.pipe) {
+  if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
     for (.v in .rmNames) {
       .minfo(paste0("remove covariance {.code ", .v, "}"))
     }
@@ -1004,7 +1004,7 @@ zeroRe <- function(object, which = c("omega", "sigma"), fix = TRUE) {
   if (length(.v2) != 1) {
     stop("cannot find parameter '", .n2, "' for covariance removal", call.=FALSE)
   }
-  if (rxode2.verbose.pipe) {
+  if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
     .minfo(paste0("remove covariance {.code (", .n1, ", ", .n2, ")}"))
   }
 

diff --git a/R/piping-model.R b/R/piping-model.R
@@ -185,7 +185,7 @@ model.rxModelVars <- model.rxode2
       .isErr <- x %in% .v$err
       if (auto || .isErr) {
         .addVariableToIniDf(x, rxui, promote=ifelse(.isErr, NA, FALSE))
-      } else if (rxode2.verbose.pipe) {
+      } else if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
         .minfo(paste0("add covariate {.code ", x, "}"))
       }
     })
@@ -750,10 +750,10 @@ attr(rxUiGet.errParams, "desc") <- "Get the error-associated variables"
       if (length(.w1) > 0) .iniDf <- .iniDf[-.w1, ]
       .w1 <- which(.iniDf$neta2 == .neta)
       if (length(.w1) > 0) .iniDf <- .iniDf[-.w1, ]
-      if (rxode2.verbose.pipe) {
+      if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
         .mwarn(paste0("remove between subject variability {.code ", var, "}"))
       }
-    } else if (rxode2.verbose.pipe) {
+    } else if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
       if (is.na(promote)) {
         .mwarn(paste0("remove residual parameter {.code ", var, "}"))
       } else {
@@ -912,7 +912,7 @@ rxSetCovariateNamesForPiping <- function(covariates=NULL) {
   }
   if (!is.null(.varSelect$cov)) {
     if (var %in% .varSelect$cov) {
-      if (rxode2.verbose.pipe) {
+      if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
         .minfo(paste0("add covariate {.code ", var, "} (as requested by cov option)"))
       }
       return(invisible())
@@ -963,7 +963,7 @@ rxSetCovariateNamesForPiping <- function(covariates=NULL) {
     .extra$neta2 <- .eta
     .extra$name <- var
     .extra$condition <- "id"
-    if (rxode2.verbose.pipe) {
+    if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
       if (is.na(promote)) {
       } else if (promote) {
         if (is.na(value))  {
@@ -985,14 +985,14 @@ rxSetCovariateNamesForPiping <- function(covariates=NULL) {
     } else if (!promote) {
       if (regexpr(.varSelect$covariateExceptions, tolower(var)) != -1 ||
             regexpr(.varSelect$thetaModelReg, var, perl=TRUE) == -1) {
-        if (rxode2.verbose.pipe) {
+        if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
           .minfo(paste0("add covariate {.code ", var, "}"))
         }
         return(invisible())
       }
       if (!is.null(.varSelect$covariateNames)) {
         if (var %in% .varSelect$covariateNames) {
-          if (rxode2.verbose.pipe) {
+          if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
             .minfo(paste0("add covariate {.code ", var, "} (known covariate)"))
           }
           return(invisible())
@@ -1008,7 +1008,7 @@ rxSetCovariateNamesForPiping <- function(covariates=NULL) {
     .extra$est <- value
     .extra$ntheta <- .theta
     .extra$name <- var
-    if (rxode2.verbose.pipe) {
+    if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {
       if (is.na(promote)) {
         .minfo(paste0("add residual parameter {.code ", var, "} and set estimate to {.number ", value, "}"))
       } else if (promote) {

diff --git a/R/rxode-options.R b/R/rxode-options.R
@@ -230,7 +230,6 @@ rxOpt <- list(
   rxode2.calculate.jacobian = c(FALSE, FALSE),
   rxode2.calculate.sensitivity = c(FALSE, FALSE),
   rxode2.verbose = c(TRUE, TRUE),
-  rxode2.verbose.pipe = c(TRUE, TRUE),
   rxode2.suppress.syntax.info = c(FALSE, FALSE),
   rxode2.sympy.engine = c("", ""),
   rxode2.cache.directory = c(.cacheDefault, .cacheDefault),
@@ -258,7 +257,6 @@ rxode2.syntax.require.ode.first <- NULL
 rxode2.compile.O <- NULL
 rxode2.unload.unused <- NULL
 rxode2.debug <- NULL
-rxode2.verbose.pipe <- NULL
 
 .isTestthat <- function() {
   return(regexpr("/tests/testthat/", getwd(), fixed = TRUE) != -1) # nolint