Merge pull request #93 from nlmixr2/ssLag-fixes

Update ssLag
nlmixr2 · Aug 27, 2023 · fd21edf · fd21edf
2 parents 72de43b + 1feb3e7
commit fd21edf
Show file tree

Hide file tree

Showing 12 changed files with 110 additions and 38 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -35,7 +35,7 @@ Imports:
     digest,
     lotri,
     nlmixr2est (>= 2.1.6),
-    nonmem2rx,
+    nonmem2rx (> 0.1.2),
     methods,
     qs,
     rex,

diff --git a/NEWS.md b/NEWS.md
@@ -2,6 +2,9 @@
 
 * Handle algebraic `mu` expressions
 
+* PKNCA controller now contains `rxControl` since it is used for some
+  translation options
+
 * This revision will load the pruned ui model to query the compartment
   properties (i.e. bioavailability, lag time, etc) when writing out the
   NONMEM model.  It should fix issues where the PK block does not
@@ -15,6 +18,12 @@
 * Fix to save parameter history into `$parHistData` to accommodate
   changes in `focei`'s output (`$parHist` is now derived).
 
+* Changed the solving options to match the new steady state options in
+  `rxode2` and how NONMEM implements them.  Also changed the itwres
+  model to account for the `rxerr.` instead of the `err.` which was
+  updated in `rxode2` as well.
+
+
 # babelmixr2 0.1.1
 
 * Add new method `as.nlmixr2` to convert `nonmem2rx` methods to `nlmixr` fits

diff --git a/R/as.nlmixr2.R b/R/as.nlmixr2.R
@@ -3,6 +3,9 @@
 #' @param x Object to convert
 #' @param ... Other arguments
 #' @param table is the `nlmixr2est::tableControl()` options
+#' @param rxControl is the `rxode2::rxControl()` options, which is
+#'   generally needed for how `addl` doses are handled in the
+#'   translation
 #' @return nlmixr2 fit object
 #' @export
 #' @author Matthew L. Fidler
@@ -60,15 +63,15 @@
 #' print(fit)
 #'
 #' }
-as.nlmixr2 <- function(x, ..., table=nlmixr2est::tableControl()) {
+as.nlmixr2 <- function(x, ..., table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl()) {
   UseMethod("as.nlmixr2")
 }
 #' @rdname as.nlmixr2
 #' @export
 as.nlmixr <- as.nlmixr2
 
 #' @export
-as.nlmixr2.default <- function(x, ..., table=nlmixr2est::tableControl()) {
+as.nlmixr2.default <- function(x, ..., table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl()) {
   stop("cannot figure out how to create an nlmixr2 object from the input",
        call.=FALSE)
 }
diff --git a/R/as.nlmixr2nonmem2rx.R b/R/as.nlmixr2nonmem2rx.R
@@ -12,7 +12,6 @@ nmObjGetControl.nonmem2rx <- function(x, ...) {
   stop("cannot find nonmem2rx related control object", call.=FALSE)
 }
 
-
 .nonmem2rxToFoceiControl <- function(env, model, assign=FALSE) {
   .rxControl <- rxode2::rxControl(covsInterpolation="nocb",
                                   atol=model$atol,
@@ -32,7 +31,7 @@ nmObjGetControl.nonmem2rx <- function(x, ...) {
 }
 
 #' @export
-as.nlmixr2.nonmem2rx <- function(x, ..., table=nlmixr2est::tableControl()) {
+as.nlmixr2.nonmem2rx <- function(x, ..., table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl()) {
   #need x$nonmemData
   # need x to have at least one endpoint
   # The environment needs:
@@ -48,7 +47,7 @@ as.nlmixr2.nonmem2rx <- function(x, ..., table=nlmixr2est::tableControl()) {
     # - $table for table options -- already present
     env$table <- table
     env$origData <- x$nonmemData
-    nlmixr2est::.foceiPreProcessData(env$origData, env, .ui)
+    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

diff --git a/R/convert.R b/R/convert.R
@@ -9,9 +9,12 @@
 #' @param table is the table control; this is mostly to figure out if
 #'   there are additional columns to keep.
 #'
+#' @param rxControl is the rxode2 control options; This is to figure
+#'   out how to handle the addl dosing information.
+#'
 #' @param env When `NULL` (default) nothing is done.  When an
 #'   environment, the function `nlmixr2est::.foceiPreProcessData(data,
-#'   env, model)` is called on the provided environment.
+#'   env, model, rxControl)` is called on the provided environment.
 #'
 #' @return
 #'
@@ -96,7 +99,8 @@
 #' bblDatToRxode(pk.turnover.emax3, nlmixr2data::warfarin)
 #'
 #' @useDynLib babelmixr2, .registration=TRUE
-bblDatToMonolix <- function(model, data, table=nlmixr2est::tableControl(), env=NULL) {
+bblDatToMonolix <- function(model, data, table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl(),
+                            env=NULL) {
   # https://dataset.lixoft.com/faq/translating-your-dataset-from-nonmem-format-to-the-monolix-suite-format/
   nlmixr2est::nmObjUiSetCompressed(FALSE)
   on.exit({nlmixr2est::nmObjUiSetCompressed(TRUE)})
@@ -109,7 +113,7 @@ bblDatToMonolix <- function(model, data, table=nlmixr2est::tableControl(), env=N
     .env <- new.env(parent=emptyenv())
   }
   .env$table <- table
-  nlmixr2est::.foceiPreProcessData(data, .env, model)
+  nlmixr2est::.foceiPreProcessData(data, .env, model, rxControl)
   .mv <- rxode2::rxModelVars(model)
   .flag <- .mv$flags
   .conv0 <- .Call(`_babelmixr2_convertDataBack`, .env$dataSav$ID, .env$dataSav$TIME, .env$dataSav$AMT,
@@ -214,7 +218,7 @@ bblDatToMonolix <- function(model, data, table=nlmixr2est::tableControl(), env=N
         .predDf$trLow, .predDf$trHi)
 }
 
-.bblDatToNonmem <- function(model, data, table=nlmixr2est::tableControl(),
+.bblDatToNonmem <- function(model, data, table=nlmixr2est::tableControl(), rxControl=rxode2::rxControl(),
                                 fun="bblDatToNonmem", replaceEvid=5L,
                             replaceOK=FALSE, software="NONMEM", env=NULL) {
   nlmixr2est::nmObjUiSetCompressed(FALSE)
@@ -229,7 +233,7 @@ bblDatToMonolix <- function(model, data, table=nlmixr2est::tableControl(), env=N
     .env <- new.env(parent=emptyenv())
   }
   .env$table <- table
-  nlmixr2est::.foceiPreProcessData(data, .env, model)
+  nlmixr2est::.foceiPreProcessData(data, .env, model, rxControl)
   .mv <- rxode2::rxModelVars(model)
   .flag <- .mv$flags
   .conv0 <- .Call(`_babelmixr2_convertDataBack`, .env$dataSav$ID, .env$dataSav$TIME, .env$dataSav$AMT,
@@ -292,13 +296,14 @@ bblDatToMonolix <- function(model, data, table=nlmixr2est::tableControl(), env=N
 
 #' @rdname bblDatToMonolix
 #' @export
-bblDatToNonmem <- function(model, data, table=nlmixr2est::tableControl(), env=NULL) {
+bblDatToNonmem <- function(model, data, table=nlmixr2est::tableControl(),
+                           rxControl=rxode2::rxControl(), env=NULL) {
   nlmixr2est::nmObjUiSetCompressed(FALSE)
   on.exit({nlmixr2est::nmObjUiSetCompressed(TRUE)})
   .xtra <- paste0(" to convert the data with 'bblDatToNonmem'")
   model <- rxode2::assertRxUi(model, extra=.xtra)
   model <- rxode2::rxUiDecompress(model)
-  .ret <- .bblDatToNonmem (model, data, table,
+  .ret <- .bblDatToNonmem (model, data, table, rxControl, 
                            fun="bblDatToNonmem", replaceEvid=5L,
                            replaceOK=FALSE, software="NONMEM", env=env)
   nlmixr2est::nmObjUiSetCompressed(FALSE)
@@ -346,27 +351,30 @@ bblDatToNonmem <- function(model, data, table=nlmixr2est::tableControl(), env=NU
 
 #' @rdname bblDatToMonolix
 #' @export
-bblDatToRxode <- function(model, data, table=nlmixr2est::tableControl(), env=NULL) {
-  .bblDatToNonmem(model, data, table,
+bblDatToRxode <- function(model, data, table=nlmixr2est::tableControl(),
+                          rxControl=rxode2::rxControl(), env=NULL) {
+  .bblDatToNonmem(model, data, table, rxControl,
                   fun="bblDatToRxode", replaceEvid=5L,
                   replaceOK=NA, software="rxode2", env=env)
 }
 
 
 #' @rdname bblDatToMonolix
 #' @export
-bblDatToMrgsolve <- function(model, data, table=nlmixr2est::tableControl(), env=NULL) {
-  .bblDatToNonmem(model, data, table,
+bblDatToMrgsolve <- function(model, data, table=nlmixr2est::tableControl(),
+                             rxControl=rxode2::rxControl(), env=NULL) {
+  .bblDatToNonmem(model, data, table, rxControl,
                   fun="bblDatToMrgsolve", replaceEvid=8L,
                   replaceOK=TRUE, software="mrgsolve", env=env)
 }
 
 #' @rdname bblDatToMonolix
 #' @export
-bblDatToPknca <- function(model, data, table=nlmixr2est::tableControl(), env=NULL) {
+bblDatToPknca <- function(model, data, table=nlmixr2est::tableControl(),
+                          rxControl=rxode2::rxControl(), env=NULL) {
   newData <-
     .bblDatToNonmem(
-      model, data, table,
+      model, data, table, rxControl, 
       fun="bblDatToPknca", replaceEvid=5L,
       replaceOK=TRUE, software="pknca", env=env
     )

diff --git a/R/monolixNlmixr2est.R b/R/monolixNlmixr2est.R
@@ -152,7 +152,7 @@
   .ret <- new.env(parent=emptyenv())
   .ret$table <- env$table
   .ret$monolixControl <- .control
-  .tmp  <- bblDatToMonolix(.ui, .data, table=env$table, env=.ret)
+  .tmp  <- bblDatToMonolix(.ui, .data, table=env$table, rxControl=.control$rxControl, env=.ret)
   .ret$monolixData <- .monolixFormatData(.tmp$monolix, .ui)
   .tmp <- .tmp$adm
   if (length(.tmp$adm) == 0) {

diff --git a/R/nonmemNlmixr2est.R b/R/nonmemNlmixr2est.R
@@ -130,7 +130,7 @@
   .ret <- new.env(parent=emptyenv())
   .ret$table <- env$table
   .ret$nonmemControl <- .control
-  .tmp  <- bblDatToNonmem(.ui, .data, table=env$table, env=.ret)
+  .tmp  <- bblDatToNonmem(.ui, .data, table=env$table, rxControl=.control$rxControl, env=.ret)
   .ret$nonmemData <- .nonmemFormatData(.tmp, .ui)
   rxode2::rxAssignControlValue(.ui, ".cmtCnt", env$nmNcmt)
 

diff --git a/R/pknca.R b/R/pknca.R
@@ -219,13 +219,15 @@ getDvLines <- function(modelfun, inModel = FALSE, dvAssign = NULL) {
 #' @noRd
 calcPknca <- function(env, pkncaUnits) {
   # Normalize column names
+  rxControl <- env$control[[1]]$rxControl
   control <- env$control[[1]]
   rawData <- env$data
+
   if (!is.null(control$ncaData)) {
     # as.data.frame() due to https://github.com/nlmixr2/nlmixr2est/pull/262
     rawData <- as.data.frame(control$ncaData)
   }
-  cleanData <- bblDatToPknca(model = env$ui, data = rawData)
+  cleanData <- bblDatToPknca(model = env$ui, data = rawData, rxControl=rxControl)
   cleanColNames <- getStandardColNames(cleanData$obs)
   oConcFormula <-
     stats::as.formula(sprintf(
@@ -403,7 +405,8 @@ pkncaControl <- function(concu = NA_character_, doseu = NA_character_, timeu = N
                          groups = character(),
                          sparse = FALSE,
                          ncaData = NULL,
-                         ncaResults = NULL) {
+                         ncaResults = NULL,
+                         rxControl=rxode2::rxControl()) {
   getValidNlmixrCtl.pknca(
     list(
       concu = concu,
@@ -418,7 +421,8 @@ pkncaControl <- function(concu = NA_character_, doseu = NA_character_, timeu = N
       groups = groups,
       sparse = sparse,
       ncaData = ncaData,
-      ncaResults = ncaResults
+      ncaResults = ncaResults,
+      rxControl=rxControl
     )
   )
 }

diff --git a/man/as.nlmixr2.Rd b/man/as.nlmixr2.Rd
diff --git a/man/bblDatToMonolix.Rd b/man/bblDatToMonolix.Rd
diff --git a/man/pkncaControl.Rd b/man/pkncaControl.Rd
diff --git a/tests/testthat/test-pknca.R b/tests/testthat/test-pknca.R
@@ -66,7 +66,8 @@ test_that("pkncaControl", {
       groups = "foo",
       sparse = FALSE,
       ncaData = NULL,
-      ncaResults = NULL
+      ncaResults = NULL,
+      rxControl= rxode2::rxControl()
     )
   )