diff --git a/R/dataImport.R b/R/dataImport.R index 410eecf..74ea2d7 100644 --- a/R/dataImport.R +++ b/R/dataImport.R @@ -172,10 +172,16 @@ if (length(.w) != 1L) return(data) # no observationtype in the dataset if (is.null(ui$predDf)) return(data[, -.w]) # single endpoint; no need to define # multiple endpoint + .dvid <- unique(data$rxMDvid) + .dvid <- .dvid[!is.na(.dvid)] + .dvid <- .dvid[!(.dvid %in% seq_along(ui$predDf$cond))] for (.i in seq_along(ui$predDf$cond)) { # only overwrite non-dosing events (ie make sure the cmt is NA) data$cmt[which(is.na(data$cmt) & data$rxMDvid == .i)] <- ui$predDf$var[.i] } + for(.i in .dvid) { + data <- data[-which(is.na(data$cmt) & data$rxMDvid == .i), ] + } data[, -.w] } diff --git a/R/equation.R b/R/equation.R index 94f8b06..56afe7b 100644 --- a/R/equation.R +++ b/R/equation.R @@ -258,6 +258,29 @@ mlxTxt <- function(file, retFile=FALSE) { .lines <- file .dirn <- getwd() } else { + if (requireNamespace("lixoftConnectors", quietly = TRUE)) { + if (!checkmate::testCharacter(file, min.chars = 5, len=1)) { + .pre <- substr(file, 1, 4) + } + if (.pre == "lib:") { + if (is.na(.monolix2rx$lixoftConnectors)) { + x <- try(lixoftConnectors::initializeLixoftConnectors(software = "monolix", force=TRUE), silent=TRUE) + if (inherits(x, "try-error")) { + warning("lixoftConnectors cannot be initialized", + call.=FALSE) + .monolix2rx$lixoftConnectors <- FALSE + } else { + .monolix2rx$lixoftConnectors <- TRUE + } + } + if (.monolix2rx$lixoftConnectors) { + .ret <- try(lixoftConnectors::getLibraryModelContent(, print=FALSE), silent=TRUE) + if (!inherits(.ret, "try-error")) { + return(as.character(.ret)) + } + } + } + } .f <- .mlxtranLib(file) if (checkmate::testFileExists(.f, "r")) { .lines <- suppressWarnings(readLines(.f)) diff --git a/R/monolix2rx.R b/R/monolix2rx.R index e76f551..a98a57f 100644 --- a/R/monolix2rx.R +++ b/R/monolix2rx.R @@ -1,4 +1,5 @@ .monolix2rx <- new.env(parent=emptyenv()) +.monolix2rx$lixoftConnectors <- NA #' Output the information #' #' @param text character vector of the text to echo diff --git a/R/rxUiGet.R b/R/rxUiGet.R index 6d1b725..19468e4 100644 --- a/R/rxUiGet.R +++ b/R/rxUiGet.R @@ -12,6 +12,8 @@ rxUiGet.monolixModelIwres <- function(x, ...) { if (length(.ui$predDf$cond) == 1) { .ret <- suppressMessages(rxode2::model(.ui, iwres <- (DV-rx_pred_)/sqrt(rx_r_), append=sim, auto=FALSE)) + .ret <- suppressMessages(rxode2::model(.ret, ires <- DV-rx_pred_, + append=sim, auto=FALSE)) } else { .ret <- suppressMessages(rxode2::as.rxUi(.ui)) .lstExpr <- .ret$lstExpr @@ -20,7 +22,8 @@ rxUiGet.monolixModelIwres <- function(x, ...) { identical(.lstExpr[[.l]][[1]], quote(`cmt`))) .l <- .l - 1 .lstOut <- c(list(quote(`{`)), lapply(seq_len(.l), function(i) .lstExpr[[i]]), - list(quote(iwres <- (DV-rx_pred_)/sqrt(rx_r_))), + list(quote(iwres <- (DV-rx_pred_)/sqrt(rx_r_)), + quote(ires <- DV-rx_pred_)), lapply(seq(.l+1, length(.lstExpr)), function(i) .lstExpr[[i]])) .lstOut <- as.call(list(quote(`model`), as.call(.lstOut))) rxode2::model(.ret) <- .lstOut diff --git a/R/validate.R b/R/validate.R index 4722c4c..038833a 100644 --- a/R/validate.R +++ b/R/validate.R @@ -88,7 +88,6 @@ return(.ret) } } - #' Validate the imported model #' #' @param ui rxode2 ui that is used to validate the model @@ -125,7 +124,8 @@ atol=.tol, rtol=.tol, ssAtol=100, ssRtol=100, omega=NULL, addDosing = FALSE)) - .ipredSolve <- .subsetMonolix(.ui, .ipredSolve, "iwres") + + .ipredSolve <- .subsetMonolix(.ui, .ipredSolve, c("iwres", "ires")) .minfo("done") .minfo("solving pred problem") .predSolve <- try(rxode2::rxSolve(.model, .pop, .data, returnType = "data.frame", @@ -138,7 +138,19 @@ ssAtol=100, ssRtol=100, omega=NULL, addDosing = FALSE)) .predSolve <- .subsetMonolix(.ui, .predSolve) - .both <- merge(.predSolve, .ipredSolve) + .nPredSolve <- length(.predSolve[, 1]) + .nIpredSolve <- length(.ipredSolve[, 1]) + if (.nPredSolve == .nIpredSolve && + all(.ipredSolve$id == .predSolve$id) && + all(.ipredSolve$time == .predSolve$time) && + all(.ipredSolve$cmt == .predSolve$cmt)) { + .both <- .ipredSolve + .both$pred <-.predSolve$pred + .nBoth <- length(.both[, 1]) + } else { + .minfo("ipred and pred rxode2 solves do not match for id, time and cmt") + return(invisible()) + } .monolix <- ui$predIpredData names(.monolix) <- vapply(names(.monolix), function(n) { @@ -148,6 +160,11 @@ } n }, character(1), USE.NAMES = FALSE) + .nMonolix <- length(.monolix[, 1]) + if (.nMonolix != .nBoth) { + .minfo("monolix and rxode2 solves have different number of rows") + return(invisible()) + } .both <- merge(.monolix, .both) .ci0 <- .ci <- ci .sigdig <- sigdig diff --git a/README.Rmd b/README.Rmd index 87b9cd1..8a44e1d 100644 --- a/README.Rmd +++ b/README.Rmd @@ -122,42 +122,26 @@ try(monolix2rx("lib:notThere.txt")) ``` In newer versions of Monolix, the model library was turned into a -binary database that is accessed by the GUI. To me there are -advantages of this: +binary database that is accessed by the GUI and `lixoftConnectors`. +If you have `lixoftConnectors` on your system and it can successfully +load the model with `lixoftConnectors::getLibraryModelContent()` then +`monolix2rx` will also load the model correctly (and will use this +version over the text files when both are setup) -- A binary database would be much faster in loading models +This means you will need to import models into `rxode2` you need to: -- With a model library, you don't have to put common model files all - over the place (saving space on your system) +- For a model built from the model library you will need: -- It would make their hard work on the excellent model library harder - to take and put into another system (They have at least 31,558 - models). + - have a path to the text file Monolix Library and setup the + `monolix2rx.library` with + `options(monolix2rx.library="~/src/monolix/library/")` - - While this now allows a complete import of the Monolix library, I - believe our `nlmixr2lib` should only be built from imported from a - open-source library or be created on its own (as we are doing in - `nlmixr2lib`). + - have `lixoftConnectors` installed and connected to a newer (and + licensed) version of Monolix that can get the model library + content by `lixoftConnectors::getLibraryModelContent()` - - Please do not request direct translations of models - from Monolix to our library `nlmixr2lib`; these requests will be - rejected. - -If you want the model library as text files, you may be able to reach -out to Lixoft and ask if they will provide them to you (or point to -the last version that used these text files.) - -My biggest concern with this a approach is submitting Monolix models -from the model library to regulatory bodies. For the regulators to be -able to truly see the models they have to have a working copy -Monolix. If they do not, the model is a black box. - -For that reason, I believe best practice when submitting to a -regulatory body is to make the model available by making some change -to the model and saving it to a final location. That way the -regulators can see the model. - -This approach also allows the model to be translated to `rxode2`. + - or without these options, you will need to save the model to a + text file outside of the model library so you can import the model. # Note on testing diff --git a/README.md b/README.md index a41664c..37ddb2c 100644 --- a/README.md +++ b/README.md @@ -39,7 +39,6 @@ theophylline is included in `monolix2rx` and can be imported below: ``` r library(monolix2rx) -#> Loading required namespace: rxode2 # First load in the model; in this case the theo model # This is modified from the Monolix demos by saving the model # file as a text file (hence you can access without model library). @@ -60,14 +59,6 @@ rx <- monolix2rx(mlxtranFile) #> ℹ imported monolix ETAS (_SAEM) imported to rxode2 compatible data ($etaData) #> ℹ imported monolix pred/ipred data to compare ($predIpredData) #> using C compiler: ‘gcc (Ubuntu 11.4.0-1ubuntu1~22.04) 11.4.0’ -#> In file included from /usr/share/R/include/R.h:71, -#> from /home/matt/R/x86_64-pc-linux-gnu-library/4.4/rxode2parse/include/rxode2parse.h:33, -#> from /home/matt/R/x86_64-pc-linux-gnu-library/4.4/rxode2/include/rxode2.h:9, -#> from /home/matt/R/x86_64-pc-linux-gnu-library/4.4/rxode2parse/include/rxode2_model_shared.h:3, -#> from rx_3eaac9dbb7c8e82fd82febcc413da174_.c:117: -#> /usr/share/R/include/R_ext/Complex.h:80:6: warning: ISO C99 doesn’t support unnamed structs/unions [-Wpedantic] -#> 80 | }; -#> | ^ #> ℹ solving ipred problem #> ℹ done #> ℹ solving pred problem @@ -99,6 +90,8 @@ rx #> ── Model (Normalized Syntax): ── #> function() { #> description <- "The administration is extravascular with a first order absorption (rate constant ka).\nThe PK model has one compartment (volume V) and a linear elimination (clearance Cl).\nThis has been modified so that it will run without the model library" +#> dfObs <- 120 +#> dfSub <- 12 #> thetaMat <- lotri({ #> ka_pop + V_pop + Cl_pop ~ c(0.09785, 0.00082606, 0.00041937, #> -4.2833e-05, -6.7957e-06, 1.1318e-05) @@ -271,14 +264,6 @@ to `rxode2`: ``` r monolix2rx("lib:bolus_1cpt_TlagVCl.txt") #> using C compiler: ‘gcc (Ubuntu 11.4.0-1ubuntu1~22.04) 11.4.0’ -#> In file included from /usr/share/R/include/R.h:71, -#> from /home/matt/R/x86_64-pc-linux-gnu-library/4.4/rxode2parse/include/rxode2parse.h:33, -#> from /home/matt/R/x86_64-pc-linux-gnu-library/4.4/rxode2/include/rxode2.h:9, -#> from /home/matt/R/x86_64-pc-linux-gnu-library/4.4/rxode2parse/include/rxode2_model_shared.h:3, -#> from rx_006529352ac819b40b322c71010f90c5_.c:117: -#> /usr/share/R/include/R_ext/Complex.h:80:6: warning: ISO C99 doesn’t support unnamed structs/unions [-Wpedantic] -#> 80 | }; -#> | ^ #> ℹ cannot find individual parameter estimates #> ── rxode2-based free-form 1-cmt ODE model ────────────────────────────────────── #> @@ -313,41 +298,27 @@ try(monolix2rx("lib:notThere.txt")) ``` In newer versions of Monolix, the model library was turned into a binary -database that is accessed by the GUI. To me there are advantages of -this: +database that is accessed by the GUI and `lixoftConnectors`. If you have +`lixoftConnectors` on your system and it can successfully load the model +with `lixoftConnectors::getLibraryModelContent()` then `monolix2rx` will +also load the model correctly (and will use this version over the text +files when both are setup) - - A binary database would be much faster in loading models +This means you will need to import models into `rxode2` you need to: - - With a model library, you don’t have to put common model files all - over the place (saving space on your system) - - - It would make their hard work on the excellent model library harder - to take and put into another system (They have at least 31,558 - models). + - For a model built from the model library you will need: - - While this now allows a complete import of the Monolix library, - I believe our `nlmixr2lib` should only be built from imported - from a open-source library or be created on its own (as we are - doing in `nlmixr2lib`). + - have a path to the text file Monolix Library and setup the + `monolix2rx.library` with + `options(monolix2rx.library="~/src/monolix/library/")` - - Please do not request direct translations of models from Monolix - to our library `nlmixr2lib`; these requests will be rejected. - -If you want the model library as text files, you may be able to reach -out to Lixoft and ask if they will provide them to you (or point to the -last version that used these text files.) - -My biggest concern with this a approach is submitting Monolix models -from the model library to regulatory bodies. For the regulators to be -able to truly see the models they have to have a working copy Monolix. -If they do not, the model is a black box. - -For that reason, I believe best practice when submitting to a regulatory -body is to make the model available by making some change to the model -and saving it to a final location. That way the regulators can see the -model. - -This approach also allows the model to be translated to `rxode2`. + - have `lixoftConnectors` installed and connected to a newer (and + licensed) version of Monolix that can get the model library + content by `lixoftConnectors::getLibraryModelContent()` + + - or without these options, you will need to save the model to a + text file outside of the model library so you can import the + model. # Note on testing