diff --git a/NAMESPACE b/NAMESPACE index 06bd81d78..639ef73f2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,6 +8,7 @@ S3method("$",rxSymInvCholEnv) S3method("$",rxUi) S3method("$<-",rxSolve) S3method("$<-",rxSymInvCholEnv) +S3method("$<-",rxUi) S3method("+",rxSolve) S3method("+",solveRxDll) S3method("[",rxSolve) @@ -139,6 +140,7 @@ S3method(rxUiGet,lhsTheta) S3method(rxUiGet,lhsVar) S3method(rxUiGet,lstChr) S3method(rxUiGet,md5) +S3method(rxUiGet,model) S3method(rxUiGet,modelDesc) S3method(rxUiGet,modelFun) S3method(rxUiGet,muRefTable) diff --git a/NEWS.md b/NEWS.md index 00e47ae03..69f384446 100644 --- a/NEWS.md +++ b/NEWS.md @@ -125,6 +125,18 @@ mu-referencing style to run the optimization. `plot(ci, Cc)` which will only plot the variable `Cc` that you summarized even if you also summarized `eff` (for instance). +- When the rxode2 ui is a compressed ui object, you can modify the ini + block with `$ini <-` or modify the model block with `$model <-`. + These are equivalent to `ini(model) <-` and `model(model) <-`, + respectively. Otherwise, the object is added to the user defined + components in the function (ie `$meta`). When the object is + uncompressed, it simply assigns it to the environment instead (just + like before). + +- When printing meta information that happens to be a `lotri` + compatible matrix, use `lotri` to express it instead of the default + R expression. + ## Internal new features - Add `as.model()` for list expressions, which implies `model(ui) <- diff --git a/R/rxUiGet.R b/R/rxUiGet.R index 7ab14730c..8393dae70 100644 --- a/R/rxUiGet.R +++ b/R/rxUiGet.R @@ -185,7 +185,22 @@ rxUiGet.funPrint <- function(x, ...) { .ret <- vector("list", length(.ls) + ifelse(.hasIni, 3, 2)) .ret[[1]] <- quote(`{`) for (.i in seq_along(.ls)) { - .ret[[.i + 1]] <- eval(parse(text=paste("quote(", .ls[.i], "<-", deparse1(.x$meta[[.ls[.i]]]), ")"))) + .var <- .ls[.i] + .val <- .x$meta[[.ls[.i]]] + .isLotri <- FALSE + if (checkmate::testMatrix(.val, any.missing=FALSE, row.names="strict", col.names="strict")) { + .dn <- dimnames(.val) + if (identical(.dn[[1]], .dn[[2]]) && isSymmetric(.val)) { + class(.val) <- c("lotriFix", class(.val)) + .val <- as.expression(.val) + .val <- bquote(.(str2lang(.var)) <- .(.val)) + .ret[[.i + 1]] <- .val + .isLotri <- TRUE + } + } + if (!.isLotri) { + .ret[[.i + 1]] <- eval(parse(text=paste("quote(", .var, "<-", deparse1(.val), ")"))) + } } .theta <- x$theta .omega <- x$omega @@ -235,6 +250,7 @@ rxUiGet.iniFun <- function(x, ...) { } attr(rxUiGet.iniFun, "desc") <- "normalized, quoted `ini()` block" + #' @export #' @rdname rxUiGet rxUiGet.modelFun <- function(x, ...) { @@ -243,6 +259,11 @@ rxUiGet.modelFun <- function(x, ...) { } attr(rxUiGet.modelFun, "desc") <- "normalized, quoted `model()` block" +#' @export +#' @rdname rxUiGet +rxUiGet.model <- rxUiGet.modelFun + + #' @export #' @rdname rxUiGet rxUiGet.modelDesc <- function(x, ...) { @@ -365,8 +386,15 @@ attr(rxUiGet.covLhs, "desc") <- "cov->lhs translation" #' @rdname rxUiGet rxUiGet.default <- function(x, ...) { .arg <- class(x)[1] - if (!exists(.arg, envir=x[[1]])) return(NULL) - get(.arg, x[[1]]) + .ui <- x[[1]] + if (!exists(.arg, envir=.ui)) { + .meta <- get("meta", envir=.ui) + if (exists(.arg, envir=.meta)) { + return(get(.arg, envir=.meta)) + } + return(NULL) + } + get(.arg, .ui) } .rxUiGetEnvInfo <- c("model"="Original Model (with comments if available)", diff --git a/R/ui-assign-parts.R b/R/ui-assign-parts.R index 19e4863b3..057a860eb 100644 --- a/R/ui-assign-parts.R +++ b/R/ui-assign-parts.R @@ -291,3 +291,30 @@ `RxODE<-` <- function(x, envir=environment(x), value) { UseMethod("rxode2<-") } + +#' @export +`$<-.rxUi` <- function(x, name, value) { + .raw <- inherits(x, "raw") + if (!.raw) { + assign(name, value, envir=x) + return(x) + } + .x <- x + if (name %in% c("ini", "iniDf")) { + ini(x) <- value + return(x) + } + if (name == "model") { + model(x) <- value + return(x) + } + .x <- rxUiDecompress(.x) + if (exists(name, .x)) { + stop("'", name, "' is a fixed UI component and should not be overwritten", + call.=FALSE) + } + .meta <- get("meta", .x) + assign(name, value, envir=.meta) + .x <- rxUiCompress(.x) + .x +} diff --git a/man/rxUiGet.Rd b/man/rxUiGet.Rd index 0b012c9d2..0f297005c 100644 --- a/man/rxUiGet.Rd +++ b/man/rxUiGet.Rd @@ -23,6 +23,7 @@ \alias{rxUiGet.ini} \alias{rxUiGet.iniFun} \alias{rxUiGet.modelFun} +\alias{rxUiGet.model} \alias{rxUiGet.modelDesc} \alias{rxUiGet.thetaLower} \alias{rxUiGet.thetaUpper} @@ -81,6 +82,8 @@ rxUiGet(x, ...) \method{rxUiGet}{modelFun}(x, ...) +\method{rxUiGet}{model}(x, ...) + \method{rxUiGet}{modelDesc}(x, ...) \method{rxUiGet}{thetaLower}(x, ...) diff --git a/man/rxode2.Rd b/man/rxode2.Rd index dc6d9aeb7..215a15ee6 100644 --- a/man/rxode2.Rd +++ b/man/rxode2.Rd @@ -333,7 +333,7 @@ compilation model. \if{html}{\out{