From 408ce47f9afbdb193897abff82aa422c43b314a4 Mon Sep 17 00:00:00 2001 From: Matthew Fidler Date: Wed, 2 Oct 2024 21:41:31 -0500 Subject: [PATCH 1/3] Use `isTRUE(getOption("rxode2.verbose.pipe", TRUE))` --- R/mu.R | 8 ++++---- R/piping-ini.R | 24 ++++++++++++------------ R/piping-model.R | 16 ++++++++-------- R/rxode-options.R | 2 -- 4 files changed, 24 insertions(+), 26 deletions(-) diff --git a/R/mu.R b/R/mu.R index d6550a513..b3186b10c 100644 --- 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,7 +935,7 @@ .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")) @@ -943,7 +943,7 @@ .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 index 226316a74..05c170852 100644 --- 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,14 +114,14 @@ } 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")) } } @@ -129,7 +129,7 @@ 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 index 2ecf21bbd..4b33430b7 100644 --- 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 index 066014d24..8bbc0faaa 100644 --- 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 From 45e4e8c41c68973e21192ca32e1f25c55fe13fa9 Mon Sep 17 00:00:00 2001 From: Matthew Fidler Date: Wed, 2 Oct 2024 21:43:11 -0500 Subject: [PATCH 2/3] Add to news --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS.md b/NEWS.md index 34edd5efd..972899471 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # rxode2 (development version) +- Query `rxode2.verbose.pipe` at run time instead of requiring it to + be set before loading `rxode2`. + # rxode2 3.0.1 - Explicitly initialize the order vector to stop valgrind warning From ceb56a13e41a007a21ce23982c50aa52b21fdb59 Mon Sep 17 00:00:00 2001 From: Matthew Fidler Date: Wed, 2 Oct 2024 22:09:45 -0500 Subject: [PATCH 3/3] Add logit to news too --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index 972899471..d132a7451 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,10 @@ - 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