diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 19a0619..b8be0ae 100644 --- 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 index 16e7759..f6ba244 100644 --- 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 index 1acd02c..a2393fd 100644 --- 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 index dbc7b8b..2e878e1 100644 --- 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 index 72b0a87..99c7cff 100644 --- 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 index ab3a05d..cc87b37 100644 --- 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 index 74ea2d7..558e051 100644 --- 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 index 462c8dc..b212b29 100644 --- 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 index 56afe7b..534ff0a 100644 --- 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 index a0602b4..327cbdb 100644 --- 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 index c502a86..ef4e7c1 100644 --- 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) diff --git a/R/mlxtranChangeEquation.R b/R/mlxtranChangeEquation.R new file mode 100644 index 0000000..5587393 --- /dev/null +++ b/R/mlxtranChangeEquation.R @@ -0,0 +1,116 @@ +#' Change Equation Info to Parsed List +#' +#' This function takes a `mlxtran` object and converts the covariate equation information +#' into a parsed list. +#' +#' @param mlxtran A list containing the `MODEL` and `COVARIATE` +#' information from `mlxtran()` +#' @return A named list of parsed covariate equations or `NULL` if the +#' covariate information is not present. +#' @noRd +#' @author Matthew L. Fidler +#' @examples +#' +#' m <- mlxtran(file.path(system.file("cov", package="monolix2rx"), "warfarin_covariate3_project.mlxtran")) +#' .mlxtranChangeEquationInfoToParsedList(m) +#' +.mlxtranChangeEquationInfoToParsedList <- function(mlxtran) { + .cov <- mlxtran$MODEL$COVARIATE$EQUATION + if (is.null(.cov)) { + return(NULL) + } + if (is.null(.cov$dplyr)) { + return(NULL) + } + .e <- str2lang(paste0("{", paste(.cov$dplyr, collapse="\n"), "}")) + .ret <- lapply(seq_along(.e)[-1], + function(i) { + .e[[i]][[3]] + }) + names(.ret) <- vapply(seq_along(.e)[-1], + function(i) { + deparse1(.e[[i]][[2]]) + },character(1), USE.NAMES=TRUE) + .ret +} + +#' Modify elements of an expression based on a lookup list +#' +#' This function recursively traverses an expression and replaces elements +#' based on a provided lookup list. If an element is a name and it exists in +#' the lookup list, it is replaced by the corresponding value from the list. +#' If the element is a call, the function is applied recursively to its arguments. +#' +#' @param x An expression to be modified. It can be a name, a call, or other types. +#' +#' @param lst A named list used for lookup. If a name in the expression matches +#' a name in this list, it will be replaced by the corresponding value. +#' +#' @return The modified expression with names replaced according to the lookup list. +#' +#' @noRd +#' +#' @keywords internal +#' +#' @author Matthew L. Fidler +#' +.mlxtranChangeF <- function(x, lst) { + if (is.name(x)) { + x0 <- deparse1(x) + if (x0 %in% names(lst)) { + lst[[x0]] + } else { + x + } + } else if (is.call(x)) { + as.call(c(x[[1]], lapply(x[-1], .mlxtranChangeF, lst=lst))) + } else { + x + } +} + +#' Replace values in a model with mlxtran transformation equations +#' +#' @param model an unevaluated R lang object to replace the values +#' from the mlxtran modification object +#' +#' @param mlxtran a mlxtran trans object +#' +#' @return an expression where the transformations are changed. For +#' example if the continuous transformation equations are defined by +#' mlxtran to be `lw70 = log(weight/70)` then the final expression +#' would replace all `lw70` values with `log(weight/70)` +#' +#' @noRd +#' @author Matthew L. Fidler +#' @examples +#' +#' mod <- quote(model({ +#' cmt(depot) +#' cmt(central) +#' if (sex == 0) { +#' tSex <- "F" +#' } else if (sex == 1) { +#' tSex <- "M" +#' } else { +#' tSex <- "M" +#' } +#' Tlag <- exp(Tlag_pop + omega_Tlag) +#' ka <- exp(ka_pop + omega_ka) +#' V <- exp(V_pop + beta_V_tSex_F * (tSex == "F") + beta_V_lw70 * lw70 + omega_V) +#' Cl <- exp(Cl_pop + beta_Cl_tSex_F * (tSex == "F") + beta_Cl_lw70 * lw70 + omega_Cl) +#' d/dt(depot) <- -ka * depot +#' alag(depot) <- Tlag +#' d/dt(central) <- +ka * depot - Cl/V * central +#' Cc <- central/V +#' concentration <- Cc +#' concentration ~ add(a) + prop(b) + combined1() +#' })) +#' +#' m <- mlxtran(file.path(system.file("cov", package="monolix2rx"), "warfarin_covariate3_project.mlxtran")) +#' +#' .mlxtranChangeVal(mod, mlxtran) +.mlxtranChangeVal <- function(model, mlxtran) { + .lst <- .mlxtranChangeEquationInfoToParsedList(mlxtran) + .mlxtranChangeF(model, lst=.lst) +} diff --git a/R/mlxtranTransformGetRxCode.R b/R/mlxtranTransformGetRxCode.R new file mode 100644 index 0000000..e9d7804 --- /dev/null +++ b/R/mlxtranTransformGetRxCode.R @@ -0,0 +1,60 @@ +#' Transform Mlxtran Covariate Definitions to `rxode2` Code +#' +#' This function takes an mlxtran object and extracts the covariate +#' transformation definitions, converting them into `rxode2`-compatible +#' code. +#' +#' @param mlxtran A list representing the `mlxtran` object, which +#' contains model definitions including covariates and their +#' transformations. This comes from the `mlxtran()` function +#' +#' @return A character vector of `rxode2`-compatible code for the +#' covariate transformations, or `NULL` if no covariate +#' transformations are defined. +#' +#' @noRd +#' +#' @author Matthew L. Fidler +#' +#' @examples +#' +#' m <- mlxtran(file.path(system.file("cov", package="monolix2rx"), "warfarin_covariate3_project.mlxtran")) +#' mlxtranTransformGetRxCode(m) +#' +mlxtranTransformGetRxCode <- function(mlxtran) { + .cov <- mlxtran$MODEL$COVARIATE$COVARIATE + if (is.null(.cov)) return(NULL) + .cov <- mlxtran$MODEL$COVARIATE$DEFINITION + if (is.null(.cov)) return(NULL) + .transform <- .cov$transform + if (length(.transform) == 0) return(NULL) + paste( + vapply(names(.transform), + function(n) { + .t <- .transform[[n]] + .v <- .t$transform + .cw <- vapply(seq_along(.t$catLabel), + function(i) { + .tmp <- suppressWarnings(as.numeric(.t$catValue[[i]])) + .q <- "" + if (any(is.na(.tmp))) { + .q <- "'" + } + .or <- paste(paste0(.v, " == ", .q, .t$catValue[[i]], .q), + collapse=" || ") + .or <- paste0("if (", .or, ") {\n") + .or <- paste0(.or, " ", n, " <- '", .t$catLabel[i], "'\n") + .or <- paste0(.or, "}") + .or + }, character(1), USE.NAMES = TRUE) + .cw <- paste(.cw, collapse=" else ") + if (checkmate::testCharacter(.t$reference, min.chars = 1)) { + .cw <- paste0(.cw," else {\n ", n, "<- '", .t$reference, "'\n}") + } else { + .cw <- c(.cw, paste0("else {\n ", n, "<- 1\n}")) + } + .cw + }, character(1), + USE.NAMES=FALSE), + collapse="\n") +} diff --git a/R/monolix2rx.R b/R/monolix2rx.R index a98a57f..1f62def 100644 --- a/R/monolix2rx.R +++ b/R/monolix2rx.R @@ -52,6 +52,10 @@ #' #' rx <- monolix2rx(file.path(pkgTheo, "theophylline_project.mlxtran")) #' +#' pkgCov <- system.file("cov", package="monolix2rx") +#' +#' rx <- monolix2rx(file.path(pkgCov, "warfarin_covariate3_project.mlxtran")) +#' #' rx monolix2rx <- function(mlxtran, update=TRUE, thetaMatType=c("sa", "lin"), sd=1.0, cor=1e-5, theta=0.5, ci=0.95, sigdig=3, @@ -100,6 +104,7 @@ monolix2rx <- function(mlxtran, update=TRUE, thetaMatType=c("sa", "lin"), if (length(.cmt) == 1L && .cmt == "cmt()") .cmt <- NULL .model <- c("model({", .cmt, + mlxtranTransformGetRxCode(.mlxtran), .mlxtran$MODEL$INDIVIDUAL$DEFINITION$rx, .equation, vapply(seq_along(.mlxtran$MODEL$LONGITUDINAL$DEFINITION$endpoint), @@ -117,7 +122,7 @@ monolix2rx <- function(mlxtran, update=TRUE, thetaMatType=c("sa", "lin"), message(paste(.model, collapse="\n")) stop("model translation did not parse into a rxode2/nlmixr2 model", call.=FALSE) } - .model <- .model0 + .model <- .mlxtranChangeVal(.model0, .mlxtran) .ini <- .def2ini(.mlxtran$MODEL$INDIVIDUAL$DEFINITION, .mlxtran$PARAMETER$PARAMETER, .mlxtran$MODEL$LONGITUDINAL$DEFINITION) @@ -186,7 +191,6 @@ monolix2rx <- function(mlxtran, update=TRUE, thetaMatType=c("sa", "lin"), crayon::bold$blue("$monolixData"), ")")) .ui$monolixData <- .monolixData .ui$sticky <- "monolixData" - } .etaData <- try(monolixEtaImport(.ui)) if (inherits(.etaData, "try-error")) .etaData <- NULL @@ -213,7 +217,7 @@ monolix2rx <- function(mlxtran, update=TRUE, thetaMatType=c("sa", "lin"), assign("dfSub", as.double(.lst$nid), envir=.ui$meta) } } - .validateModel(.ui, ci=ci, sigdig=sigdig) + try(.validateModel(.ui, ci=ci, sigdig=sigdig)) .ui <- rxode2::rxUiCompress(.ui) class(.ui) <- c("monolix2rx", class(.ui)) .ui diff --git a/R/pk.R b/R/pk.R index 9148afd..9b1da39 100644 --- a/R/pk.R +++ b/R/pk.R @@ -6,6 +6,7 @@ #' @author Matthew L. Fidler .pkIni <- function(full=TRUE) { if (full) { + .monolix2rx$preEq <- character(0) .monolix2rx$pkCc <- NA_character_ .monolix2rx$pkCe <- NA_character_ .monolix2rx$pkPars <- c(V=NA_character_, @@ -218,6 +219,12 @@ df } +.pkPushPre <- function() { + if(.monolix2rx$pkLong && length(.monolix2rx$equationLine) > 0) { + .monolix2rx$preEq <- .monolix2rx$equationLine + .monolix2rx$equationLine <- character(0) + } +} #' Pushes the Pk information based on current statement #' #' @return nothing, called for side effect @@ -339,7 +346,12 @@ #' @return nothing, called for side effects #' @noRd #' @author Matthew L. Fidler -.pk <- function(text) { +.pk <- function(text, long=FALSE) { + .monolix2rx$pkLong <- long + if (.monolix2rx$pkLong) { + .monolix2rx$saveEq <- .monolix2rx$equationLine + .monolix2rx$equationLine <- character(0) + } .pkIni(TRUE) if (text != "") .Call(`_monolix2rx_trans_equation`, text, "[LONGITUDINAL] EQUATION:") .pkPushStatement() @@ -358,6 +370,12 @@ reset=.monolix2rx$pkReset, elimination=.monolix2rx$pkElimination, admd=.monolix2rx$admd) + if (.monolix2rx$pkLong) { + .ret <- c(.ret, + list(preEq=.monolix2rx$preEq, + postEq=.monolix2rx$equationLine)) + .monolix2rx$equationLine <- .monolix2rx$saveEq + } class(.ret) <- "monolix2rxPk" .ret } @@ -397,6 +415,7 @@ #' @noRd #' @author Matthew L. Fidler .pkSetCc <- function(cc) { + .pkPushPre() .pkPushStatement() .monolix2rx$pkCc <- cc .monolix2rx$pkStatement <- "pkmodel" @@ -408,6 +427,7 @@ #' @noRd #' @author Matthew L. Fidler .pkSetCe <- function(ce) { + .pkPushPre() .pkPushStatement() .monolix2rx$pkCe <- ce .monolix2rx$pkStatement <- "pkmodel" @@ -546,6 +566,7 @@ #' @noRd #' @author Matthew L. Fidler .pkSetStatement <- function(type) { + .pkPushPre() .pkPushStatement() if (type == "absorption") type <- "oral" .monolix2rx$pkStatement <- type @@ -712,7 +733,7 @@ as.character.monolix2rxPk <- function(x, ...) { } .prnAdm <- TRUE } - .retf + c(x$preEq, .retf, x$postEq) } #' @export print.monolix2rxPk <- function(x, ...) { diff --git a/R/rxSolve.R b/R/rxSolve.R index 708d610..5d6eb09 100644 --- a/R/rxSolve.R +++ b/R/rxSolve.R @@ -5,33 +5,36 @@ rxSolve.monolix2rx <- function(object, params = NULL, events = NULL, "dop853", "indLin"), sigdig = NULL, atol = 1e-08, rtol = 1e-06, maxsteps = 70000L, hmin = 0, hmax = NA_real_, hmaxSd = 0, hini = 0, maxordn = 12L, maxords = 5L, ..., cores, covsInterpolation = c("locf", - "linear", "nocb", "midpoint"), addCov = TRUE, sigma = NULL, - sigmaDf = NULL, sigmaLower = -Inf, sigmaUpper = Inf, nCoresRV = 1L, - sigmaIsChol = FALSE, sigmaSeparation = c("auto", "lkj", "separation"), - sigmaXform = c("identity", "variance", "log", "nlmixrSqrt", - "nlmixrLog", "nlmixrIdentity"), nDisplayProgress = 10000L, - amountUnits = NA_character_, timeUnits = "hours", theta = NULL, - thetaLower = -Inf, thetaUpper = Inf, eta = NULL, addDosing = FALSE, - stateTrim = Inf, updateObject = FALSE, omega = NULL, omegaDf = NULL, - omegaIsChol = FALSE, omegaSeparation = c("auto", "lkj", "separation"), - omegaXform = c("variance", "identity", "log", "nlmixrSqrt", - "nlmixrLog", "nlmixrIdentity"), omegaLower = -Inf, omegaUpper = Inf, - nSub = 1L, thetaMat = NULL, thetaDf = NULL, thetaIsChol = FALSE, - nStud = 1L, dfSub = 0, dfObs = 0, returnType = c("rxSolve", - "matrix", "data.frame", "data.frame.TBS", "data.table", - "tbl", "tibble"), seed = NULL, nsim = NULL, minSS = 10L, - maxSS = 1000L, infSSstep = 12, strictSS = TRUE, istateReset = TRUE, - subsetNonmem = TRUE, maxAtolRtolFactor = 0.1, from = NULL, - to = NULL, by = NULL, length.out = NULL, iCov = NULL, keep = NULL, - indLinPhiTol = 1e-07, indLinPhiM = 0L, indLinMatExpType = c("expokit", - "Al-Mohy", "arma"), indLinMatExpOrder = 6L, drop = NULL, - idFactor = TRUE, mxhnil = 0, hmxi = 0, warnIdSort = TRUE, - warnDrop = TRUE, ssAtol = 1e-08, ssRtol = 1e-06, safeZero = TRUE, - sumType = c("pairwise", "fsum", "kahan", "neumaier", "c"), - prodType = c("long double", "double", "logify"), sensType = c("advan", - "autodiff", "forward", "central"), linDiff = c(tlag = 1.5e-05, - f = 1.5e-05, rate = 1.5e-05, dur = 1.5e-05, tlag2 = 1.5e-05, - f2 = 1.5e-05, rate2 = 1.5e-05, dur2 = 1.5e-05), linDiffCentral = c(tlag = TRUE, + "linear", "nocb", "midpoint"), naInterpolation = c("locf", + "nocb"), keepInterpolation = c("locf", "nocb", "na"), + addCov = TRUE, sigma = NULL, sigmaDf = NULL, sigmaLower = -Inf, + sigmaUpper = Inf, nCoresRV = 1L, sigmaIsChol = FALSE, sigmaSeparation = c("auto", + "lkj", "separation"), sigmaXform = c("identity", "variance", + "log", "nlmixrSqrt", "nlmixrLog", "nlmixrIdentity"), + nDisplayProgress = 10000L, amountUnits = NA_character_, timeUnits = "hours", + theta = NULL, thetaLower = -Inf, thetaUpper = Inf, eta = NULL, + addDosing = FALSE, stateTrim = Inf, updateObject = FALSE, + omega = NULL, omegaDf = NULL, omegaIsChol = FALSE, omegaSeparation = c("auto", + "lkj", "separation"), omegaXform = c("variance", "identity", + "log", "nlmixrSqrt", "nlmixrLog", "nlmixrIdentity"), + omegaLower = -Inf, omegaUpper = Inf, nSub = 1L, thetaMat = NULL, + thetaDf = NULL, thetaIsChol = FALSE, nStud = 1L, dfSub = 0, + dfObs = 0, returnType = c("rxSolve", "matrix", "data.frame", + "data.frame.TBS", "data.table", "tbl", "tibble"), seed = NULL, + nsim = NULL, minSS = 10L, maxSS = 1000L, infSSstep = 12, + strictSS = TRUE, istateReset = TRUE, subsetNonmem = TRUE, + maxAtolRtolFactor = 0.1, from = NULL, to = NULL, by = NULL, + length.out = NULL, iCov = NULL, keep = NULL, indLinPhiTol = 1e-07, + indLinPhiM = 0L, indLinMatExpType = c("expokit", "Al-Mohy", + "arma"), indLinMatExpOrder = 6L, drop = NULL, idFactor = TRUE, + mxhnil = 0, hmxi = 0, warnIdSort = TRUE, warnDrop = TRUE, + ssAtol = 1e-08, ssRtol = 1e-06, safeZero = TRUE, safeLog = TRUE, + safePow = TRUE, sumType = c("pairwise", "fsum", "kahan", + "neumaier", "c"), prodType = c("long double", "double", + "logify"), sensType = c("advan", "autodiff", "forward", + "central"), linDiff = c(tlag = 1.5e-05, f = 1.5e-05, + rate = 1.5e-05, dur = 1.5e-05, tlag2 = 1.5e-05, f2 = 1.5e-05, + rate2 = 1.5e-05, dur2 = 1.5e-05), linDiffCentral = c(tlag = TRUE, f = TRUE, rate = TRUE, dur = TRUE, tlag2 = TRUE, f2 = TRUE, rate2 = TRUE, dur2 = TRUE), resample = NULL, resampleID = TRUE, maxwhile = 1e+05, atolSens = 1e-08, rtolSens = 1e-06, ssAtolSens = 1e-08, @@ -118,6 +121,7 @@ rxSolve.monolix2rx <- function(object, params = NULL, events = NULL, atol = atol, rtol = rtol, maxsteps = maxsteps, hmin = hmin, hmax = hmax, hmaxSd = hmaxSd, hini = hini, maxordn = maxordn, maxords = maxords, ..., cores = cores, covsInterpolation = covsInterpolation, + naInterpolation = naInterpolation, keepInterpolation = keepInterpolation, addCov = addCov, sigma = sigma, sigmaDf = sigmaDf, sigmaLower = sigmaLower, sigmaUpper = sigmaUpper, nCoresRV = nCoresRV, sigmaIsChol = sigmaIsChol, sigmaSeparation = sigmaSeparation, sigmaXform = sigmaXform, @@ -138,13 +142,14 @@ rxSolve.monolix2rx <- function(object, params = NULL, events = NULL, indLinMatExpType = indLinMatExpType, indLinMatExpOrder = indLinMatExpOrder, drop = drop, idFactor = idFactor, mxhnil = mxhnil, hmxi = hmxi, warnIdSort = warnIdSort, warnDrop = warnDrop, ssAtol = ssAtol, - ssRtol = ssRtol, safeZero = safeZero, sumType = sumType, - prodType = prodType, sensType = sensType, linDiff = linDiff, - linDiffCentral = linDiffCentral, resample = resample, - resampleID = resampleID, maxwhile = maxwhile, atolSens = atolSens, - rtolSens = rtolSens, ssAtolSens = ssAtolSens, ssRtolSens = ssRtolSens, - simVariability = simVariability, nLlikAlloc = nLlikAlloc, - useStdPow = useStdPow, naTimeHandle = naTimeHandle, addlKeepsCov = addlKeepsCov, - addlDropSs = addlDropSs, ssAtDoseTime = ssAtDoseTime, - ss2cancelAllPending = ss2cancelAllPending, envir = envir) + ssRtol = ssRtol, safeZero = safeZero, safeLog = safeLog, + safePow = safePow, sumType = sumType, prodType = prodType, + sensType = sensType, linDiff = linDiff, linDiffCentral = linDiffCentral, + resample = resample, resampleID = resampleID, maxwhile = maxwhile, + atolSens = atolSens, rtolSens = rtolSens, ssAtolSens = ssAtolSens, + ssRtolSens = ssRtolSens, simVariability = simVariability, + nLlikAlloc = nLlikAlloc, useStdPow = useStdPow, naTimeHandle = naTimeHandle, + addlKeepsCov = addlKeepsCov, addlDropSs = addlDropSs, + ssAtDoseTime = ssAtDoseTime, ss2cancelAllPending = ss2cancelAllPending, + envir = envir) } diff --git a/R/validate.R b/R/validate.R index 038833a..b9e3e03 100644 --- a/R/validate.R +++ b/R/validate.R @@ -161,11 +161,17 @@ n }, character(1), USE.NAMES = FALSE) .nMonolix <- length(.monolix[, 1]) - if (.nMonolix != .nBoth) { - .minfo("monolix and rxode2 solves have different number of rows") - return(invisible()) - } + + .monolix$rxMonolixRowN <- seq_along(.monolix[,1]) .both <- merge(.monolix, .both) + .monolixNot <- .monolix[!(.monolix$rxMonolixRowN %in% .both$rxMonolixRowN), ,drop=FALSE] + if (length(.monolixNot$rxMonolixRowN) != 0L) { + .minfo(paste0("monolix and rxode2 solves have different number of rows (", + crayon::blue$bold("$monolixNotMatched"),")")) + .monolixNot <- .monolixNot[,names(.monolixNot) != "rxMonolixRowN"] + assign("monolixNotMatched", .monolixNot, .ui) + } + .both <- .both[, names(.both) != "rxMonolixRowN"] .ci0 <- .ci <- ci .sigdig <- sigdig .ci <- (1 - .ci) / 2 diff --git a/man/mlxtranGetMutate.Rd b/man/mlxtranGetMutate.Rd new file mode 100644 index 0000000..feaf1c3 --- /dev/null +++ b/man/mlxtranGetMutate.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dataCov.R +\name{mlxtranGetMutate} +\alias{mlxtranGetMutate} +\title{Get the string of the mutate statement for input dataset based on +mlxtran} +\usage{ +mlxtranGetMutate(mlxtran) +} +\arguments{ +\item{mlxtran}{input mlxtran file} +} +\value{ +mlxtran string that can be applied to a model (by evaluating it) +} +\description{ +Get the string of the mutate statement for input dataset based on +mlxtran +} +\examples{ + +covD <- system.file("cov", package="monolix2rx") +m <- mlxtran(file.path(covD, "phenobarbital_project.mlxtran")) +message(mlxtranGetMutate(m)) +} +\author{ +Matthew L. Fidler +} diff --git a/man/monolix2rx.Rd b/man/monolix2rx.Rd index 43502c2..16bc041 100644 --- a/man/monolix2rx.Rd +++ b/man/monolix2rx.Rd @@ -60,6 +60,10 @@ pkgTheo <- system.file("theo", package="monolix2rx") rx <- monolix2rx(file.path(pkgTheo, "theophylline_project.mlxtran")) +pkgCov <- system.file("cov", package="monolix2rx") + +rx <- monolix2rx(file.path(pkgCov, "warfarin_covariate3_project.mlxtran")) + rx } \author{ diff --git a/tests/testthat/test-longDef.R b/tests/testthat/test-longDef.R index 99d0a1c..4ceed41 100644 --- a/tests/testthat/test-longDef.R +++ b/tests/testthat/test-longDef.R @@ -235,6 +235,31 @@ log(P(Event=k)) = lpk test_that("covariate transform", { + tmp <- .longDef("tSex = { + transform = 'sex', + categories = { + 'F' = {'0'}, + 'M' = {'1'} }, + reference = 'M'} + +tSTUDYIDN = +{ + transform = STUDYID, + categories = { + S1 = 1, + S2_3 = {2, 3}, + S4 = S4, + S5 = S5 + }, + reference = S2_3 +} +") + + expect_equal(as.character(tmp), + c("tSex = {transform='sex', categories={'F'={'0'}, 'M'={'1'}}, reference='M'}", + "tSTUDYIDN = {transform=STUDYID, categories={S1=1, S2_3={2, 3}, S4=S4, S5=S5}, reference=S2_3}" + )) + tmp <- .longDef(" tSex = { transform = 'sex', categories = { diff --git a/tests/testthat/test-pk.R b/tests/testthat/test-pk.R index 126c18b..b66fc6c 100644 --- a/tests/testthat/test-pk.R +++ b/tests/testthat/test-pk.R @@ -602,3 +602,11 @@ empty(adm=3, target=Ap)") expect_error(.pk("peripheral(k2_13, k13_2, k14_4)")) }) + +test_that("pk in long pk captures equations", { + + tmp <- .pk("before =1\nCc = pkmodel(ka, Cl, V)\nafter=1", TRUE) + + expect_equal(as.character(tmp), + c("before <- 1", "Cc = pkmodel(V, ka, Cl)", "after <- 1")) +})