From 05864cda4ac6f2593961c87db03d779cf809434e Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Wed, 16 Aug 2023 18:31:37 -0500 Subject: [PATCH 1/7] Update ssLag --- NEWS.md | 4 ++++ R/as.nlmixr2nonmem2rx.R | 2 +- R/convert.R | 34 +++++++++++++++++++++------------- R/monolixNlmixr2est.R | 2 +- R/nonmemNlmixr2est.R | 2 +- R/pknca.R | 8 +++++--- 6 files changed, 33 insertions(+), 19 deletions(-) diff --git a/NEWS.md b/NEWS.md index 40870493..08e181d4 100644 --- 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 @@ -14,6 +17,7 @@ * Fix to save parameter history into `$parHistData` to accommodate changes in `focei`'s output (`$parHist` is now derived). + # babelmixr2 0.1.1 diff --git a/R/as.nlmixr2nonmem2rx.R b/R/as.nlmixr2nonmem2rx.R index 762923b4..ab91d413 100644 --- a/R/as.nlmixr2nonmem2rx.R +++ b/R/as.nlmixr2nonmem2rx.R @@ -48,7 +48,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, env$control$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 index 30abc755..4146622f 100644 --- 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,8 +351,9 @@ 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) } @@ -355,18 +361,20 @@ bblDatToRxode <- function(model, data, table=nlmixr2est::tableControl(), env=NUL #' @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 index a73c5159..60087a80 100644 --- 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 index 8c46e2f2..7546c4a6 100644 --- 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, control=.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 index 543fb2f5..e91545a6 100644 --- a/R/pknca.R +++ b/R/pknca.R @@ -225,7 +225,7 @@ calcPknca <- function(env, pkncaUnits) { # 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=env$control$rxControl) cleanColNames <- getStandardColNames(cleanData$obs) oConcFormula <- stats::as.formula(sprintf( @@ -403,7 +403,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 +419,8 @@ pkncaControl <- function(concu = NA_character_, doseu = NA_character_, timeu = N groups = groups, sparse = sparse, ncaData = ncaData, - ncaResults = ncaResults + ncaResults = ncaResults, + rxControl=rxControl ) ) } From 001f3971911c03fa2ea1b4aa4d38f4018a726f54 Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Wed, 16 Aug 2023 21:53:29 -0500 Subject: [PATCH 2/7] Add to news --- NEWS.md | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 08e181d4..cc6e0dd6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -17,7 +17,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 From 23ab89ef6d397b5f571333f6328c98c81820da96 Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Wed, 16 Aug 2023 21:54:50 -0500 Subject: [PATCH 3/7] Fix nonmem2rx version dependency --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 002f35c5..c1238d1c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -35,7 +35,7 @@ Imports: digest, lotri, nlmixr2est (>= 2.1.6), - nonmem2rx, + nonmem2rx (> 0.1.2), methods, qs, rex, From 8e1f69356301fe778c6f71995a5a61df1367a066 Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Thu, 17 Aug 2023 09:48:49 -0500 Subject: [PATCH 4/7] Add rxControl to as.nlmixr2 --- R/as.nlmixr2.R | 9 ++++--- R/as.nlmixr2nonmem2rx.R | 5 ++-- man/as.nlmixr2.Rd | 18 ++++++++++++-- man/bblDatToMonolix.Rd | 53 +++++++++++++++++++++++++++++++++-------- man/pkncaControl.Rd | 3 ++- 5 files changed, 69 insertions(+), 19 deletions(-) diff --git a/R/as.nlmixr2.R b/R/as.nlmixr2.R index 7388a2d4..a6c17a8d 100644 --- a/R/as.nlmixr2.R +++ b/R/as.nlmixr2.R @@ -1,8 +1,11 @@ -#' Convert an object to a nlmixr2 fit object +#' Convert an oburject to a nlmixr2 fit object #' #' @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,7 +63,7 @@ #' 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 @@ -68,7 +71,7 @@ as.nlmixr2 <- function(x, ..., table=nlmixr2est::tableControl()) { 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 index ab91d413..3b6fe99e 100644 --- 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, env$control$rxControl) + 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/man/as.nlmixr2.Rd b/man/as.nlmixr2.Rd index 9796408d..aa81e18c 100644 --- a/man/as.nlmixr2.Rd +++ b/man/as.nlmixr2.Rd @@ -5,9 +5,19 @@ \alias{as.nlmixr} \title{Convert an object to a nlmixr2 fit object} \usage{ -as.nlmixr2(x, ..., table = nlmixr2est::tableControl()) +as.nlmixr2( + x, + ..., + table = nlmixr2est::tableControl(), + rxControl = rxode2::rxControl() +) -as.nlmixr(x, ..., table = nlmixr2est::tableControl()) +as.nlmixr( + x, + ..., + table = nlmixr2est::tableControl(), + rxControl = rxode2::rxControl() +) } \arguments{ \item{x}{Object to convert} @@ -15,6 +25,10 @@ as.nlmixr(x, ..., table = nlmixr2est::tableControl()) \item{...}{Other arguments} \item{table}{is the `nlmixr2est::tableControl()` options} + +\item{rxControl}{is the `rxode2::rxControl()` options, which is +generally needed for how `addl` doses are handled in the +translation} } \value{ nlmixr2 fit object diff --git a/man/bblDatToMonolix.Rd b/man/bblDatToMonolix.Rd index deeed241..1ecb729b 100644 --- a/man/bblDatToMonolix.Rd +++ b/man/bblDatToMonolix.Rd @@ -8,15 +8,45 @@ \alias{bblDatToPknca} \title{Convert nlmixr2-compatible data to other formats (if possible)} \usage{ -bblDatToMonolix(model, data, table = nlmixr2est::tableControl(), env = NULL) - -bblDatToNonmem(model, data, table = nlmixr2est::tableControl(), env = NULL) - -bblDatToRxode(model, data, table = nlmixr2est::tableControl(), env = NULL) - -bblDatToMrgsolve(model, data, table = nlmixr2est::tableControl(), env = NULL) - -bblDatToPknca(model, data, table = nlmixr2est::tableControl(), env = NULL) +bblDatToMonolix( + model, + data, + table = nlmixr2est::tableControl(), + rxControl = rxode2::rxControl(), + env = NULL +) + +bblDatToNonmem( + model, + data, + table = nlmixr2est::tableControl(), + rxControl = rxode2::rxControl(), + env = NULL +) + +bblDatToRxode( + model, + data, + table = nlmixr2est::tableControl(), + rxControl = rxode2::rxControl(), + env = NULL +) + +bblDatToMrgsolve( + model, + data, + table = nlmixr2est::tableControl(), + rxControl = rxode2::rxControl(), + env = NULL +) + +bblDatToPknca( + model, + data, + table = nlmixr2est::tableControl(), + rxControl = rxode2::rxControl(), + env = NULL +) } \arguments{ \item{model}{rxode2 model for conversion} @@ -26,9 +56,12 @@ bblDatToPknca(model, data, table = nlmixr2est::tableControl(), env = NULL) \item{table}{is the table control; this is mostly to figure out if there are additional columns to keep.} +\item{rxControl}{is the rxode2 control options; This is to figure +out how to handle the addl dosing information.} + \item{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.} } \value{ With the function `bblDatToMonolix()` return a list with: diff --git a/man/pkncaControl.Rd b/man/pkncaControl.Rd index ad63f291..e5cddfe8 100644 --- a/man/pkncaControl.Rd +++ b/man/pkncaControl.Rd @@ -17,7 +17,8 @@ pkncaControl( groups = character(), sparse = FALSE, ncaData = NULL, - ncaResults = NULL + ncaResults = NULL, + rxControl = rxode2::rxControl() ) } \arguments{ From ee006485d4b2d1e1925f10e07a45368f4347414c Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Thu, 17 Aug 2023 09:49:27 -0500 Subject: [PATCH 5/7] Fix typo --- R/as.nlmixr2.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/as.nlmixr2.R b/R/as.nlmixr2.R index a6c17a8d..9970d786 100644 --- a/R/as.nlmixr2.R +++ b/R/as.nlmixr2.R @@ -1,4 +1,4 @@ -#' Convert an oburject to a nlmixr2 fit object +#' Convert an object to a nlmixr2 fit object #' #' @param x Object to convert #' @param ... Other arguments From 487c702f53f0e7c168fbab96bb5decf3da53f15a Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Thu, 17 Aug 2023 09:55:06 -0500 Subject: [PATCH 6/7] Fix nonmem conversion arguments --- R/nonmemNlmixr2est.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/nonmemNlmixr2est.R b/R/nonmemNlmixr2est.R index 7546c4a6..71460f45 100644 --- 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, control=.control$rxControl, 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) From 1feb3e713341820d91f3242d451cf71509bde6ff Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Thu, 17 Aug 2023 10:07:52 -0500 Subject: [PATCH 7/7] Fix rxControl requirements for pknca --- R/pknca.R | 4 +++- tests/testthat/test-pknca.R | 3 ++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/R/pknca.R b/R/pknca.R index e91545a6..f6178b4d 100644 --- 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, rxControl=env$control$rxControl) + cleanData <- bblDatToPknca(model = env$ui, data = rawData, rxControl=rxControl) cleanColNames <- getStandardColNames(cleanData$obs) oConcFormula <- stats::as.formula(sprintf( diff --git a/tests/testthat/test-pknca.R b/tests/testthat/test-pknca.R index f88fd222..23f34e8b 100644 --- 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() ) )