diff --git a/R/dataCov.R b/R/dataCov.R index 2f6581e..1139dac 100644 --- a/R/dataCov.R +++ b/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") } diff --git a/R/dataImport.R b/R/dataImport.R index c85a2a1..4d84c3b 100644 --- a/R/dataImport.R +++ b/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 { diff --git a/R/def2ini.R b/R/def2ini.R index 7d97eca..462c8dc 100644 --- a/R/def2ini.R +++ b/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 {