Add more data conversion and integrate into covariate transform

R/dataCov.R

@@ -1,13 +1,52 @@
+#' Get the string of the mutate statement for input dataset based on
+#' mlxtran
+#'
+#' @param mlxtran input mlxtran file
+#' @return mlxtran string that can be applied to a model (by evaluating it)
+#' @export
+#' @author Matthew L. Fidler
+#' @examples
+#'
+#' covD <- system.file("cov", package="monolix2rx")
+#' m <- mlxtran(file.path(covD, "phenobarbital_project.mlxtran"))
+#' message(mlxtranGetMutate(m))
 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), ")")
+    .mutate <- paste0("\tdplyr::mutate(", paste(vapply(names(.cat), function(x) {
+      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))
+  }
+  if (length(.mutate) == 0) return(NULL)
   # Add equations
-
+  paste(.mutate, collapse=" |> \n\t")
 }

R/dataImport.R

@@ -2,10 +2,11 @@
 #'
 #' @param data input data
 #' @param na.strings na strings
-#' @return converted dataset with na
+#' @param mlxtran mlxtran information
+#' @return converted dataset with na AND mutated values
 #' @noRd
 #' @author Matthew L. Fidler
-.monolixNaApply <- function(data, na.strings) {
+.monolixNaApply <- function(data, na.strings, mlxtran) {
   .dat <- data
   for (v in names(.dat)) {
     if (tolower(v) %in% c("amt", "time", "dv") &&
@@ -21,6 +22,14 @@
       }
     }
   }
+  browser()
+  .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
 }
 
@@ -50,7 +59,7 @@
         # has header (and it matches)
         .data <- utils::read.table(.file, header = TRUE, sep=.sep, row.names=NULL,
                             na.strings=na.strings)
-        return(.monolixNaApply(.data, na.strings))
+        return(.monolixNaApply(.data, na.strings, mlxtran))
       } else {
         .num <- vapply(.head,
                        function(v) {
@@ -68,7 +77,7 @@
                  call.=FALSE)
           }
           names(.data) <- mlxtran$DATAFILE$FILEINFO$FILEINFO$header
-          return(.monolixNaApply(.data, na.strings))
+          return(.monolixNaApply(.data, na.strings, mlxtran))
         } else {
           # missing header
           .data <- utils::read.table(.file, header = FALSE, sep=.sep, row.names=NULL,
@@ -78,7 +87,7 @@
                  call.=FALSE)
           }
           names(.data) <- mlxtran$DATAFILE$FILEINFO$FILEINFO$header
-          return(.monolixNaApply(.data, na.strings))
+          return(.monolixNaApply(.data, na.strings, mlxtran))
         }
       }
     } else {

R/def2ini.R

@@ -296,6 +296,13 @@
       .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 {