Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

rxode2.verbose.pipe #797

Merged
merged 3 commits into from
Oct 3, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 7 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -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
Expand Down
8 changes: 4 additions & 4 deletions R/mu.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)))
Expand Down Expand Up @@ -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) {
Expand Down Expand Up @@ -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"))
Expand Down
24 changes: 12 additions & 12 deletions R/piping-ini.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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}"))
}
}
Expand All @@ -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], "}"))
}
}
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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")
}
Expand Down Expand Up @@ -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, "}"))
}
Expand All @@ -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, ")}"))
}

Expand Down
16 changes: 8 additions & 8 deletions R/piping-model.R
Original file line number Diff line number Diff line change
Expand Up @@ -185,7 +185,7 @@
.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, "}"))
}
})
Expand Down Expand Up @@ -750,10 +750,10 @@
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 {
Expand Down Expand Up @@ -912,7 +912,7 @@
}
if (!is.null(.varSelect$cov)) {
if (var %in% .varSelect$cov) {
if (rxode2.verbose.pipe) {
if (isTRUE(getOption("rxode2.verbose.pipe", TRUE))) {

Check warning on line 915 in R/piping-model.R

View check run for this annotation

Codecov / codecov/patch

R/piping-model.R#L915

Added line #L915 was not covered by tests
.minfo(paste0("add covariate {.code ", var, "} (as requested by cov option)"))
}
return(invisible())
Expand Down Expand Up @@ -963,7 +963,7 @@
.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)) {
Expand All @@ -985,14 +985,14 @@
} 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())
Expand All @@ -1008,7 +1008,7 @@
.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) {
Expand Down
2 changes: 0 additions & 2 deletions R/rxode-options.R
Original file line number Diff line number Diff line change
Expand Up @@ -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),
Expand Down Expand Up @@ -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
Expand Down
Loading