diff --git a/R/focei.R b/R/focei.R index 0d85fdf9..fe36558a 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) - } + } } } @@ -1326,18 +1326,15 @@ 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_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..5f91f273 --- /dev/null +++ b/tests/testthat/test-focei.R @@ -0,0 +1,42 @@ +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", { + 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)) +})