From d27bfeb6744e1b49ea3a38d88bf2b60b45e38b64 Mon Sep 17 00:00:00 2001 From: Bill Denney Date: Tue, 18 Oct 2022 20:52:56 -0400 Subject: [PATCH 1/2] Make .foceiPreProcessData() work with tibbles --- R/focei.R | 20 ++++++++++---------- tests/testthat/test-focei.R | 19 +++++++++++++++++++ 2 files changed, 29 insertions(+), 10 deletions(-) create mode 100644 tests/testthat/test-focei.R diff --git a/R/focei.R b/R/focei.R index 0d85fdf9..2c84e99c 100644 --- a/R/focei.R +++ b/R/focei.R @@ -289,12 +289,12 @@ rxGetDistributionFoceiLines <- function(line) { #' Get pred only options #' #' @param env rxode2 environment option -#' +#' #' @return If the current method is requesting loglik instead of pred/r #' (required for cwres) -#' +#' #' @author Matthew L. Fidler -#' +#' #' @noRd .getRxPredLlikOption <-function() { if (inherits(.rxPredLlik, "logical")) { @@ -318,7 +318,7 @@ rxGetDistributionFoceiLines.norm <- function(line) { #' @export rxGetDistributionFoceiLines.t <- function(line) { - if (rxode2hasLlik()) { + if (rxode2hasLlik()) { env <- line[[1]] pred1 <- line[[2]] .errNum <- line[[3]] @@ -331,7 +331,7 @@ rxGetDistributionFoceiLines.t <- function(line) { #' @export rxGetDistributionFoceiLines.cauchy <- function(line) { - if (rxode2hasLlik()) { + if (rxode2hasLlik()) { env <- line[[1]] pred1 <- line[[2]] .errNum <- line[[3]] @@ -344,7 +344,7 @@ rxGetDistributionFoceiLines.cauchy <- function(line) { #' @export rxGetDistributionFoceiLines.default <- function(line) { - if (rxode2hasLlik()) { + if (rxode2hasLlik()) { env <- line[[1]] pred1 <- line[[2]] .errNum <- line[[3]] @@ -401,13 +401,13 @@ rxUiGet.foceiModel0ll <- function(x, ...) { .malert(("pruning branches ({.code if}/{.code else}) of llik full model...")) } else { .malert("pruning branches ({.code if}/{.code else}) of llik model...") - } + } } else { if (fullModel) { .malert(("pruning branches ({.code if}/{.code else}) of full model...")) } else { .malert("pruning branches ({.code if}/{.code else}) of model...") - } + } } .ret <- rxode2::.rxPrune(.x, envir = .env) .mv <- rxode2::rxModelVars(.ret) @@ -1021,7 +1021,7 @@ rxUiGet.foceiEtaNames <- function(x, ...) { .rxControl <- rxode2::rxGetControl(ui, "rxControl", rxode2::rxControl()) .rxControl$nLlikAlloc <- .maxLl rxode2::rxAssignControlValue(ui, "rxControl", .rxControl) - } + } } } @@ -1337,7 +1337,7 @@ attr(rxUiGet.foceiOptEnv, "desc") <- "Get focei optimization environment" } data[[.v]] <- as.double(data[[.v]]) } - data$nlmixrRowNums <- seq_along(data[, 1]) + data$nlmixrRowNums <- seq_len(nrow(data)) .keep <- unique(c("nlmixrRowNums", env$table$keep)) .et <- rxode2::etTrans(inData=data, obj=ui$mv0, addCmt=TRUE, dropUnits=TRUE, diff --git a/tests/testthat/test-focei.R b/tests/testthat/test-focei.R new file mode 100644 index 00000000..78e672f6 --- /dev/null +++ b/tests/testthat/test-focei.R @@ -0,0 +1,19 @@ +test_that(".foceiPreProcessData works with data.frame and tibble data", { + model <- function() { + ini({ + foo <- 1 + }) + model({ + bar <- foo + bar ~ add(foo) + }) + } + ui <- nlmixr(model) + env_orig <- new.env() + df <- data.frame(ID=1, DV=1:2, time=1:2) + .foceiPreProcessData(data = df, env = env_orig, ui = ui) + expect_equal(env_orig$dataSav$nlmixrRowNums, c(NA, 1, 2)) + tib <- tibble::tibble(ID=1, DV=1:2, time=1:2) + .foceiPreProcessData(data = tib, env = env_orig, ui = ui) + expect_equal(env_orig$dataSav$nlmixrRowNums, c(NA, 1, 2)) +}) From 8e73d98920bff8b39d945ab5fc6ea3501667a6c9 Mon Sep 17 00:00:00 2001 From: Bill Denney Date: Tue, 18 Oct 2022 21:02:56 -0400 Subject: [PATCH 2/2] Simplify .foceiPreProcessData() --- R/focei.R | 9 +++----- tests/testthat/test-focei.R | 43 ++++++++++++++++++++++++++++--------- 2 files changed, 36 insertions(+), 16 deletions(-) diff --git a/R/focei.R b/R/focei.R index 2c84e99c..fe36558a 100644 --- a/R/focei.R +++ b/R/focei.R @@ -1326,15 +1326,12 @@ attr(rxUiGet.foceiOptEnv, "desc") <- "Get focei optimization environment" return(toupper(x)) } }, character(1)) - if (is.null(data$ID)) stop('"ID" not found in data') - if (is.null(data$DV)) stop('"DV" not found in data') + requiredCols <- c("ID", "DV", "TIME", .covNames) + checkmate::assert_names(names(data), must.include = requiredCols) if (is.null(data$EVID)) data$EVID <- 0 if (is.null(data$AMT)) data$AMT <- 0 ## Make sure they are all double amounts. - for (.v in c("TIME", "AMT", "DV", .covNames)) { - if (!any(names(data) == .v)) { - stop("missing '", .v, "' in data", call.=FALSE) - } + for (.v in requiredCols) { data[[.v]] <- as.double(data[[.v]]) } data$nlmixrRowNums <- seq_len(nrow(data)) diff --git a/tests/testthat/test-focei.R b/tests/testthat/test-focei.R index 78e672f6..5f91f273 100644 --- a/tests/testthat/test-focei.R +++ b/tests/testthat/test-focei.R @@ -1,14 +1,37 @@ +model <- function() { + ini({ + foo <- 1 + }) + model({ + bar <- foo + bar ~ add(foo) + }) +} +ui <- nlmixr(model) + +test_that(".foceiPreProcessData errors with missing info", { + env_orig <- new.env() + df_noid <- data.frame(DV=1:2, time=1:2) + df_nodv <- data.frame(ID=1, time=1:2) + df_notime <- data.frame(ID=1, DV=1:2) + expect_error( + .foceiPreProcessData(data = df_noid, env = env_orig, ui = ui), + regexp = "missing elements {'ID'}", + fixed = TRUE + ) + expect_error( + .foceiPreProcessData(data = df_nodv, env = env_orig, ui = ui), + regexp = "missing elements {'DV'}", + fixed = TRUE + ) + expect_error( + .foceiPreProcessData(data = df_notime, env = env_orig, ui = ui), + regexp = "missing elements {'TIME'}", + fixed = TRUE + ) +}) + test_that(".foceiPreProcessData works with data.frame and tibble data", { - model <- function() { - ini({ - foo <- 1 - }) - model({ - bar <- foo - bar ~ add(foo) - }) - } - ui <- nlmixr(model) env_orig <- new.env() df <- data.frame(ID=1, DV=1:2, time=1:2) .foceiPreProcessData(data = df, env = env_orig, ui = ui)