changes for issues #120 and #115 (#159)

For classification problems, an error is thrown if the outcome is not a factor: 

```
Error: For classification models, the outcome should be a factor.
```

There are a lot of travis related changes too: 

  * To get travis to run tests, the modeling packages have to be formal dependencies so a bunch were added to Suggests. This _may_ be temporary; I may decide to remove these for the version sent to CRAN. `rstanarm` was excluded because compiling it (and its dependencies) exceeded the time allowed by travis. 

 * A variety of changes were made to the tests related to r-devel. It looks like any function directly accessed in the tests now need to be formal dependencies (not the case before). There is still some weirdness about this though and I've attributed it to being _devel_. Hopefully this will get smoothed out.

Author: topepo

.Rbuildignore

@@ -7,3 +7,6 @@
 ^\.Rproj\.user$
 ^.travis.yml$
 ^R/README\.md$
+derby.log
+^logs$
+^tests/testthat/logs$

.gitignore

@@ -5,3 +5,5 @@
 tests/testthat/derby.log
 tests/testthat/logs/
 *.history
+derby.log
+logs/*

.travis.yml

@@ -8,67 +8,76 @@ sudo: true
 warnings_are_errors: false
 
 r:
-- 3.1
-- 3.2
-- oldrel
-- release
-- devel
+  - 3.1
+  - 3.2
+  - oldrel
+  - release
+  - devel
 
-env:
-  global:
-  - KERAS_BACKEND="tensorflow"
-  - MAKEFLAGS="-j 2"
 
-# until we troubleshoot these issues
 matrix:
   allow_failures:
     - r: 3.1
     - r: 3.2
 
 r_binary_packages: 
- - rstan
- - rstanarm
- - RCurl
- - dplyr
- - glue
- - magrittr
- - stringi
- - stringr
- - munsell
- - rlang
- - reshape2
- - scales
- - tibble
- - ggplot2
- - StanHeaders
- - Rcpp
- - RcppEigen
- - BH
- - glmnet
- - earth
- - sparklyr
- - flexsurv
- - ranger
- - randomforest
- - xgboost
- - C50
+  - RCurl
+  - dplyr
+  - glue
+  - magrittr
+  - stringi
+  - stringr
+  - munsell
+  - rlang
+  - reshape2
+  - scales
+  - tibble
+  - ggplot2
+  - Rcpp
+  - RcppEigen
+  - BH
+  - glmnet
+  - earth
+  - sparklyr
+  - flexsurv
+  - ranger
+  - randomforest
+  - xgboost
+  - C50
+
 
 cache:
   packages: true
   directories:
     - $HOME/.keras
     - $HOME/.cache/pip
 
+env:
+  global:
+  - KERAS_BACKEND="tensorflow"
+  - MAKEFLAGS="-j 2"
+
+addons:
+  apt:
+    sources:
+      - ubuntu-toolchain-r-test
+    packages:
+      g++-6
 
 before_script:
   - python -m pip install --upgrade --ignore-installed --user travis pip setuptools wheel virtualenv
   - python -m pip install --upgrade --ignore-installed --user travis keras h5py pyyaml requests Pillow scipy theano
   - R -e 'tensorflow::install_tensorflow()'
 
+
 before_install:
   - sudo apt-get -y install libnlopt-dev 
   - sudo apt-get update
   - sudo apt-get -y install python3
+  - mkdir -p ~/.R && echo "CXX14=g++-6" > ~/.R/Makevars
+  - echo "CXX14FLAGS += -fPIC" >> ~/.R/Makevars
+ 
 
 after_success:
   - Rscript -e 'covr::codecov()'
+

DESCRIPTION

@@ -38,4 +38,14 @@ Suggests:
     keras,
     xgboost,
     covr,
-    sparklyr
+    C50,
+    sparklyr,
+    earth,
+    glmnet,
+    kernlab,
+    kknn,
+    randomForest,
+    ranger,
+    rpart,
+    MASS,
+    nlme

NEWS.md

@@ -14,8 +14,11 @@ that are actually varying).
 
 * `fit_control()` not returns an S3 method. 
 
+* For classification models, an error occurs if the outcome data are not encoded as factors (#115). 
+
 * The prediction modules (e.g. `predict_class`, `predict_numeric`, etc) were de-exported. These were internal functions that were not to be used by the users and the users were using them. 
 
+
 ## Bug Fixes
 
 * `varying_args()` now uses the version from the `generics` package. This means

R/fit_helpers.R

@@ -6,21 +6,21 @@
 #' @importFrom  stats model.frame model.response terms as.formula model.matrix
 form_form <-
   function(object, control, env, ...) {
-    opts <- quos(...)
 
-    if (object$mode != "regression") {
-      y_levels <- levels_from_formula( # prob rewrite this as simple subset/levels
-        env$formula,
-        env$data
-      )
+    if (object$mode == "classification") {
+      # prob rewrite this as simple subset/levels
+      y_levels <- levels_from_formula(env$formula, env$data)
+      if (!inherits(env$data, "tbl_spark") && is.null(y_levels))
+        stop("For classification models, the outcome should be a factor.",
+             call. =  FALSE)
     } else {
       y_levels <- NULL
     }
 
     object <- check_mode(object, y_levels)
 
     # if descriptors are needed, update descr_env with the calculated values
-    if(requires_descrs(object)) {
+    if (requires_descrs(object)) {
       data_stats <- get_descr_form(env$formula, env$data)
       scoped_descrs(data_stats)
     }
@@ -71,8 +71,14 @@ xy_xy <- function(object, env, control, target = "none", ...) {
 
   object <- check_mode(object, levels(env$y))
 
+  if (object$mode == "classification") {
+    if (is.null(levels(env$y)))
+      stop("For classification models, the outcome should be a factor.",
+           call. =  FALSE)
+  }
+
   # if descriptors are needed, update descr_env with the calculated values
-  if(requires_descrs(object)) {
+  if (requires_descrs(object)) {
     data_stats <- get_descr_form(env$formula, env$data)
     scoped_descrs(data_stats)
   }
@@ -125,13 +131,12 @@ form_xy <- function(object, control, env,
   env$x <- data_obj$x
   env$y <- data_obj$y
 
-  res <- list(
-    lvl = levels_from_formula(
-      env$formula,
-      env$data
-    ),
-    spec = object
-  )
+  res <- list(lvl = levels_from_formula(env$formula, env$data), spec = object)
+  if (object$mode == "classification") {
+    if (is.null(res$lvl))
+      stop("For classification models, the outcome should be a factor.",
+           call. =  FALSE)
+  }
 
   res <- xy_xy(
     object = object,
@@ -148,6 +153,13 @@ form_xy <- function(object, control, env,
 }
 
 xy_form <- function(object, env, control, ...) {
+
+  if (object$mode == "classification") {
+    if (is.null(levels(env$y)))
+      stop("For classification models, the outcome should be a factor.",
+           call. =  FALSE)
+  }
+
   data_obj <-
     convert_xy_to_form_fit(
       x = env$x,

R/multinom_reg.R

@@ -168,7 +168,7 @@ check_args.multinom_reg <- function(object) {
 
   args <- lapply(object$args, rlang::eval_tidy)
 
-  if (is.numeric(args$penalty) && args$penalty < 0)
+  if (all(is.numeric(args$penalty)) && any(args$penalty < 0))
     stop("The amount of regularization should be >= 0", call. = FALSE)
   if (is.numeric(args$mixture) && (args$mixture < 0 | args$mixture > 1))
     stop("The mixture proportion should be within [0,1]", call. = FALSE)

tests/testthat/test_boost_tree_C50.R

@@ -1,13 +1,17 @@
 library(testthat)
 library(parsnip)
 library(tibble)
+library(dplyr)
 
 # ------------------------------------------------------------------------------
 
 context("boosted tree execution with C5.0")
 
 data("lending_club")
 lending_club <- head(lending_club, 200)
+lending_club_fail <-
+  lending_club %>%
+  mutate(bad = Inf, miss = NA)
 num_pred <- c("funded_amnt", "annual_inc", "num_il_tl")
 lc_basic <-
   boost_tree(mode = "classification")  %>%
@@ -41,6 +45,8 @@ test_that('C5.0 execution', {
     ),
     regexp = NA
   )
+
+  # outcome is not a factor:
   expect_error(
     res <- fit(
       lc_basic,
@@ -51,19 +57,21 @@ test_that('C5.0 execution', {
     )
   )
 
+  # Model fails
   C5.0_form_catch <- fit(
     lc_basic,
-    funded_amnt ~ term,
-    data = lending_club,
+    Class ~ miss,
+    data = lending_club_fail,
     control = caught_ctrl
   )
   expect_true(inherits(C5.0_form_catch$fit, "try-error"))
 
+  # Model fails
   C5.0_xy_catch <- fit_xy(
     lc_basic,
     control = caught_ctrl,
-    x = lending_club[, num_pred],
-    y = lending_club$total_bal_il
+    x = lending_club_fail[, "miss"],
+    y = lending_club_fail$Class
   )
   expect_true(inherits(C5.0_xy_catch$fit, "try-error"))
 })
@@ -108,11 +116,12 @@ test_that('C5.0 probabilities', {
 test_that('submodel prediction', {
 
   skip_if_not_installed("C50")
+  library(C50)
 
   vars <- c("female", "tenure", "total_charges", "phone_service", "monthly_charges")
   class_fit <-
     boost_tree(trees = 20, mode = "classification") %>%
-    set_engine("C5.0", control = C50::C5.0Control(earlyStopping = FALSE)) %>%
+    set_engine("C5.0", control = C5.0Control(earlyStopping = FALSE)) %>%
     fit(churn ~ ., data = wa_churn[-(1:4), c("churn", vars)])
 
   pred_class <- predict(class_fit$fit, wa_churn[1:4, vars], trials = 4, type = "prob")

tests/testthat/test_linear_reg_stan.R

@@ -102,14 +102,21 @@ test_that('stan intervals', {
             type = "pred_int",
             level = 0.93)
 
-  prediction_stan <-
-    predictive_interval(res_xy$fit, newdata = iris[1:5, ], seed = 13,
-                        prob = 0.93)
-
-  stan_post <- posterior_linpred(res_xy$fit, newdata = iris[1:5, ],
-                                 seed = 13)
-  stan_lower <- apply(stan_post, 2, quantile, prob = 0.035)
-  stan_upper <- apply(stan_post, 2, quantile, prob = 0.965)
+  # prediction_stan <-
+  #   predictive_interval(res_xy$fit, newdata = iris[1:5, ], seed = 13,
+  #                       prob = 0.93)
+  #
+  # stan_post <- posterior_linpred(res_xy$fit, newdata = iris[1:5, ],
+  #                                seed = 13)
+  # stan_lower <- apply(stan_post, 2, quantile, prob = 0.035)
+  # stan_upper <- apply(stan_post, 2, quantile, prob = 0.965)
+
+  stan_lower <- c(`1` = 4.93164991101342, `2` = 4.60197941230393,
+                  `3` = 4.6671442757811, `4` = 4.74402724639963,
+                  `5` = 4.99248110476701)
+  stan_upper <- c(`1` = 5.1002837047058, `2` = 4.77617561853506,
+                  `3` = 4.83183673602725, `4` = 4.90844811805409,
+                  `5` = 5.16979395659009)
 
   expect_equivalent(confidence_parsnip$.pred_lower, stan_lower)
   expect_equivalent(confidence_parsnip$.pred_upper, stan_upper)

tests/testthat/test_logistic_reg.R

@@ -244,23 +244,24 @@ test_that('glm execution', {
     )
   )
 
-  # passes interactively but not on R CMD check
-  # glm_form_catch <- fit(
-  #   lc_basic,
-  #   funded_amnt ~ term,
-  #   data = lending_club,
-  #
-  #   control = caught_ctrl
-  # )
-  # expect_true(inherits(glm_form_catch$fit, "try-error"))
+  # wrong outcome type
+  expect_error(
+    glm_form_catch <- fit(
+      lc_basic,
+      funded_amnt ~ term,
+      data = lending_club,
+      control = caught_ctrl
+    )
+  )
 
-  glm_xy_catch <- fit_xy(
-    lc_basic,
-    control = caught_ctrl,
-    x = lending_club[, num_pred],
-    y = lending_club$total_bal_il
+  expect_error(
+    glm_xy_catch <- fit_xy(
+      lc_basic,
+      control = caught_ctrl,
+      x = lending_club[, num_pred],
+      y = lending_club$total_bal_il
+    )
   )
-  expect_true(inherits(glm_xy_catch$fit, "try-error"))
 })
 
 test_that('glm prediction', {