38 dont protect known non zero mu vars

R/nonmem.R

@@ -282,17 +282,8 @@ rex::register_shortcuts("babelmixr2")
 #' @author Matthew L. Fidler
 #' @noRd
 .rxProtectPlusZero <- function(x, ui, one=FALSE) {
-  .protectZeros <- rxode2::rxGetControl(ui, "protectZeros", TRUE)
-  .inIfElse <- rxode2::rxGetControl(ui, ".ifelse", FALSE)
-  .protectZeros <- .protectZeros && !.inIfElse
-  if (inherits(x, "numeric")) {
-    .protectZeros <- FALSE
-  }
   .ret <- .rxToNonmem(x, ui=ui)
-  if (.ret %in% ui$allCovs) {
-    .protectZeros <- FALSE
-  }
-  if (.protectZeros) {
+  if (.rxShouldProtectZeros(.ret, ui)) {
     .df <- rxode2::rxGetControl(ui, ".nmGetDivideZeroDf",
                                 data.frame(expr=character(0),
                                            nm=character(0)))
@@ -338,17 +329,8 @@ rex::register_shortcuts("babelmixr2")
 #' @author Matthew L. Fidler
 #' @noRd
 .rxProtectPlusOrMinusZero <- function(x, ui) {
-  .protectZeros <- rxode2::rxGetControl(ui, "protectZeros", TRUE)
-  .inIfElse <- rxode2::rxGetControl(ui, ".ifelse", FALSE)
-  .protectZeros <- .protectZeros && !.inIfElse
-  if (inherits(x, "numeric")) {
-    .protectZeros <- FALSE
-  }
   .denom <- .rxToNonmem(x, ui=ui)
-  if (.denom %in% ui$allCovs) {
-    .protectZeros <- FALSE
-  }
-  if (.protectZeros) {
+  if (.rxShouldProtectZeros(.denom, ui)) {
     .df <- rxode2::rxGetControl(ui, ".nmGetDivideZeroDf",
                                 data.frame(expr=character(0),
                                            nm=character(0)))
@@ -432,8 +414,14 @@ rex::register_shortcuts("babelmixr2")
     }
   } else if (identical(x[[1]], quote(`^`)) ||
                identical(x[[1]], quote(`**`))) {
+    .needProtect <-TRUE
+    if (is.numeric(x[[3]]) && x[[3]] > 0) {
+      .needProtect <- FALSE
+    }
     .ret <- paste0(
-      .rxProtectPlusOrMinusZero(x[[2]], ui),
+      ifelse(.needProtect,
+             .rxProtectPlusOrMinusZero(x[[2]], ui),
+             .rxToNonmem(x[[2]], ui)),
       .rxNMbin[as.character(x[[1]])],
       .rxToNonmem(x[[3]], ui=ui)
     )

R/utils.R

@@ -46,3 +46,48 @@
   if (!identical(expr[[3]][[1]], quote(`dt`))) return(FALSE)
   TRUE
 }
+#' Is a variable known to be non-zero
+#'
+#' @param variable Varible name to check
+#' @param ui rxode2 ui
+#' @return logical to say if the variable is known to be non-zero
+#' @author Matthew L. Fidler
+#' @noRd
+.rxIsKnownNonZeroVariable <- function(variable, ui) {
+  if (!is.null(names(variable))) {
+    if (.rxIsKnownNonZeroVariable(names(variable), ui)) return(TRUE)
+  }
+  variable <- as.character(variable)
+  if (variable %in% toupper(ui$allCovs)) return(TRUE)
+  .split <- ui$getSplitMuModel
+  .mus <- c(.split$pureMuRef, .split$taintMuRef)
+  .w <- which(variable == toupper(.mus))
+  if (length(.w) != 1) return(FALSE)
+  .tv <- names(.w)
+  .w <- which(ui$muRefCurEval$parameter == .tv)
+  if (length(.w) != 1) return(FALSE)
+  .curEval <- ui$muRefCurEval$curEval[.w]
+  if (.curEval == "exp") return(TRUE)
+  if (any(.curEval == c("expit", "probitInv"))) {
+    .low <- ui$muRefCurEval$parameter$low[.w]
+    if (.low >= 0) return(TRUE)
+    .hi <- ui$muRefCurEval$parameter$hi[.w]
+    if (.hi <= 0) return(TRUE)
+  }
+  FALSE
+}
+#' Should the variable be protected from being zero?
+#'
+#' @param variable name of the variable
+#' @param ui rxode2 ui
+#' @return boolean of if the variable needs protection
+#' @author Matthew L. Fidler
+#' @noRd
+.rxShouldProtectZeros <- function(variable, ui) {
+  # should protect zeros if requested, not in an if/else block
+  # and if the variable is known to be something non-zero
+  if (!rxode2::rxGetControl(ui, "protectZeros", TRUE)) return(FALSE)
+  if (rxode2::rxGetControl(ui, ".ifelse", FALSE)) return(FALSE)
+  if (.rxIsKnownNonZeroVariable(variable, ui)) return(FALSE)
+  return(TRUE)
+}

tests/testthat/test-monolix-read.R

@@ -52,6 +52,7 @@ pk.turnover.emax3 <- function() {
 }
 
 test_that("test monolix reading for 2019, 2020, and 2021", {
+
   if (file.exists("pk.turnover.emax3-2019.zip")) {
     .path <- normalizePath("pk.turnover.emax3-2019.zip")
     withr::with_tempdir({
@@ -78,6 +79,7 @@ test_that("test monolix reading for 2019, 2020, and 2021", {
       expect_true(inherits(f, "nlmixr2FitData"))
     })
   }
+
 })
 
 
@@ -144,6 +146,7 @@ test_that("test more nlmixr2/monolix features", {
     f <- nlmixr2::nlmixr(pk.turnover.emax4, nlmixr2data::warfarin, "monolix")
     expect_true(inherits(f, "nlmixr2FitData"))
   })
+
 })
 
 test_that("test Monolix pheno", {
@@ -168,14 +171,14 @@ test_that("test Monolix pheno", {
     })
   }
 
-
   skip_if_not(file.exists("pheno-2021.zip"))
   .path <- normalizePath("pheno-2021.zip")
   withr::with_tempdir({
     unzip(.path)
     f <- nlmixr2::nlmixr(pheno, nlmixr2data::pheno_sd, "monolix")
     expect_true(inherits(f, "nlmixr2FitData"))
   })
+
 })
 
 test_that("pbpk mavoglurant", {
@@ -288,9 +291,11 @@ test_that("pbpk mavoglurant", {
     f <- nlmixr2::nlmixr(pbpk, nlmixr2data::mavoglurant, "monolix")
     expect_true(inherits(f, "nlmixr2FitData"))
   })
+
 })
 
 test_that("nimo test", {
+
   nimo <- function() {
     ini({
       ## Note that the UI can take expressions
@@ -349,6 +354,7 @@ test_that("nimo test", {
     f <- suppressWarnings(nlmixr2::nlmixr2(nimo, tmp, "monolix"))
     expect_true(inherits(f, "nlmixr2FitData"))
   })
+
 })
 
 # WBC Model tests ####