diff --git a/NAMESPACE b/NAMESPACE index 5764164f..747d685b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,7 @@ # Generated by roxygen2: do not edit by hand S3method(as.nlmixr2,default) +S3method(as.nlmixr2,monolix2rx) S3method(as.nlmixr2,nonmem2rx) S3method(getValidNlmixrCtl,monolix) S3method(getValidNlmixrCtl,nonmem) @@ -19,6 +20,7 @@ S3method(nmGetDistributionNonmemLines,norm) S3method(nmGetDistributionNonmemLines,rxUi) S3method(nmGetDistributionNonmemLines,t) S3method(nmObjGetControl,monolix) +S3method(nmObjGetControl,monolix2rx) S3method(nmObjGetControl,nonmem) S3method(nmObjGetControl,nonmem2rx) S3method(nmObjGetFoceiControl,monolix) @@ -141,6 +143,7 @@ export(bblDatToRxode) export(getStandardColNames) export(getValidNlmixrCtl) export(modelUnitConversion) +export(monolix2rx) export(monolixControl) export(nlmixr2Est) export(nmGetDistributionMonolixLines) @@ -158,6 +161,7 @@ export(rxToNonmem) export(rxUiGet) export(simplifyUnit) importFrom(methods,is) +importFrom(monolix2rx,monolix2rx) importFrom(nlmixr2,nlmixr2) importFrom(nlmixr2est,getValidNlmixrCtl) importFrom(nlmixr2est,nlmixr2Est) diff --git a/R/as.nlmixr2monolixr2rx.R b/R/as.nlmixr2monolixr2rx.R new file mode 100644 index 00000000..12bf4f95 --- /dev/null +++ b/R/as.nlmixr2monolixr2rx.R @@ -0,0 +1,138 @@ +#' @export +nmObjGetControl.monolix2rx <- function(x, ...) { + .env <- x[[1]] + if (exists("control", .env)) { + .control <- get("control", .env) + if (inherits(.control, "foceiControl")) return(.control) + } + if (exists("foceiControl0", .env)) { + .control <- get("foceiControl0", .env) + if (inherits(.control, "foceiControl")) return(.control) + } + stop("cannot find monolix2rx related control object", call.=FALSE) +} + +.monolix2rxToFoceiControl <- function(env, model, assign=FALSE) { + ## maxSS=nbSSDoses + 1, + ## minSS=nbSSDoses, + ## ssAtol=100, + ## ssRtol=100, + ## atol=ifelse(stiff, 1e-9, 1e-6), + ## rtol=ifelse(stiff, 1e-6, 1e-3), + ## method=ifelse(stiff, "liblsoda", "dop853") + .nbSsDoses <- monolix2rx::.getNbdoses(model) + .stiff <- monolix2rx::.getStiff(model) + .rxControl <- rxode2::rxControl(covsInterpolation="locf", + atol=ifelse(.stiff, 1e-9, 1e-6), + rtol=ifelse(.stiff, 1e-6, 1e-3), + ssRtol=100, + ssAtol=100, + maxSS=.nbSsDoses + 1, + minSS=.nbSsDoses, + method=ifelse(.stiff, "liblsoda", "dop853"), + safeZero=FALSE) + .foceiControl <- nlmixr2est::foceiControl(rxControl=.rxControl, + maxOuterIterations = 0L, maxInnerIterations = 0L, + etaMat = env$etaMat, + covMethod=0L, + interaction = 1L) + if (assign) + env$control <- .foceiControl + .foceiControl +} + +#' @export +as.nlmixr2.monolix2rx <- function(x, ..., table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl()) { + browser() + #need x$nonmemData + # need x to have at least one endpoint + # The environment needs: + env <- new.env(parent=emptyenv()) + x <- rxode2::rxUiDecompress(x) + nlmixr2est::nlmixrWithTiming("as.nlmixr2", { + .ui <- new.env(parent=emptyenv()) + .oldUi <- x + for (n in ls(envir=.oldUi, all.names=TRUE)) { + assign(n, get(n, envir=.oldUi), envir=.ui) + } + class(.ui) <- class(.oldUi) + # - $table for table options -- already present + env$table <- table + env$origData <- x$monolixData + nlmixr2est::.foceiPreProcessData(env$origData, env, .ui, rxControl) + # - $origData -- Original Data -- already present + # - $dataSav -- Processed data from .foceiPreProcessData --already present + # - $idLvl -- Level information for ID factor added -- already present + env$ui <- .ui + # - $ui for ui fullTheta Full theta information + env$fullTheta <- .ui$monolixFullTheta + # - $etaObf data frame with ID, etas and OBJI + env$etaObf <- .ui$monolixEtaObf + if (is.null(env$etaObf)) { + .df <- data.frame(ID=unique(env$dataSav$ID)) + for (.n in .getEtaNames(.ui)) { + .df[[.n]] <- 0 + } + .df[["OBJI"]] <- NA_real_ + env$etaObf <- .df + warning("since NONMEM did not output between subject variability, assuming all ETA(#) are zero", + call.=FALSE) + } + # - $cov For covariance + .cov <- .ui$monolixCovariance + if (!is.null(.cov)) { + env$cov <- .cov + # - $covMethod for the method of calculating the covariance + env$covMethod <- "monolix2rx" + } + # - $objective objective function value + env$objective <- .ui$monolixObjf + # - $extra Extra print information + env$extra <- paste0(" reading Monolix ver ", env$ui$monolixOutputVersion) + # - $method Estimation method (for printing) + env$method <- "monolix2rx" + # - $omega Omega matrix + env$omega <- .ui$monolixOmega + # - $theta Is a theta data frame + env$theta <- .ui$monolixTheta + # - $model a list of model information for table generation. Needs a `predOnly` model + env$model <- .ui$ebe + # - $message Message for display + env$message <- "" + # - $est estimation method + env$est <- "monolix2rx" + # - $ofvType (optional) tells the type of ofv is currently being used + #env$ofvType + env$ofvType <- .ui$monolixObjfType + # Add parameter history + env$nobs <- x$dfObs + env$nobs2<- x$dfObs + # Run before converting to nonmemControl + .objf <- .ui$monolixObjf + # When running the focei problem to create the nlmixr object, you also need a + # foceiControl object + .monolix2rxToFoceiControl(env, x, TRUE) + .ret <- nlmixr2est::nlmixr2CreateOutputFromUi(env$ui, data=env$origData, + control=env$control, table=env$table, + env=env, est="monolix2rx") + if (inherits(.ret, "nlmixr2FitData")) { + .msg <- .monolixMergePredsAndCalcRelativeErr(.ret) + .msg$message <- c(.msg$message) + .tmp <- .ret$ui$monolixParHistory + assign("message", paste(.msg$message, collapse="\n "), envir=.ret$env) + if (is.null(.tmp)) { + .minfo("monolix parameter history needs exported charts, please export charts") + } else { + .tmp$type <- "Unscaled" + assign("parHistData", .tmp, .ret$env) + .minfo("monolix parameter history integrated into fit object") + } + } + ## .time <- get("time", .ret$env) + ## .time <- .time[,!(names(.time) %in% c("optimize", "covariance"))] + ## assign("time", + ## cbind(.time, data.frame(NONMEM=.ui$nonmemRunTime)), + ## .ret$env) + .ret + }, env=env) +} diff --git a/R/monolixNlmixr2est.R b/R/monolixNlmixr2est.R index 3e05701f..241bd0e1 100644 --- a/R/monolixNlmixr2est.R +++ b/R/monolixNlmixr2est.R @@ -231,7 +231,7 @@ .mlxtran <- .ui$monolixMlxtranFile .runLock <- .ui$monolixRunLock - if (file.exists(.qs)) { + if (checkmate::testFileExists(.qs)) { .minfo("load saved nlmixr2 object") .ret <- qs::qread(.qs) if (!exists("parHistData", .ret$env)) { @@ -246,7 +246,7 @@ } } return(.ret) - } else if (!file.exists(.model)) { + } else if (!checkmate::testFileExists(.model)) { .minfo("writing monolix files") writeLines(text=.modelText, con=.model) writeLines(text=.mlxtranText, con=.mlxtran) diff --git a/R/monolixReadData.R b/R/monolixReadData.R index 31060166..d29f0ac3 100644 --- a/R/monolixReadData.R +++ b/R/monolixReadData.R @@ -408,7 +408,7 @@ rxUiGet.monolixCovariance <- function(x, ...) { .cov <- rxUiGet.monolixCovarianceEstimatesSA(x, ...) .ui <- x[[1]] .split <- .ui$getSplitMuModel - + .muRef <- c(.split$pureMuRef, .split$taintMuRef) .sa <- TRUE if (is.null(.cov)) { @@ -444,30 +444,58 @@ rxUiGet.monolixPreds <- function(x, ...) { .predDf <- .ui$predDf .exportPath <- rxUiGet.monolixExportPath(x, ...) if (!file.exists(.exportPath)) return(NULL) + .mlxtran <- monolix2rx::.monolixGetMlxtran(.ui) + if (inherits(.mlxtran, "monolix2rxMlxtran")) { + if (length(.predDf$var) > 1) { + do.call("rbind", lapply(seq_along(.predDf$cond), + function(i) { + .var <- .predDf$cond[i] + .file <- file.path(.exportPath, + paste0("predictions_", .var, ".txt")) + .monolixWaitForFile(.file) + .ret <- read.csv(.file) + .ret$CMT <- .predDf$cond[i] + names(.ret) <- sub("id", "ID", + sub("time", "TIME", + sub(.var, "DV", names(.ret)))) + .ret + })) + } else { + .var <- .predDf$cond + .file <- file.path(.exportPath,"predictions.txt") + .monolixWaitForFile(.file) + .ret <- read.csv(.file) + names(.ret) <- sub("id", "ID", + sub("time", "TIME", + sub(.var, "DV", names(.ret)))) + .ret - if (length(.predDf$var) > 1) { - do.call("rbind", lapply(seq_along(.predDf$var), - function(i){ - .var <- .predDf$var[i] - .file <- file.path(.exportPath, - paste0("predictions_rx_prd_", .var, ".txt")) - .monolixWaitForFile(.file) - .ret <- read.csv(.file) - .ret$CMT <- .predDf$cond[i] - names(.ret) <- sub("id", "ID", - sub("time", "TIME", - sub(paste0("rx_prd_", .var), "DV", names(.ret)))) - .ret - })) + } } else { - .var <- .predDf$var - .file <- file.path(.exportPath,"predictions.txt") - .monolixWaitForFile(.file) - .ret <- read.csv(.file) - names(.ret) <- sub("id", "ID", - sub("time", "TIME", - sub(paste0("rx_prd_", .var), "DV", names(.ret)))) - .ret + if (length(.predDf$var) > 1) { + do.call("rbind", lapply(seq_along(.predDf$var), + function(i) { + .var <- .predDf$var[i] + .file <- file.path(.exportPath, + paste0("predictions_rx_prd_", .var, ".txt")) + .monolixWaitForFile(.file) + .ret <- read.csv(.file) + .ret$CMT <- .predDf$cond[i] + names(.ret) <- sub("id", "ID", + sub("time", "TIME", + sub(paste0("rx_prd_", .var), "DV", names(.ret)))) + .ret + })) + } else { + .var <- .predDf$var + .file <- file.path(.exportPath,"predictions.txt") + .monolixWaitForFile(.file) + .ret <- read.csv(.file) + names(.ret) <- sub("id", "ID", + sub("time", "TIME", + sub(paste0("rx_prd_", .var), "DV", names(.ret)))) + .ret + } } } @@ -507,4 +535,3 @@ rxUiGet.monolixPreds <- function(x, ...) { individualAbs=.qai, popAbs=.qap, message=.msg) } - diff --git a/R/monolixRxUiGet.R b/R/monolixRxUiGet.R index e0ddeabd..c8313e92 100644 --- a/R/monolixRxUiGet.R +++ b/R/monolixRxUiGet.R @@ -15,6 +15,16 @@ rxUiGet.monolixModelName <- function(x, ...) { #' @export rxUiGet.monolixExportPath <- function(x, ...) { .ui <- x[[1]] + # Handle monolix2rx as well + .mlxtran <- monolix2rx::.monolixGetMlxtran(.ui) + if (inherits(.mlxtran, "monolix2rxMlxtran")) { + .wd <- attr(.mlxtran, "dirn") + if (!checkmate::testDirectoryExists(.wd)) .wd <- getwd() + withr::with_dir(.wd, { + .exportPath <- .mlxtran$MONOLIX$SETTINGS$GLOBAL$exportpath + return(path.expand(file.path(.wd, .exportPath))) + }) + } .extra <- "" .num <- rxode2::rxGetControl(.ui, ".modelNumber", 0) if (.num > 0) { diff --git a/R/reexport.R b/R/reexport.R index 0cd1b494..580e44ec 100644 --- a/R/reexport.R +++ b/R/reexport.R @@ -38,3 +38,6 @@ nonmem2rx::nonmem2rx #' @export nonmem2rx::as.nonmem2rx +#' @importFrom monolix2rx monolix2rx +#' @export +monolix2rx::monolix2rx diff --git a/man/reexports.Rd b/man/reexports.Rd index 0dd8d3b9..67c93bc2 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -13,6 +13,7 @@ \alias{nmObjGetControl} \alias{nonmem2rx} \alias{as.nonmem2rx} +\alias{monolix2rx} \title{Objects exported from other packages} \keyword{internal} \description{ @@ -20,6 +21,8 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ + \item{monolix2rx}{\code{\link[monolix2rx]{monolix2rx}}} + \item{nlmixr2est}{\code{\link[nlmixr2est:getValidNlmixrControl]{getValidNlmixrCtl}}, \code{\link[nlmixr2est]{nlmixr2Est}}, \code{\link[nlmixr2est]{nmObjGetControl}}, \code{\link[nlmixr2est]{nmObjGetFoceiControl}}, \code{\link[nlmixr2est]{nmObjHandleControlObject}}} \item{nonmem2rx}{\code{\link[nonmem2rx]{as.nonmem2rx}}, \code{\link[nonmem2rx]{nonmem2rx}}}