Add kernlab engine for svm_linear() (#438)

* Add kernlab as engine for svm_linear()

* Tests for kernlab linear SVM

* Redocument

* Update NEWS for new engine

Author: juliasilge

NEWS.md

@@ -2,7 +2,7 @@
 
 * The `liquidSVM` engine for `svm_rbf()` was deprecated due to that package's removal from CRAN. (#425)
 
-* A new linear SVM model `svm_linear()` is now available with the `LiblineaR` engine (#424), and the `LiblineaR` engine is available for `logistic_reg()` as well (#429).
+* A new linear SVM model `svm_linear()` is now available with the `LiblineaR` engine (#424) and the `kernlab` engine (#438), and the `LiblineaR` engine is available for `logistic_reg()` as well (#429).
 
 # parsnip 0.1.5
 

R/svm_linear.R

@@ -29,7 +29,7 @@
 #' The model can be created using the `fit()` function using the
 #'  following _engines_:
 #' \itemize{
-#' \item \pkg{R}:  `"LiblineaR"` (the default)
+#' \item \pkg{R}:  `"LiblineaR"` (the default) or `"kernlab"`
 #' }
 #'
 #'
@@ -173,6 +173,16 @@ translate.svm_linear <- function(x, engine = x$engine, ...) {
     }
   }
 
+  if (x$engine == "kernlab") {
+
+    # unless otherwise specified, classification models predict probabilities
+    if (x$mode == "classification" && !any(arg_names == "prob.model"))
+      arg_vals$prob.model <- TRUE
+    if (x$mode == "classification" && any(arg_names == "epsilon"))
+      arg_vals$epsilon <- NULL
+
+  }
+
   x$method$fit$args <- arg_vals
 
   # worried about people using this to modify the specification
@@ -191,3 +201,7 @@ svm_linear_post <- function(results, object) {
   results$predictions
 }
 
+svm_reg_linear_post <- function(results, object) {
+  results[,1]
+}
+

R/svm_linear_data.R

@@ -36,9 +36,7 @@ set_fit(
     protect = c("x", "y", "wi"),
     data = c(x = "data", y = "target"),
     func = c(pkg = "LiblineaR", fun = "LiblineaR"),
-    defaults = list(
-      type = 11
-    )
+    defaults = list(type = 11)
   )
 )
 
@@ -51,9 +49,7 @@ set_fit(
     data = c(x = "data", y = "target"),
     protect = c("x", "y", "wi"),
     func = c(pkg = "LiblineaR", fun = "LiblineaR"),
-    defaults = list(
-      type = 1
-    )
+    defaults = list(type = 1)
   )
 )
 
@@ -162,3 +158,158 @@ set_pred(
       newx = quote(new_data))
   )
 )
+
+# ------------------------------------------------------------------------------
+
+set_model_engine("svm_linear", "classification", "kernlab")
+set_model_engine("svm_linear", "regression", "kernlab")
+set_dependency("svm_linear", "kernlab", "kernlab")
+
+set_model_arg(
+  model = "svm_linear",
+  eng = "kernlab",
+  parsnip = "cost",
+  original = "C",
+  func = list(pkg = "dials", fun = "cost", range = c(-10, 5)),
+  has_submodel = FALSE
+)
+
+set_model_arg(
+  model = "svm_linear",
+  eng = "kernlab",
+  parsnip = "margin",
+  original = "epsilon",
+  func = list(pkg = "dials", fun = "svm_margin"),
+  has_submodel = FALSE
+)
+
+set_fit(
+  model = "svm_linear",
+  eng = "kernlab",
+  mode = "regression",
+  value = list(
+    interface = "formula",
+    data = c(formula = "x", data = "data"),
+    protect = c("x", "data"),
+    func = c(pkg = "kernlab", fun = "ksvm"),
+    defaults = list(kernel = "vanilladot")
+  )
+)
+
+set_fit(
+  model = "svm_linear",
+  eng = "kernlab",
+  mode = "classification",
+  value = list(
+    interface = "formula",
+    data = c(formula = "x", data = "data"),
+    protect = c("x", "data"),
+    func = c(pkg = "kernlab", fun = "ksvm"),
+    defaults = list(kernel = "vanilladot")
+  )
+)
+
+set_encoding(
+  model = "svm_linear",
+  eng = "kernlab",
+  mode = "regression",
+  options = list(
+    predictor_indicators = "none",
+    compute_intercept = FALSE,
+    remove_intercept = FALSE,
+    allow_sparse_x = FALSE
+  )
+)
+
+set_pred(
+  model = "svm_linear",
+  eng = "kernlab",
+  mode = "regression",
+  type = "numeric",
+  value = list(
+    pre = NULL,
+    post = svm_reg_linear_post,
+    func = c(pkg = "kernlab", fun = "predict"),
+    args =
+      list(
+        object = quote(object$fit),
+        newdata = quote(new_data),
+        type = "response"
+      )
+  )
+)
+
+set_pred(
+  model = "svm_linear",
+  eng = "kernlab",
+  mode = "regression",
+  type = "raw",
+  value = list(
+    pre = NULL,
+    post = NULL,
+    func = c(pkg = "kernlab", fun = "predict"),
+    args = list(object = quote(object$fit), newdata = quote(new_data))
+  )
+)
+
+set_encoding(
+  model = "svm_linear",
+  eng = "kernlab",
+  mode = "classification",
+  options = list(
+    predictor_indicators = "none",
+    compute_intercept = FALSE,
+    remove_intercept = FALSE,
+    allow_sparse_x = FALSE
+  )
+)
+
+set_pred(
+  model = "svm_linear",
+  eng = "kernlab",
+  mode = "classification",
+  type = "class",
+  value = list(
+    pre = NULL,
+    post = NULL,
+    func = c(pkg = "kernlab", fun = "predict"),
+    args =
+      list(
+        object = quote(object$fit),
+        newdata = quote(new_data),
+        type = "response"
+      )
+  )
+)
+
+set_pred(
+  model = "svm_linear",
+  eng = "kernlab",
+  mode = "classification",
+  type = "prob",
+  value = list(
+    pre = NULL,
+    post = function(result, object) as_tibble(result),
+    func = c(pkg = "kernlab", fun = "predict"),
+    args =
+      list(
+        object = quote(object$fit),
+        newdata = quote(new_data),
+        type = "probabilities"
+      )
+  )
+)
+
+set_pred(
+  model = "svm_linear",
+  eng = "kernlab",
+  mode = "classification",
+  type = "raw",
+  value = list(
+    pre = NULL,
+    post = NULL,
+    func = c(pkg = "kernlab", fun = "predict"),
+    args = list(object = quote(object$fit), newdata = quote(new_data))
+  )
+)
+

man/rmd/svm-linear.Rmd

@@ -31,6 +31,25 @@ predictions (e.g., accuracy and so on).
 This engine fits models that are L2-regularized for L2-loss. In the `LiblineaR` 
 documentation, these are types 1 (classification) and 11 (regression).
 
+## kernlab
+
+```{r kernlab-reg}
+svm_linear() %>% 
+  set_engine("kernlab") %>% 
+  set_mode("regression") %>% 
+  translate()
+```
+
+```{r kernlab-cls}
+svm_linear() %>% 
+  set_engine("kernlab") %>% 
+  set_mode("classification") %>% 
+  translate()
+```
+
+`fit()` passes the data directly to `kernlab::ksvm()` so that its formula method can create dummy variables as-needed. 
+
+
 ## Parameter translations
 
 The standardized parameter names in parsnip can be mapped to their original 
@@ -44,6 +63,8 @@ get_defaults_svm_linear <- function() {
     ~model,    ~engine,       ~parsnip,        ~original,  ~default,
     "svm_linear", "LiblineaR",   "cost",          "C",        "1",
     "svm_linear", "LiblineaR",   "margin",        "svr_eps",  "0.1",
+    "svm_linear", "kernlab",     "cost",          "C",        "1",
+    "svm_linear", "kernlab",     "margin",        "epsilon",  "0.1",
   )
 }
 convert_args("svm_linear")