Brulee neural networks with two hidden layers

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: parsnip
 Title: A Common API to Modeling and Analysis Functions
-Version: 1.2.1.9002
+Version: 1.2.1.9003
 Authors@R: c(
     person("Max", "Kuhn", , "max@posit.co", role = c("aut", "cre")),
     person("Davis", "Vaughan", , "davis@posit.co", role = "aut"),

NAMESPACE

@@ -132,7 +132,7 @@ S3method(tunable,logistic_reg)
 S3method(tunable,mars)
 S3method(tunable,mlp)
 S3method(tunable,model_spec)
-S3method(tunable,multinomial_reg)
+S3method(tunable,multinom_reg)
 S3method(tunable,rand_forest)
 S3method(tunable,survival_reg)
 S3method(tunable,svm_poly)

R/mlp_brulee_two_layer.R

@@ -0,0 +1,11 @@
+#' Multilayer perceptron via brulee with two hidden layers
+#'
+#' [brulee::brulee_mlp_two_layer()] fits a neural network (with version 0.3.0.9000 or higher of brulee)
+#'
+#' @includeRmd man/rmd/mlp_brulee_two_layer.md details
+#'
+#' @name details_mlp_brulee_two_layer
+#' @keywords internal
+NULL
+
+# See inst/README-DOCS.md for a description of how these files are processed

R/mlp_data.R

@@ -527,3 +527,165 @@ set_pred(
   )
 )
 
+
+set_model_engine("mlp", "classification", "brulee_two_layer")
+set_model_engine("mlp", "regression", "brulee_two_layer")
+set_dependency("mlp", "brulee_two_layer", "brulee")
+
+set_model_arg(
+  model = "mlp",
+  eng = "brulee_two_layer",
+  parsnip = "hidden_units",
+  original = "hidden_units",
+  func = list(pkg = "dials", fun = "hidden_units"),
+  has_submodel = FALSE
+)
+
+set_model_arg(
+  model = "mlp",
+  eng = "brulee_two_layer",
+  parsnip = "penalty",
+  original = "penalty",
+  func = list(pkg = "dials", fun = "penalty"),
+  has_submodel = FALSE
+)
+
+set_model_arg(
+  model = "mlp",
+  eng = "brulee_two_layer",
+  parsnip = "epochs",
+  original = "epochs",
+  func = list(pkg = "dials", fun = "epochs"),
+  has_submodel = FALSE
+)
+
+set_model_arg(
+  model = "mlp",
+  eng = "brulee_two_layer",
+  parsnip = "dropout",
+  original = "dropout",
+  func = list(pkg = "dials", fun = "dropout"),
+  has_submodel = FALSE
+)
+
+set_model_arg(
+  model = "mlp",
+  eng = "brulee_two_layer",
+  parsnip = "learn_rate",
+  original = "learn_rate",
+  func = list(pkg = "dials", fun = "learn_rate", range = c(-2.5, -0.5)),
+  has_submodel = FALSE
+)
+
+set_model_arg(
+  model = "mlp",
+  eng = "brulee_two_layer",
+  parsnip = "activation",
+  original = "activation",
+  func = list(pkg = "dials", fun = "activation", values = c('relu', 'elu', 'tanh')),
+  has_submodel = FALSE
+)
+
+
+set_fit(
+  model = "mlp",
+  eng = "brulee_two_layer",
+  mode = "regression",
+  value = list(
+    interface = "data.frame",
+    protect = c("x", "y"),
+    func = c(pkg = "brulee", fun = "brulee_mlp_two_layer"),
+    defaults = list()
+  )
+)
+
+set_encoding(
+  model = "mlp",
+  eng = "brulee_two_layer",
+  mode = "regression",
+  options = list(
+    predictor_indicators = "none",
+    compute_intercept = FALSE,
+    remove_intercept = FALSE,
+    allow_sparse_x = FALSE
+  )
+)
+
+set_fit(
+  model = "mlp",
+  eng = "brulee_two_layer",
+  mode = "classification",
+  value = list(
+    interface = "data.frame",
+    protect = c("x", "y"),
+    func = c(pkg = "brulee", fun = "brulee_mlp_two_layer"),
+    defaults = list()
+  )
+)
+
+set_encoding(
+  model = "mlp",
+  eng = "brulee_two_layer",
+  mode = "classification",
+  options = list(
+    predictor_indicators = "none",
+    compute_intercept = FALSE,
+    remove_intercept = FALSE,
+    allow_sparse_x = FALSE
+  )
+)
+
+set_pred(
+  model = "mlp",
+  eng = "brulee_two_layer",
+  mode = "regression",
+  type = "numeric",
+  value = list(
+    pre = NULL,
+    post = reformat_torch_num,
+    func = c(fun = "predict"),
+    args =
+      list(
+        object = quote(object$fit),
+        new_data = quote(new_data),
+        type = "numeric"
+      )
+  )
+)
+
+set_pred(
+  model = "mlp",
+  eng = "brulee_two_layer",
+  mode = "classification",
+  type = "class",
+  value = list(
+    pre = NULL,
+    post = NULL,
+    func = c(fun = "predict"),
+    args =
+      list(
+        object = quote(object$fit),
+        new_data = quote(new_data),
+        type = "class"
+      )
+  )
+)
+
+set_pred(
+  model = "mlp",
+  eng = "brulee_two_layer",
+  mode = "classification",
+  type = "prob",
+  value = list(
+    pre = NULL,
+    post = NULL,
+    func = c(fun = "predict"),
+    args =
+      list(
+        object = quote(object$fit),
+        new_data = quote(new_data),
+        type = "prob"
+      )
+  )
+)
+

R/tunable.R

@@ -194,38 +194,6 @@ earth_engine_args <-
     component_id = "engine"
   )
 
-brulee_mlp_engine_args <-
-  tibble::tribble(
-    ~name,                                                  ~call_info,
-    "momentum",      list(pkg = "dials", fun = "momentum", range = c(0.5, 0.95)),
-    "batch_size",      list(pkg = "dials", fun = "batch_size", range = c(3, 10)),
-    "stop_iter",                          list(pkg = "dials", fun = "stop_iter"),
-    "class_weights",                  list(pkg = "dials", fun = "class_weights"),
-    "decay",                             list(pkg = "dials", fun = "rate_decay"),
-    "initial",                         list(pkg = "dials", fun = "rate_initial"),
-    "largest",                         list(pkg = "dials", fun = "rate_largest"),
-    "rate_schedule",                  list(pkg = "dials", fun = "rate_schedule"),
-    "step_size",                     list(pkg = "dials", fun = "rate_step_size"),
-    "steps",                             list(pkg = "dials", fun = "rate_steps")
-  ) %>%
-  dplyr::mutate(,
-                source = "model_spec",
-                component = "mlp",
-                component_id = "engine"
-  )
-
-brulee_linear_engine_args <-
-  brulee_mlp_engine_args %>%
-  dplyr::filter(name %in% c("momentum", "batch_size", "stop_iter"))
-
-brulee_logistic_engine_args <-
-  brulee_mlp_engine_args %>%
-  dplyr::filter(name %in% c("momentum", "batch_size", "stop_iter", "class_weights"))
-
-brulee_multinomial_engine_args <-
-  brulee_mlp_engine_args %>%
-  dplyr::filter(name %in% c("momentum", "batch_size", "stop_iter", "class_weights"))
-
 flexsurvspline_engine_args <-
   tibble::tibble(
     name = c("k"),
@@ -238,6 +206,37 @@ flexsurvspline_engine_args <-
   )
 
 # ------------------------------------------------------------------------------
+# used for brulee engines:
+
+tune_activations <- c("relu", "tanh", "elu", "log_sigmoid", "tanhshrink")
+tune_sched <- c("none", "decay_time", "decay_expo", "cyclic", "step")
+
+brulee_args <-
+  tibble::tibble(
+    name = c('epochs', 'hidden_units', 'hidden_units_2', 'activation', 'activation_2',
+             'penalty', 'mixture', 'dropout', 'learn_rate', 'momentum', 'batch_size',
+             'class_weights', 'stop_iter', 'rate_schedule'),
+    call_info = list(
+      list(pkg = "dials", fun = "epochs", range = c(5L, 500L)),
+      list(pkg = "dials", fun = "hidden_units", range = c(2L, 50L)),
+      list(pkg = "dials", fun = "hidden_units_2", range = c(2L, 50L)),
+      list(pkg = "dials", fun = "activation", values = tune_activations),
+      list(pkg = "dials", fun = "activation_2", values = tune_activations),
+      list(pkg = "dials", fun = "penalty"),
+      list(pkg = "dials", fun = "mixture"),
+      list(pkg = "dials", fun = "dropout"),
+      list(pkg = "dials", fun = "learn_rate", range = c(-3, -1/5)),
+      list(pkg = "dials", fun = "momentum", range = c(0.50, 0.95)),
+      list(pkg = "dials", fun = "batch_size"),
+      list(pkg = "dials", fun = "stop_iter"),
+      list(pkg = "dials", fun = "class_weights"),
+      list(pkg = "dials", fun = "rate_schedule", values = tune_sched)
+    )
+  )
+
+# ------------------------------------------------------------------------------
+
+
 
 #' @export
 tunable.linear_reg <- function(x, ...) {
@@ -246,34 +245,19 @@ tunable.linear_reg <- function(x, ...) {
     res$call_info[res$name == "mixture"] <-
       list(list(pkg = "dials", fun = "mixture", range = c(0.05, 1.00)))
   } else if (x$engine == "brulee") {
-    res <- add_engine_parameters(res, brulee_linear_engine_args)
+    res <-
+      brulee_args %>%
+      dplyr::filter(name %in% tune_args(x)$name) %>%
+      dplyr::full_join(res %>% dplyr::select(-call_info), by = "name")
   }
   res
 }
 
 #' @export
-tunable.logistic_reg <- function(x, ...) {
-  res <- NextMethod()
-  if (x$engine == "glmnet") {
-    res$call_info[res$name == "mixture"] <-
-      list(list(pkg = "dials", fun = "mixture", range = c(0.05, 1.00)))
-  } else if (x$engine == "brulee") {
-    res <- add_engine_parameters(res, brulee_logistic_engine_args)
-  }
-  res
-}
+tunable.logistic_reg <- tunable.linear_reg
 
 #' @export
-tunable.multinomial_reg <- function(x, ...) {
-  res <- NextMethod()
-  if (x$engine == "glmnet") {
-    res$call_info[res$name == "mixture"] <-
-      list(list(pkg = "dials", fun = "mixture", range = c(0.05, 1.00)))
-  } else if (x$engine == "brulee") {
-    res <- add_engine_parameters(res, brulee_multinomial_engine_args)
-  }
-  res
-}
+tunable.multinom_reg <- tunable.linear_reg
 
 #' @export
 tunable.boost_tree <- function(x, ...) {
@@ -346,16 +330,14 @@ tunable.svm_poly <- function(x, ...) {
   res
 }
 
-
 #' @export
 tunable.mlp <- function(x, ...) {
   res <- NextMethod()
-  if (x$engine == "brulee") {
-    res <- add_engine_parameters(res, brulee_mlp_engine_args)
-    res$call_info[res$name == "learn_rate"] <-
-      list(list(pkg = "dials", fun = "learn_rate", range = c(-3, -1/2)))
-    res$call_info[res$name == "epochs"] <-
-      list(list(pkg = "dials", fun = "epochs", range = c(5L, 500L)))
+  if (grepl("brulee", x$engine)) {
+    res <-
+      brulee_args %>%
+      dplyr::filter(name %in% tune_args(x)$name) %>%
+      dplyr::full_join(res %>% dplyr::select(-call_info), by = "name")
   }
   res
 }

inst/models.tsv

@@ -1,4 +1,5 @@
 "model"	"mode"	"engine"	"pkg"
+"C5_rules"	"classification"	"C5.0"	"rules"
 "auto_ml"	"classification"	"h2o"	"agua"
 "auto_ml"	"regression"	"h2o"	"agua"
 "bag_mars"	"classification"	"earth"	"baguette"
@@ -23,7 +24,6 @@
 "boost_tree"	"regression"	"lightgbm"	"bonsai"
 "boost_tree"	"regression"	"spark"	NA
 "boost_tree"	"regression"	"xgboost"	NA
-"C5_rules"	"classification"	"C5.0"	"rules"
 "cubist_rules"	"regression"	"Cubist"	"rules"
 "decision_tree"	"censored regression"	"partykit"	"censored"
 "decision_tree"	"censored regression"	"rpart"	"censored"
@@ -58,24 +58,26 @@
 "linear_reg"	"regression"	"spark"	NA
 "linear_reg"	"regression"	"stan"	NA
 "linear_reg"	"regression"	"stan_glmer"	"multilevelmod"
+"logistic_reg"	"classification"	"LiblineaR"	NA
 "logistic_reg"	"classification"	"brulee"	NA
 "logistic_reg"	"classification"	"gee"	"multilevelmod"
 "logistic_reg"	"classification"	"glm"	NA
 "logistic_reg"	"classification"	"glmer"	"multilevelmod"
 "logistic_reg"	"classification"	"glmnet"	NA
 "logistic_reg"	"classification"	"h2o"	"agua"
 "logistic_reg"	"classification"	"keras"	NA
-"logistic_reg"	"classification"	"LiblineaR"	NA
 "logistic_reg"	"classification"	"spark"	NA
 "logistic_reg"	"classification"	"stan"	NA
 "logistic_reg"	"classification"	"stan_glmer"	"multilevelmod"
 "mars"	"classification"	"earth"	NA
 "mars"	"regression"	"earth"	NA
 "mlp"	"classification"	"brulee"	NA
+"mlp"	"classification"	"brulee_two_layer"	NA
 "mlp"	"classification"	"h2o"	"agua"
 "mlp"	"classification"	"keras"	NA
 "mlp"	"classification"	"nnet"	NA
 "mlp"	"regression"	"brulee"	NA
+"mlp"	"regression"	"brulee_two_layer"	NA
 "mlp"	"regression"	"h2o"	"agua"
 "mlp"	"regression"	"keras"	NA
 "mlp"	"regression"	"nnet"	NA
@@ -128,10 +130,10 @@
 "survival_reg"	"censored regression"	"flexsurv"	"censored"
 "survival_reg"	"censored regression"	"flexsurvspline"	"censored"
 "survival_reg"	"censored regression"	"survival"	"censored"
-"svm_linear"	"classification"	"kernlab"	NA
 "svm_linear"	"classification"	"LiblineaR"	NA
-"svm_linear"	"regression"	"kernlab"	NA
+"svm_linear"	"classification"	"kernlab"	NA
 "svm_linear"	"regression"	"LiblineaR"	NA
+"svm_linear"	"regression"	"kernlab"	NA
 "svm_poly"	"classification"	"kernlab"	NA
 "svm_poly"	"regression"	"kernlab"	NA
 "svm_rbf"	"classification"	"kernlab"	NA