as.nlmixr2 for monolix2rx objects

.github/workflows/R-CMD-check.yaml

@@ -66,6 +66,7 @@ jobs:
             nlmixr2/nlmixr2plot
             nlmixr2/nlmixr2
             nlmixr2/nonmem2rx
+            nlmixr2/monolix2rx
             lixoftConnectors=?ignore
           needs: check
 

.github/workflows/pkgdown.yaml

@@ -42,6 +42,7 @@ jobs:
             nlmixr2/rxode2ll
             nlmixr2/rxode2
             nlmixr2/nonmem2rx
+            nlmixr2/monolix2rx
             nlmixr2/nlmixr2est
             nlmixr2/nlmixr2rpt
             mrgsolve

.github/workflows/test-coverage.yaml

@@ -40,6 +40,7 @@ jobs:
             nlmixr2/nlmixr2plot
             nlmixr2/nlmixr2
             nlmixr2/nonmem2rx
+            nlmixr2/monolix2rx
             lixoftConnectors=?ignore
           needs: coverage
 

DESCRIPTION

@@ -39,6 +39,7 @@ Imports:
     lotri,
     nlmixr2est (>= 2.1.6),
     nonmem2rx (>= 0.1.3),
+    monolix2rx,
     methods,
     qs,
     rex,

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)
@@ -151,14 +153,21 @@ export(bblDatToPknca)
 export(bblDatToRxode)
 export(getStandardColNames)
 export(getValidNlmixrCtl)
+export(mlxtran)
 export(modelUnitConversion)
+export(monolix2rx)
 export(monolixControl)
 export(nlmixr2Est)
 export(nmGetDistributionMonolixLines)
 export(nmGetDistributionNonmemLines)
 export(nmObjGetControl)
 export(nmObjGetFoceiControl)
 export(nmObjHandleControlObject)
+export(nmcov)
+export(nmext)
+export(nminfo)
+export(nmtab)
+export(nmxml)
 export(nonmem2rx)
 export(nonmemControl)
 export(pkncaControl)
@@ -169,13 +178,20 @@ export(rxToNonmem)
 export(rxUiGet)
 export(simplifyUnit)
 importFrom(methods,is)
+importFrom(monolix2rx,mlxtran)
+importFrom(monolix2rx,monolix2rx)
 importFrom(nlmixr2,nlmixr2)
 importFrom(nlmixr2est,getValidNlmixrCtl)
 importFrom(nlmixr2est,nlmixr2Est)
 importFrom(nlmixr2est,nmObjGetControl)
 importFrom(nlmixr2est,nmObjGetFoceiControl)
 importFrom(nlmixr2est,nmObjHandleControlObject)
 importFrom(nonmem2rx,as.nonmem2rx)
+importFrom(nonmem2rx,nmcov)
+importFrom(nonmem2rx,nmext)
+importFrom(nonmem2rx,nminfo)
+importFrom(nonmem2rx,nmtab)
+importFrom(nonmem2rx,nmxml)
 importFrom(nonmem2rx,nonmem2rx)
 importFrom(rxode2,.minfo)
 importFrom(rxode2,`model<-`)

R/as.nlmixr2.R

@@ -6,6 +6,8 @@
 #' @param rxControl is the `rxode2::rxControl()` options, which is
 #'   generally needed for how `addl` doses are handled in the
 #'   translation
+#' @param ci is the confidence interval of the residual differences
+#'   calculated (by default 0.95)
 #' @return nlmixr2 fit object
 #' @export
 #' @author Matthew L. Fidler
@@ -63,15 +65,15 @@
 #' print(fit)
 #'
 #' }
-as.nlmixr2 <- function(x, ..., table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl()) {
+as.nlmixr2 <- function(x, ..., table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl(), ci=0.95) {
   UseMethod("as.nlmixr2")
 }
 #' @rdname as.nlmixr2
 #' @export
 as.nlmixr <- as.nlmixr2
 
 #' @export
-as.nlmixr2.default <- function(x, ..., table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl()) {
+as.nlmixr2.default <- function(x, ..., table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl(), ci=0.95) {
   stop("cannot figure out how to create an nlmixr2 object from the input",
        call.=FALSE)
 }

R/as.nlmixr2monolixr2rx.R

@@ -0,0 +1,139 @@
+#' @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(), ci=0.95) {
+  #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 Monolix 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")) {
+      assign("monolixControl", list(ci=ci), .ret$env)
+      .msg <- .monolixMergePredsAndCalcRelativeErr(.ret)
+      rm("monolixControl", envir=.ret$env)
+      .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)
+}

R/as.nlmixr2nonmem2rx.R

@@ -27,11 +27,11 @@ nmObjGetControl.nonmem2rx <- function(x, ...) {
                                             interaction = 1L)
   if (assign)
     env$control <- .foceiControl
-  .foceiControl 
+  .foceiControl
 }
 
 #' @export
-as.nlmixr2.nonmem2rx <- function(x, ..., table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl()) {
+as.nlmixr2.nonmem2rx <- function(x, ..., table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl(), ci=0.95) {
   #need x$nonmemData
   # need x to have at least one endpoint
   # The environment needs:
@@ -105,7 +105,9 @@ as.nlmixr2.nonmem2rx <- function(x, ..., table=nlmixr2est::tableControl(), rxCon
                                                   control=env$control, table=env$table,
                                                   env=env, est="nonmem2rx")
     if (inherits(.ret, "nlmixr2FitData")) {
+      assign("nonmemControl", list(ci=ci), .ret$env)
       .msg <- .nonmemMergePredsAndCalcRelativeErr(.ret)
+      rm("nonmemControl", envir=.ret$env)
       .prderrPath <- file.path(x$nonmemExportPath, "PRDERR")
       .msg$message <- c(.ui$nonmemTransMessage,
                         .ui$nonmemTermMessage,

R/monolixNlmixr2est.R

@@ -235,7 +235,7 @@
   .runLock <- .ui$monolixRunLock
 
   .cmd <- rxode2::rxGetControl(.ui, "runCommand", "")
-  if (file.exists(.qs)) {
+if (checkmate::testFileExists(.qs)) {
     .minfo("load saved nlmixr2 object")
     .ret <- qs::qread(.qs)
     if (!exists("parHistData", .ret$env)) {
@@ -250,7 +250,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)

R/monolixReadData.R

@@ -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
+    }
   }
 }
 

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) {