Skip to content

Commit

Permalink
Use rxRename totally from rxode2; fix $sigma etc access
Browse files Browse the repository at this point in the history
  • Loading branch information
@mattfidler
mattfidler committed Dec 8, 2023
1 parent 6db0e59 commit dce0d63
Show file tree
Hide file tree
Showing 5 changed files with 68 additions and 65 deletions.
1 change: 0 additions & 1 deletion NAMESPACE
View file
Expand Up @@ -18,7 +18,6 @@ S3method(nonmem2rxRec,sub)
S3method(nonmem2rxRec,tab)
S3method(nonmem2rxRec,the)
S3method(print,nonmem2rx)
S3method(rxRename,nonmem2rx)
S3method(rxSolve,nonmem2rx)
export("%>%")
export("model<-")
Expand Down
4 changes: 4 additions & 0 deletions R/buildParser.R
View file
Expand Up @@ -265,6 +265,10 @@
.desc <- setNames(.meth[i], NULL)
.ret <- c("",
sprintf("rxUiGet.%s <- function(x, ...) {", .name),
" .meta <- new.env(parent=emptyenv())",
" if (exists(\"meta\", envir=x[[1]])) .meta <- get(\"meta\", envir=x[[1]])",
sprintf(" if (exists(\"%s\", envir=.meta)) return(get(\"%s\", envir=.meta))", .name, .name),
sprintf(" if (!exists(\"%s\", envir=x[[1]])) return(NULL)", .name),
sprintf(" if (!exists(\"%s\", envir=x[[1]])) return(NULL)", .name),
sprintf(" get(\"%s\", envir=x[[1]])", .name),
"}",
Expand Down
64 changes: 64 additions & 0 deletions R/rxUiGetGen.R
View file
Expand Up @@ -2,96 +2,160 @@
# This is built from buildParser.R, edit there

rxUiGet.nonmemData <- function(x, ...) {
.meta <- new.env(parent=emptyenv())
if (exists("meta", envir=x[[1]])) .meta <- get("meta", envir=x[[1]])
if (exists("nonmemData", envir=.meta)) return(get("nonmemData", envir=.meta))
if (!exists("nonmemData", envir=x[[1]])) return(NULL)
if (!exists("nonmemData", envir=x[[1]])) return(NULL)
get("nonmemData", envir=x[[1]])
}
attr(rxUiGet.nonmemData, "desc=") <- "NONMEM input data from nonmem2rx"

rxUiGet.etaData <- function(x, ...) {
.meta <- new.env(parent=emptyenv())
if (exists("meta", envir=x[[1]])) .meta <- get("meta", envir=x[[1]])
if (exists("etaData", envir=.meta)) return(get("etaData", envir=.meta))
if (!exists("etaData", envir=x[[1]])) return(NULL)
if (!exists("etaData", envir=x[[1]])) return(NULL)
get("etaData", envir=x[[1]])
}
attr(rxUiGet.etaData, "desc=") <- "NONMEM etas input from nonmem2rx"

rxUiGet.ipredAtol <- function(x, ...) {
.meta <- new.env(parent=emptyenv())
if (exists("meta", envir=x[[1]])) .meta <- get("meta", envir=x[[1]])
if (exists("ipredAtol", envir=.meta)) return(get("ipredAtol", envir=.meta))
if (!exists("ipredAtol", envir=x[[1]])) return(NULL)
if (!exists("ipredAtol", envir=x[[1]])) return(NULL)
get("ipredAtol", envir=x[[1]])
}
attr(rxUiGet.ipredAtol, "desc=") <- "50th percentile of the IPRED atol comparison between rxode2 and model import"

rxUiGet.ipredRtol <- function(x, ...) {
.meta <- new.env(parent=emptyenv())
if (exists("meta", envir=x[[1]])) .meta <- get("meta", envir=x[[1]])
if (exists("ipredRtol", envir=.meta)) return(get("ipredRtol", envir=.meta))
if (!exists("ipredRtol", envir=x[[1]])) return(NULL)
if (!exists("ipredRtol", envir=x[[1]])) return(NULL)
get("ipredRtol", envir=x[[1]])
}
attr(rxUiGet.ipredRtol, "desc=") <- "50th percentile of the IPRED rtol comparison between rxode2 and model import"

rxUiGet.ipredCompare <- function(x, ...) {
.meta <- new.env(parent=emptyenv())
if (exists("meta", envir=x[[1]])) .meta <- get("meta", envir=x[[1]])
if (exists("ipredCompare", envir=.meta)) return(get("ipredCompare", envir=.meta))
if (!exists("ipredCompare", envir=x[[1]])) return(NULL)
if (!exists("ipredCompare", envir=x[[1]])) return(NULL)
get("ipredCompare", envir=x[[1]])
}
attr(rxUiGet.ipredCompare, "desc=") <- "Dataset comparing ID, TIME and the IPREDs between rxode2 and model import"

rxUiGet.predAtol <- function(x, ...) {
.meta <- new.env(parent=emptyenv())
if (exists("meta", envir=x[[1]])) .meta <- get("meta", envir=x[[1]])
if (exists("predAtol", envir=.meta)) return(get("predAtol", envir=.meta))
if (!exists("predAtol", envir=x[[1]])) return(NULL)
if (!exists("predAtol", envir=x[[1]])) return(NULL)
get("predAtol", envir=x[[1]])
}
attr(rxUiGet.predAtol, "desc=") <- "50th percentile of the PRED atol comparison between rxode2 and model import"

rxUiGet.predRtol <- function(x, ...) {
.meta <- new.env(parent=emptyenv())
if (exists("meta", envir=x[[1]])) .meta <- get("meta", envir=x[[1]])
if (exists("predRtol", envir=.meta)) return(get("predRtol", envir=.meta))
if (!exists("predRtol", envir=x[[1]])) return(NULL)
if (!exists("predRtol", envir=x[[1]])) return(NULL)
get("predRtol", envir=x[[1]])
}
attr(rxUiGet.predRtol, "desc=") <- "50th percentile of the PRED rtol comparison between rxode2 and model import"

rxUiGet.predCompare <- function(x, ...) {
.meta <- new.env(parent=emptyenv())
if (exists("meta", envir=x[[1]])) .meta <- get("meta", envir=x[[1]])
if (exists("predCompare", envir=.meta)) return(get("predCompare", envir=.meta))
if (!exists("predCompare", envir=x[[1]])) return(NULL)
if (!exists("predCompare", envir=x[[1]])) return(NULL)
get("predCompare", envir=x[[1]])
}
attr(rxUiGet.predCompare, "desc=") <- "Dataset comparing ID, TIME and the PREDs between rxode2 and model import"

rxUiGet.sigma <- function(x, ...) {
.meta <- new.env(parent=emptyenv())
if (exists("meta", envir=x[[1]])) .meta <- get("meta", envir=x[[1]])
if (exists("sigma", envir=.meta)) return(get("sigma", envir=.meta))
if (!exists("sigma", envir=x[[1]])) return(NULL)
if (!exists("sigma", envir=x[[1]])) return(NULL)
get("sigma", envir=x[[1]])
}
attr(rxUiGet.sigma, "desc=") <- "sigma matrix from model import"

rxUiGet.thetaMat <- function(x, ...) {
.meta <- new.env(parent=emptyenv())
if (exists("meta", envir=x[[1]])) .meta <- get("meta", envir=x[[1]])
if (exists("thetaMat", envir=.meta)) return(get("thetaMat", envir=.meta))
if (!exists("thetaMat", envir=x[[1]])) return(NULL)
if (!exists("thetaMat", envir=x[[1]])) return(NULL)
get("thetaMat", envir=x[[1]])
}
attr(rxUiGet.thetaMat, "desc=") <- "covariance matrix"

rxUiGet.dfSub <- function(x, ...) {
.meta <- new.env(parent=emptyenv())
if (exists("meta", envir=x[[1]])) .meta <- get("meta", envir=x[[1]])
if (exists("dfSub", envir=.meta)) return(get("dfSub", envir=.meta))
if (!exists("dfSub", envir=x[[1]])) return(NULL)
if (!exists("dfSub", envir=x[[1]])) return(NULL)
get("dfSub", envir=x[[1]])
}
attr(rxUiGet.dfSub, "desc=") <- "Number of subjects"

rxUiGet.dfObs <- function(x, ...) {
.meta <- new.env(parent=emptyenv())
if (exists("meta", envir=x[[1]])) .meta <- get("meta", envir=x[[1]])
if (exists("dfObs", envir=.meta)) return(get("dfObs", envir=.meta))
if (!exists("dfObs", envir=x[[1]])) return(NULL)
if (!exists("dfObs", envir=x[[1]])) return(NULL)
get("dfObs", envir=x[[1]])
}
attr(rxUiGet.dfObs, "desc=") <- "Number of observations"

rxUiGet.atol <- function(x, ...) {
.meta <- new.env(parent=emptyenv())
if (exists("meta", envir=x[[1]])) .meta <- get("meta", envir=x[[1]])
if (exists("atol", envir=.meta)) return(get("atol", envir=.meta))
if (!exists("atol", envir=x[[1]])) return(NULL)
if (!exists("atol", envir=x[[1]])) return(NULL)
get("atol", envir=x[[1]])
}
attr(rxUiGet.atol, "desc=") <- "atol imported from translation"

rxUiGet.rtol <- function(x, ...) {
.meta <- new.env(parent=emptyenv())
if (exists("meta", envir=x[[1]])) .meta <- get("meta", envir=x[[1]])
if (exists("rtol", envir=.meta)) return(get("rtol", envir=.meta))
if (!exists("rtol", envir=x[[1]])) return(NULL)
if (!exists("rtol", envir=x[[1]])) return(NULL)
get("rtol", envir=x[[1]])
}
attr(rxUiGet.rtol, "desc=") <- "rtol imported from translation"

rxUiGet.ssRtol <- function(x, ...) {
.meta <- new.env(parent=emptyenv())
if (exists("meta", envir=x[[1]])) .meta <- get("meta", envir=x[[1]])
if (exists("ssRtol", envir=.meta)) return(get("ssRtol", envir=.meta))
if (!exists("ssRtol", envir=x[[1]])) return(NULL)
if (!exists("ssRtol", envir=x[[1]])) return(NULL)
get("ssRtol", envir=x[[1]])
}
attr(rxUiGet.ssRtol, "desc=") <- "ssRtol imported from translation"

rxUiGet.ssAtol <- function(x, ...) {
.meta <- new.env(parent=emptyenv())
if (exists("meta", envir=x[[1]])) .meta <- get("meta", envir=x[[1]])
if (exists("ssAtol", envir=.meta)) return(get("ssAtol", envir=.meta))
if (!exists("ssAtol", envir=x[[1]])) return(NULL)
if (!exists("ssAtol", envir=x[[1]])) return(NULL)
get("ssAtol", envir=x[[1]])
}
Expand Down
61 changes: 0 additions & 61 deletions R/rxode2.R
View file

This file was deleted.

3 changes: 0 additions & 3 deletions R/zzz.R
View file
Expand Up @@ -3,9 +3,6 @@
if (requireNamespace("nlme", quietly=TRUE)) {
rxode2::.s3register("nlme::getData", "nonmem2rx")
}
if (requireNamespace("dplyr", quietly=TRUE)) {
rxode2::.s3register("dplyr::rename", "nonmem2rx")
}
rxode2::.s3register("ggplot2::autoplot", "nonmem2rx")
rxode2::.s3register("base::plot", "nonmem2rx")
.rxUiGetRegister()
Expand Down

0 comments on commit dce0d63

Please sign in to comment.