Merge pull request #262 from nlmixr2/focei-tibble

Make .foceiPreProcessData() work with tibbles

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,

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))
+})