From a07b72c1d78398ca14e79dc4ed74e3d19be7877f Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Mon, 27 May 2024 20:33:05 -0500 Subject: [PATCH] some fixes for coef models --- .Rbuildignore | 1 + DESCRIPTION | 1 + R/dataCov.R | 13 ++++++ R/def2ini.R | 27 ++++++++++++ R/indDef.R | 21 ++++++++++ R/monolix2rx.R | 1 + vignettes/.gitignore | 2 + vignettes/articles/convert-nlmixr2.Rmd | 58 ++++++++++++++++++++++++++ 8 files changed, 124 insertions(+) create mode 100644 R/dataCov.R create mode 100644 vignettes/.gitignore create mode 100644 vignettes/articles/convert-nlmixr2.Rmd diff --git a/.Rbuildignore b/.Rbuildignore index aa8a180..3378f28 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -3,3 +3,4 @@ ^bad-library.md$ ^pkgdown$ ^.github$ +^vignettes/articles$ diff --git a/DESCRIPTION b/DESCRIPTION index 1264ec7..dbc7b8b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -47,3 +47,4 @@ Suggests: xgxr, vdiffr Config/testthat/edition: 3 +Config/Needs/website: rmarkdown diff --git a/R/dataCov.R b/R/dataCov.R new file mode 100644 index 0000000..2f6581e --- /dev/null +++ b/R/dataCov.R @@ -0,0 +1,13 @@ +mlxtranGetMutate <- function(mlxtran) { + .cov <- mlxtran$MODEL$COVARIATE$COVARIATE + .mutate <- character(0) + # Convert all covariates to factors + if (!is.null(.cov)) { + .cat <- .cov$cat + .mutate <- paste0("dplyr::mutate(", paste(vapply(names(.cat), function(x) { + paste0(x, "=factor(", x, ", labels=", deparse1(.cat[[x]]$cat), ")") + }, character(1), USE.NAMES=TRUE), collapse=", "), ")") + } + # Add equations + +} diff --git a/R/def2ini.R b/R/def2ini.R index 04b06bc..7d97eca 100644 --- a/R/def2ini.R +++ b/R/def2ini.R @@ -284,10 +284,36 @@ lapply(seq_along(longDef$endpoint), function(i) { .env$err <- c(.env$err, longDef$endpoint[[i]]$err$typical) }) + .env$omega <- list() .env$vl <- character(0) .env$omegaDf <- data.frame(level=character(0), name=character(0), var=character(0)) .env$extraFixed <- character(0) + + .coef <- lapply(.n, function(n) { + .cur <- .var[[n]] + if (!is.null(.cur$coef)) { + .coef <- .cur$coef[[1]] + lapply(.coef, function(var) { + .val <- .parsGetValue(pars, var) + if (.parsGetFixed(pars, var)) { + bquote(.(str2lang(var)) <- fixed(.(.val))) + } else { + bquote(.(str2lang(var)) <- .(.val)) + } + }) + } else { + NULL + } + }) + .coef <- do.call(`c`, .coef) + .in <- which(vapply(seq_along(.coef), + function(i) { + as.character(.coef[[i]][[2]]) %in% .monolix2rx$ignoredCoef + }, logical(1), USE.NAMES = FALSE)) + if (length(.in) > 0L) { + .coef <- .coef[-.in] + } .pop <- c(list(quote(`{`)), lapply(.n, function(n) { .cur <- .var[[n]] @@ -319,6 +345,7 @@ bquote(.(str2lang(.var)) <- .(.val)) } }), + .coef, lapply(.env$err, function(e) { if (.parsGetFixed(pars, e)) { diff --git a/R/indDef.R b/R/indDef.R index 6011a9c..5bf5d8c 100644 --- a/R/indDef.R +++ b/R/indDef.R @@ -160,6 +160,27 @@ .rx <- paste0(.rx, " + ", paste(vapply(seq_along(.ret$coef), function(i) { + .coef <- .ret$coef[[i]] + .cov <- .ret$cov[i] + if (length(.coef) > 1) { + .ref <- vapply(strsplit(.coef, paste0(.cov,"_"), fixed = TRUE), + function(l) { + if (length(l) != 2) return("") + .ret <- l[[2]] + .num <- suppressWarnings(as.numeric(.ret)) + if (!is.na(.num)) return("") + return(.ret) + }, + character(1), USE.NAMES = FALSE) + .w <- which(.ref == "") + if (length(.w) == 1) { + .monolix2rx$ignoredCoef <- c(.monolix2rx$ignoredCoef, + .coef[.w]) + .coef <- .coef[-.w] + .ref <- .ref[-.w] + return(paste(paste0(.coef, " * (", .cov, " == '", .ref, "')"), collapse=" + ")) + } + } paste(paste0(.ret$coef[[i]], "*", .ret$cov[i]), collapse=" + ") }, character(1), USE.NAMES=FALSE), collapse=" + ")) diff --git a/R/monolix2rx.R b/R/monolix2rx.R index 1c7bd5b..eb6f58f 100644 --- a/R/monolix2rx.R +++ b/R/monolix2rx.R @@ -68,6 +68,7 @@ monolix2rx <- function(mlxtran, update=TRUE, thetaMatType=c("sa", "lin"), checkmate::assertNumeric(theta, finite=TRUE, any.missing = FALSE, len=1) checkmate::assertNumeric(ci, lower=0, upper=1, finite=TRUE, any.missing=FALSE, len=1) checkmate::assertIntegerish(sigdig, lower=1, any.missing=FALSE, len=1) + .monolix2rx$ignoredCoef <- character(0) .monolix2rx$iniSd <- sd .monolix2rx$iniCor <- cor .monolix2rx$iniTheta <- theta diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 0000000..097b241 --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1,2 @@ +*.html +*.R diff --git a/vignettes/articles/convert-nlmixr2.Rmd b/vignettes/articles/convert-nlmixr2.Rmd new file mode 100644 index 0000000..4fa1f13 --- /dev/null +++ b/vignettes/articles/convert-nlmixr2.Rmd @@ -0,0 +1,58 @@ +--- +title: "Converting Monolix fit to nlmixr2 fit" +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r setup} +library(monolix2rx) +``` +### Creating a nlmixr2 compatible model + +Unlike `nonmem2rx`, the residuals specification can be converted more +efficiently to the nlmixr2 residual syntax. + +## Example + +```{r asNonmem2Rx} +library(monolix2rx) +library(babelmixr2) + +# You use the path to the monolix mlxtran file + +# In this case we will us the theophylline project included in monolix2rx +pkgTheo <- system.file("theo/theophylline_project.mlxtran", package="monolix2rx") + +# Note you have to setup monolix2rx to use the model library or save the model as a separate file +mod <- monolix2rx(pkgTheo) + +print(mod) +``` + +### Converting the model to a nlmixr2 fit + +Once you have a `rxode2()` model that: + +- Qualifies against the NONMEM model, + +- Has `nlmixr2` compatible residuals + +You can then convert it to a `nlmixr2` fit object with `babelmixr2`: + +```{r convertNlmixr2object} +library(babelmixr2) + +fit <- as.nlmixr2(mod) + +# If you want you can use nlmixr2, to add cwres to this fit: +fit <- addCwres(fit) + +library(ggplot2) +ggplot(fit, aes(PRED, CWRES)) + + geom_point() + rxode2::rxTheme() +```