Merge pull request #12 from nlmixr2/12-transform-and-mu

Replace mu-referenced equations in the `rxode2` ui
nlmixr2 · Sep 5, 2024 · b48b541 · b48b541
2 parents 1ef7021 + c26ef93
commit b48b541
Show file tree

Hide file tree

Showing 21 changed files with 403 additions and 133 deletions.
diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
@@ -1,4 +1,4 @@
-# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+ # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
 # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
 on:
   push:
@@ -53,13 +53,12 @@ jobs:
           pak-version: devel
           extra-packages: |
             any::rcmdcheck
-            nlmixr2/lotri
             nlmixr2/dparser-R
+            nlmixr2/lotri
             nlmixr2/rxode2ll
-            nlmixr2/rxode2parse
-            nlmixr2/rxode2random
-            nlmixr2/rxode2et
             nlmixr2/rxode2
+            nlmixr2/PreciseSums
+            lixoftConnectors=?ignore
           needs: check
       - uses: r-lib/actions/check-r-package@v2
         with:

diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml
@@ -32,23 +32,22 @@ jobs:
         with:
           extra-packages: |
             any::pkgdown
-            nlmixr2/lotri
+            nlmixr2/n1qn1c
+            nlmixr2/lbfgsb3c
+            nlmixr2/PreciseSums
+            nlmixr2/babelmixr2
             nlmixr2/dparser-R
-            nlmixr2/rxode2ll
-            nlmixr2/rxode2parse
-            nlmixr2/rxode2random
-            nlmixr2/rxode2et
-            nlmixr2/rxode2
+            nlmixr2/lotri
+            nlmixr2/nlmixr2
             nlmixr2/nlmixr2est
             nlmixr2/nlmixr2extra
             nlmixr2/nlmixr2plot
-            nlmixr2/nlmixr2
-            nlmixr2/babelmixr2
             nlmixr2/nlmixr2rpt
+            nlmixr2/rxode2
+            nlmixr2/rxode2ll
             lixoftConnectors=?ignore
             local::.
           needs: website
-
       - name: Build site
         run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE)
         shell: Rscript {0}

diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml
@@ -29,10 +29,9 @@ jobs:
             nlmixr2/lotri
             nlmixr2/dparser-R
             nlmixr2/rxode2ll
-            nlmixr2/rxode2parse
-            nlmixr2/rxode2random
-            nlmixr2/rxode2et
             nlmixr2/rxode2
+            nlmixr2/PreciseSums
+            lixoftConnectors=?ignore
           needs: coverage
 
       - name: Test coverage

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -23,7 +23,7 @@ Description: 'Monolix' is a tool for running mixed effects model using
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 LinkingTo:
     dparser,
     rxode2parse,
@@ -45,6 +45,7 @@ Suggests:
     devtools,
     testthat (>= 3.0.0),
     xgxr,
-    vdiffr
+    vdiffr,
+    lixoftConnectors
 Config/testthat/edition: 3
 Config/Needs/website: rmarkdown
diff --git a/NAMESPACE b/NAMESPACE
@@ -69,6 +69,7 @@ export(logit)
 export(lotri)
 export(mlxTxt)
 export(mlxtran)
+export(mlxtranGetMutate)
 export(model)
 export(monolix2rx)
 export(monolixDataImport)

diff --git a/R/dataCov.R b/R/dataCov.R
@@ -20,32 +20,6 @@ mlxtranGetMutate <- function(mlxtran) {
       paste0(x, "=factor(as.character(", x, "), labels=", deparse1(.cat[[x]]$cat), ")")
     }, character(1), USE.NAMES=TRUE), collapse=", "), ")")
   }
-  .cov <- mlxtran$MODEL$COVARIATE$DEFINITION
-  if (!is.null(.cov)) {
-    .transform <- .cov$transform
-    .mutate <- c(.mutate,
-                 vapply(names(.transform),
-                        function(n) {
-                          .t <- .transform[[n]]
-                          .v <- .t$transform
-                          .cw <- vapply(seq_along(.t$catLabel),
-                                        function(i) {
-                                          paste0(.v, " %in% c(",
-                                                 paste(paste0("'", .t$catValue[[i]], "'"),
-                                                       collapse=", "),
-                                                 ") ~ '", .t$catLabel[i], "'")
-                                        }, character(1), USE.NAMES = TRUE)
-                          if (checkmate::testCharacter(.t$reference, min.chars = 1)) {
-                            .cw <- c(.cw, paste0("TRUE ~ '", .t$reference, "'"))
-                          } else {
-                            .cw <- c(.cw, paste0("TRUE ~ NA_character_"))
-                          }
-                          paste0("dplyr::mutate(", n, "= dplyr::case_when(",
-                                paste(.cw, collapse=",\n\t\t"),
-                                 "))")
-                        }, character(1),
-                        USE.NAMES=FALSE))
-  }
   .cov <- mlxtran$MODEL$COVARIATE$EQUATION
   if (!is.null(.cov)) {
     .mutate <- c(.mutate,

diff --git a/R/dataImport.R b/R/dataImport.R
@@ -22,13 +22,6 @@
       }
     }
   }
-  .mutate <- mlxtranGetMutate(mlxtran)
-  if (!is.null(.mutate)) {
-    .minfo("modifying input data to match monolix transformations")
-    message("\tdata |> ")
-    message(.mutate)
-    .dat <- eval(str2lang(paste0(".dat |> ", .mutate)))
-  }
   .dat
 }
 
@@ -135,13 +128,6 @@
                           }
                           n
                         }, character(1), USE.NAMES = FALSE)
-  # Make sure factors match what monolix defined
-  for (.i in seq_along(.content$cat)) {
-    .n <- names(.content$cat)[.i]
-    if (!is.na(.n) && any(names(data) == .n)) {
-      data[[.n]] <- factor(paste(data[[.n]]), levels=.content$cat[[.i]]$cat)
-    }
-  }
   # Make sure continuous are double
   for (.i in seq_along(.content$cont)) {
     .n <- names(.content$cat)[.i]

diff --git a/R/def2ini.R b/R/def2ini.R
@@ -293,22 +293,26 @@
   .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)
-                ## .val <- .parsTransformValue(.val, .cur$distribution,
-                ##                             min=.cur$min, max=.cur$max)
-                ## if (is.na(.val) && .inNaVal) {
-                ##   stop("transformed value of initial estimate for ", .var,
-                ##        " is not in correct range",
-                ##        call.=FALSE)
-                ## }
-                if (.parsGetFixed(pars, var)) {
-                  bquote(.(str2lang(var)) <- fixed(.(.val)))
-                } else {
-                  bquote(.(str2lang(var)) <- .(.val))
-                }
-              })
+      .v <- lapply(seq_along(.cur$coef), function(i) {
+        .coef <- .cur$coef[[i]]
+        lapply(.coef, function(var) {
+          .val <- .parsGetValue(pars, var)
+          ## .val <- .parsTransformValue(.val, .cur$distribution,
+          ##                             min=.cur$min, max=.cur$max)
+          ## if (is.na(.val) && .inNaVal) {
+          ##   stop("transformed value of initial estimate for ", .var,
+          ##        " is not in correct range",
+          ##        call.=FALSE)
+          ## }
+          if (.parsGetFixed(pars, var)) {
+            bquote(.(str2lang(var)) <- fixed(.(.val)))
+          } else {
+            bquote(.(str2lang(var)) <- .(.val))
+          }
+        })
+      })
+      .v <- do.call(`c`, .v)
+      .v
     } else {
       NULL
     }

diff --git a/R/equation.R b/R/equation.R
@@ -14,8 +14,15 @@
   .monolix2rx$equationLhs <- character(0)
   .monolix2rx$equationRhs <- character(0)
   .monolix2rx$odeType <- "nonStiff"
+  .start <- .end <- character(0)
   if (is.null(pk)) pk <- .pk("")
   if (is.character(pk)) pk <- .pk(pk)
+  if (length(pk$preEq) > 0) {
+    .start <- pk$preEq
+  }
+  if (length(pk$postEq) > 0) {
+    .end <- pk$postEq
+  }
   # Apparently pk macros can also be in the EQUATION: block
   .pkIni(TRUE)
   if (text!="") {
@@ -86,6 +93,7 @@
                                       " <- ",
                                       .monolix2rx$endpointPred[.w]))
   }
+  .monolix2rx$equationLine <- c(.start, .monolix2rx$equationLine, .end)
   .monolix2rx$equationLine <- .updateDdtEq(.monolix2rx$state, .monolix2rx$equationLine, .monolix2rx$pk)
   .monolix2rx$equationLine <- .updateDdtEq(.monolix2rx$state, .monolix2rx$equationLine, .pk3)
   .w <- which(grepl("^ *[<][-] *$", .monolix2rx$equationLine))

diff --git a/R/longDef.R b/R/longDef.R
@@ -154,18 +154,7 @@
     .reset <- TRUE
   }
   if (length(.monolix2rx$transformTo) == 1L && length(.monolix2rx$transformFrom) == 1L) {
-    .val <- list(transform = .monolix2rx$transformFrom,
-                 transformQ=.monolix2rx$transformQ,
-                 catLabel=.monolix2rx$transformCatLabel,
-                 catLabelQ=.monolix2rx$transformCatLabelQ,
-                 catValue=.monolix2rx$transformCatValue,
-                 catValueQ=.monolix2rx$transformCatValueQ,
-                 catB=.monolix2rx$transformCatB,
-                 reference = .monolix2rx$transformReference,
-                 referenceQ = .monolix2rx$transformReferenceQ)
-    .val <- list(.val)
-    names(.val) <- .monolix2rx$transformTo
-    .monolix2rx$longDefTransform <- c(.monolix2rx$longDefTransform, .val)
+    .pushTransform()
     .reset <- TRUE
   }
   if (.reset) .longDefIni(FALSE)
@@ -306,7 +295,40 @@
 .longDefSetMax <- function(var) {
   .monolix2rx$max <- as.numeric(var)
 }
+#' Push transform on the transformation list
+#'
+#' @return  nothing, called for side effects
+#' @noRd
+#' @author Matthew L. Fidler
+.pushTransform <- function() {
+  .val <- list(transform = .monolix2rx$transformFrom,
+               transformQ=.monolix2rx$transformQ,
+               catLabel=.monolix2rx$transformCatLabel,
+               catLabelQ=.monolix2rx$transformCatLabelQ,
+               catValue=.monolix2rx$transformCatValue,
+               catValueQ=.monolix2rx$transformCatValueQ,
+               catB=.monolix2rx$transformCatB,
+               reference = .monolix2rx$transformReference,
+               referenceQ = .monolix2rx$transformReferenceQ)
+  .val <- list(.val)
+  names(.val) <- .monolix2rx$transformTo
+  .monolix2rx$longDefTransform <- c(.monolix2rx$longDefTransform, .val)
+  .monolix2rx$transformTo <- character(0)
+  .monolix2rx$transformFrom <- character(0)
+  .monolix2rx$transformQ <- character(0)
+  .monolix2rx$transformCatB <- logical(0)
+  .monolix2rx$transformCatLabel <- character(0)
+  .monolix2rx$transformCatLabelQ <- logical(0)
+  .monolix2rx$transformCatValue <- NULL
+  .monolix2rx$transformCatValueQ <- NULL
+  .monolix2rx$transformReference <- character(0)
+  .monolix2rx$transformReferenceQ <- logical(0)
+}
+
 .longDefSetTransformTo <- function(var) {
+  if (length(.monolix2rx$transformTo) == 1L) {
+    .pushTransform()
+  }
   .monolix2rx$transformTo <- var
 }
 .longDefSetTransformFrom <- function(var, q) {

diff --git a/R/mlxtran.R b/R/mlxtran.R
@@ -116,7 +116,7 @@
         .monolix2rx$endpointPred <- character(0)
       }
       if (!is.null(.ret$MODEL$LONGITUDINAL$PK)) {
-        .ret$MODEL$LONGITUDINAL$PK <- .pk(.ret$MODEL$LONGITUDINAL$PK)
+        .ret$MODEL$LONGITUDINAL$PK <- .pk(.ret$MODEL$LONGITUDINAL$PK, TRUE)
       }
       if (!is.null(.ret$MODEL$LONGITUDINAL$OUTPUT)) {
         .ret$MODEL$LONGITUDINAL$OUTPUT <- .longOut(.ret$MODEL$LONGITUDINAL$OUTPUT)