some fixes for coef models

.Rbuildignore

@@ -3,3 +3,4 @@
 ^bad-library.md$
 ^pkgdown$
 ^.github$
+^vignettes/articles$

DESCRIPTION

@@ -47,3 +47,4 @@ Suggests:
     xgxr,
     vdiffr
 Config/testthat/edition: 3
+Config/Needs/website: rmarkdown

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

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

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=" + "))

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

vignettes/.gitignore

@@ -0,0 +1,2 @@
+*.html
+*.R

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()
+```