added logistic and multinomial regression via keras

Author: topepo

R/logistic_reg.R

@@ -2,8 +2,8 @@
 #'
 #' `logistic_reg` is a way to generate a _specification_ of a model
 #'  before fitting and allows the model to be created using
-#'  different packages in R, Stan, or via Spark. The main arguments for the
-#'  model are:
+#'  different packages in R, Stan, keras, or via Spark. The main 
+#'  arguments for the model are:
 #' \itemize{
 #'   \item \code{penalty}: The total amount of regularization
 #'  in the model. Note that this must be zero for some engines.
@@ -19,8 +19,11 @@
 #' @inheritParams boost_tree
 #' @param mode A single character string for the type of model.
 #'  The only possible value for this model is "classification".
-#' @param penalty An non-negative number representing the
-#'  total amount of regularization (`glmnet` and `spark` only).
+#' @param penalty An non-negative number representing the total
+#'  amount of regularization (`glmnet`, `keras`, and `spark` only).
+#'  For `keras` models, this corresponds to purely L2 regularization
+#'  (aka weight decay) while the other models can be a combination
+#'  of L1 and L2 (depending on the value of `mixture`).
 #' @param mixture A number between zero and one (inclusive) that
 #'  represents the proportion of regularization that is used for the
 #'  L2 penalty (i.e. weight decay, or ridge regression) versus L1
@@ -34,6 +37,7 @@
 #' \item \pkg{R}:  `"glm"` or `"glmnet"`
 #' \item \pkg{Stan}:  `"stan"`
 #' \item \pkg{Spark}: `"spark"`
+#' \item \pkg{keras}: `"keras"`
 #' }
 #'
 #' @section Engine Details:
@@ -58,6 +62,10 @@
 #'
 #' \Sexpr[results=rd]{parsnip:::show_fit(parsnip:::logistic_reg(), "spark")}
 #'
+#' \pkg{keras}
+#'
+#' \Sexpr[results=rd]{parsnip:::show_fit(parsnip:::logistic_reg(), "keras")}
+#' 
 #' When using `glmnet` models, there is the option to pass
 #'  multiple values (or no values) to the `penalty` argument.
 #'  This can have an effect on the model object results. When using

R/logistic_reg_data.R

@@ -4,6 +4,7 @@ logistic_reg_arg_key <- data.frame(
   glmnet =  c(   "lambda",             "alpha"),
   spark  =  c("reg_param", "elastic_net_param"),
   stan   =  c(        NA,                  NA),
+  keras  =  c(   "decay",                  NA),  
   stringsAsFactors = FALSE,
   row.names =  c("penalty", "mixture")
 )
@@ -15,6 +16,7 @@ logistic_reg_engines <- data.frame(
   glmnet = TRUE,
   spark  = TRUE,
   stan   = TRUE,
+  keras  = TRUE,
   row.names =  c("classification")
 )
 
@@ -290,3 +292,39 @@ logistic_reg_spark_data <-
     )
   )
 
+logistic_reg_keras_data <-
+  list(
+    libs = c("keras", "magrittr"),
+    fit = list(
+      interface = "matrix",
+      protect = c("x", "y"),
+      func = c(pkg = "parsnip", fun = "keras_mlp"),
+      defaults = list(hidden_units = 1, act = "linear")
+    ),
+    class = list(
+      pre = NULL,
+      post = function(x, object) {
+        object$lvl[x + 1]
+      },
+      func = c(pkg = "keras", fun = "predict_classes"),
+      args =
+        list(
+          object = quote(object$fit),
+          x = quote(as.matrix(new_data))
+        )
+    ),
+    classprob = list(
+      pre = NULL,
+      post = function(x, object) {
+        x <- as_tibble(x)
+        colnames(x) <- object$lvl
+        x
+      },
+      func = c(pkg = "keras", fun = "predict_proba"),
+      args =
+        list(
+          object = quote(object$fit),
+          x = quote(as.matrix(new_data))
+        )
+    )
+  )

R/multinom_reg.R

@@ -2,7 +2,7 @@
 #'
 #' `multinom_reg` is a way to generate a _specification_ of a model
 #'  before fitting and allows the model to be created using
-#'  different packages in R or Spark. The main arguments for the
+#'  different packages in R, keras, or Spark. The main arguments for the
 #'  model are:
 #' \itemize{
 #'   \item \code{penalty}: The total amount of regularization
@@ -19,8 +19,11 @@
 #' @inheritParams boost_tree
 #' @param mode A single character string for the type of model.
 #'  The only possible value for this model is "classification".
-#' @param penalty An non-negative number representing the
-#'  total amount of regularization.
+#' @param penalty An non-negative number representing the total
+#'  amount of regularization (`glmnet`, `keras`, and `spark` only).
+#'  For `keras` models, this corresponds to purely L2 regularization
+#'  (aka weight decay) while the other models can be a combination
+#'  of L1 and L2 (depending on the value of `mixture`).
 #' @param mixture A number between zero and one (inclusive) that
 #'  represents the proportion of regularization that is used for the
 #'  L2 penalty (i.e. weight decay, or ridge regression) versus L1
@@ -33,6 +36,7 @@
 #' \itemize{
 #' \item \pkg{R}:   `"glmnet"`
 #' \item \pkg{Stan}:  `"stan"`
+#' \item \pkg{keras}: `"keras"`
 #' }
 #'
 #' @section Engine Details:
@@ -49,6 +53,10 @@
 #'
 #' \Sexpr[results=rd]{parsnip:::show_fit(parsnip:::multinom_reg(), "spark")}
 #'
+#' \pkg{keras}
+#'
+#' \Sexpr[results=rd]{parsnip:::show_fit(parsnip:::multinom_reg(), "keras")}
+#'
 #' When using `glmnet` models, there is the option to pass
 #'  multiple values (or no values) to the `penalty` argument.
 #'  This can have an effect on the model object results. When using

R/multinom_reg_data.R

@@ -2,6 +2,7 @@
 multinom_reg_arg_key <- data.frame(
   glmnet =  c(   "lambda",             "alpha"),
   spark  =  c("reg_param", "elastic_net_param"),
+  keras  =  c(    "decay",                  NA),  
   stringsAsFactors = FALSE,
   row.names =  c("penalty", "mixture")
 )
@@ -11,6 +12,7 @@ multinom_reg_modes <- "classification"
 multinom_reg_engines <- data.frame(
   glmnet = TRUE,
   spark  = TRUE,
+  keras  = TRUE,
   row.names =  c("classification")
 )
 
@@ -98,3 +100,39 @@ multinom_reg_spark_data <-
   )
 
 
+multinom_reg_keras_data <-
+  list(
+    libs = c("keras", "magrittr"),
+    fit = list(
+      interface = "matrix",
+      protect = c("x", "y"),
+      func = c(pkg = "parsnip", fun = "keras_mlp"),
+      defaults = list(hidden_units = 1, act = "linear")
+    ),
+    class = list(
+      pre = NULL,
+      post = function(x, object) {
+        object$lvl[x + 1]
+      },
+      func = c(pkg = "keras", fun = "predict_classes"),
+      args =
+        list(
+          object = quote(object$fit),
+          x = quote(as.matrix(new_data))
+        )
+    ),
+    classprob = list(
+      pre = NULL,
+      post = function(x, object) {
+        x <- as_tibble(x)
+        colnames(x) <- object$lvl
+        x
+      },
+      func = c(pkg = "keras", fun = "predict_proba"),
+      args =
+        list(
+          object = quote(object$fit),
+          x = quote(as.matrix(new_data))
+        )
+    )
+  )