moved ancillary functions to another file

Author: topepo

R/fit.R

@@ -141,253 +141,6 @@ fit.model_spec <-
 
 ###################################################################
 
-#' @importFrom stats as.formula
-fit_formula <- function(object, formula, data, engine = engine, control, ...) {
-  opts <- quos(...)
-  # Look up the model's interface (e.g. formula, recipes, etc)
-  # and delegate to the connector functions (`formula_to_recipe` etc)
-  if(object$method$interface %in% c("formula", "spark")) {
-    fit_args <- object$method$fit_args
-    fit_args <- resolve_args(fit_args, env = current_env())
-
-    if (object$method$interface == "formula") {
-      fit_args$data <- data
-    } else {
-      if (object$method$interface == "spark")
-        fit_args$x <- data
-    }
-    fit_args$formula <- formula
-
-    fit_call <- make_call(
-      fun = object$method$fit_name["fun"],
-      ns = object$method$fit_name["pkg"],
-      fit_args
-    )
-
-    res <-
-      eval_mod(
-        fit_call,
-        capture = control$verbosity == 0,
-        catch = control$catch,
-        env = current_env()
-      )
-  } else {
-    if(object$method$interface %in% c("data.frame", "matrix", "spark")) {
-      res <- formula_to_xy(object = object, formula = formula, data = data, control)
-    } else {
-      stop("I don't know about the ",
-           object$method$interface, " interface.",
-           call. = FALSE)
-    }
-  }
-  res
-}
-
-# TODO find a hook for whether to make dummies or not. Test cases
-# are all numeric. Solve via the fit the method object via entry for
-# `requires_dummies`
-
-#' @importFrom  stats model.frame model.response terms
-formula_to_xy <- function(object, formula, data, control) {
-  # Q: how do we fill in the other standard things here (subset, contrasts etc)?
-  # Q: add a "matrix" option here and invoke model.matrix
-  x <- stats::model.frame(eval(formula), eval(data))
-  y <- model.response(x)
-
-  # Remove outcome column(s) from `x`
-  outcome_cols <- attr(terms(x), "response")
-  if (!isTRUE(all.equal(outcome_cols, 0))) {
-    x <- x[,-outcome_cols, drop = FALSE]
-  }
-
-  object$method$fit_args[["x"]] <- quote(x)
-  object$method$fit_args[["y"]] <- quote(y)
-
-  fit_call <- make_call(
-    fun = object$method$fit_name["fun"],
-    ns = object$method$fit_name["pkg"],
-    object$method$fit_args
-  )
-
-  eval_mod(
-    fit_call,
-    capture = control$verbosity == 0,
-    catch = control$catch,
-    env = current_env()
-  )
-}
-
-###################################################################
-
-fit_xy <- function(object, x, y, control, ...) {
-  opts <- quos(...)
-
-  if (inherits(x, "tbl_spark") | inherits(y, "tbl_spark"))
-    stop("spark objects must be fit with the formula interface to `fit`",
-         call. = FALSE)
-
-  res <- switch(
-    object$method$interface,
-    formula = xy_to_formula(object = object, x = x, y = y, control, ...),
-    matrix = xy_to_matrix(object = object, x = x, y = y, control, ...),
-    data.frame = xy_to_df(object = object, x = x, y = y, control, ...),
-    stop("Unknown interface")
-  )
-  res
-}
-
-xy_to_xy <- function(object, x, y, control, ...) {
-  fit_args <- object$method$fit_args
-
-  fit_args <- resolve_args(fit_args, env = current_env())
-
-  fit_args[["x"]] <- quote(x)
-  fit_args[["y"]] <- quote(y)
-
-  fit_call <- make_call(
-    fun = object$method$fit_name["fun"],
-    ns = object$method$fit_name["pkg"],
-    fit_args
-  )
-
-  eval_mod(
-    fit_call,
-    capture = control$verbosity == 0,
-    catch = control$catch,
-    env = current_env()
-  )
-}
-xy_to_matrix <- function(object, x, y, control, ...) {
-  if (object$method$interface == "matrix" && !is.matrix(x))
-    x <- as.matrix(x)
-  xy_to_xy(object, x, y, control, ...)
-}
-xy_to_df <- function(object, x, y, control, ...) {
-  if (object$method$interface == "data.frame" && !is.data.frame(x))
-    x <- as.data.frame(x)
-  xy_to_xy(object, x, y, control, ...)
-}
-
-
-fit_recipe <- function(object, recipe, data, control, ...) {
-  opts <- quos(...)
-
-  # Look up the model's interface (e.g. formula, recipes, etc)
-  # and delegate to the connector functions (`recipe_to_formula` etc)
-  if(object$method$interface == "formula") {
-    res <- recipe_to_formula(object = object, recipe = recipe, data = data, control)
-  } else {
-    if(object$method$interface %in% c("data.frame", "matrix")) {
-      res <- recipe_to_xy(object = object, recipe = recipe, data = data, control)
-    } else {
-      stop("I don't know about the ",
-           object$method$interface, " interface.",
-           call. = FALSE)
-    }
-  }
-  res
-
-}
-
-
-#placeholder
-fit_spark <- function(object, remote, engine = engine, control, ...) {
-  NULL
-}
-
-### or.... let `data, `x` and `y` be remote spark data tables or specifications
-
-invoke2 <- function(.f, envir = parent.frame(), ...) {
-
-  dots <- dots_values(...)
-  do.call(.f, dots, envir = envir)
-}
-
-###################################################################
-
-formula_to_recipe <- function(object, formula, data, control) {
-  # execute the formula
-  # extract terms _and roles_
-  # put into recipe
-
-}
-
-###################################################################
-
-#' @importFrom recipes prep juice all_predictors all_outcomes
-recipe_to_formula <- function(object, recipe, data, control) {
-  # TODO case weights
-  recipe <-
-    prep(recipe, training = data, retain = TRUE, verbose = control$verbosity > 1)
-  dat <- juice(recipe, all_predictors(), all_outcomes())
-  dat <- as.data.frame(dat)
-
-  data_info <- summary(recipe)
-  y_names <- data_info$variable[data_info$role == "outcome"]
-  if (length(y_names) > 1)
-    y_names <-
-    paste0("cbind(", paste0(y_names, collapse = ","), ")")
-
-  fit_args <- object$method$fit_args
-  fit_args$formula <- as.formula(paste0(y_names, "~."))
-  fit_args$data <- quote(dat)
-  eval_mod(
-    fit_args,
-    capture = control$verbosity == 0,
-    catch = control$catch,
-    env = current_env()
-  )
-}
-
-recipe_to_xy <- function(object, recipe, data, control) {
-  # TODO case weights
-  recipe <-
-    prep(recipe, training = data, retain = TRUE, verbose = control$verbosity > 1)
-
-  x <- juice(recipe, all_predictors())
-  x <- as.data.frame(x)
-  y <- juice(recipe, all_outcomes())
-  if (ncol(y) > 1)
-    y <- as.data.frame(y)
-  else
-    y <- y[[1]]
-
-  fit_args <- object$method$fit_args
-
-  fit_args[["x"]] <- quote(x)
-  fit_args[["y"]] <- quote(y)
-
-  eval_mod(
-    fit_args,
-    capture = control$verbosity == 0,
-    catch = control$catch,
-    env = current_env()
-  )
-}
-
-###################################################################
-
-xy_to_formula <- function(object, x, y, control) {
-  if(!is.data.frame(x))
-    x <- as.data.frame(x)
-  x$.y <- y
-  fit_args <- object$method$fit_args
-  fit_args$formula <- as.formula(.y ~ .)
-  fit_args$data <- quote(x)
-  fit_call <- make_call(
-    fun = object$method$fit_name["fun"],
-    ns = object$method$fit_name["pkg"],
-    fit_args
-  )
-  eval_tidy(fit_call, env = current_env())
-}
-
-xy_to_recipe <- function(object, x, y, control) {
-
-}
-
-###################################################################
-
 #' @importFrom utils capture.output
 eval_mod <- function(e, capture = FALSE, catch = FALSE, ...) {
   if (capture) {