various small things

R/cluster_spec.R

@@ -8,7 +8,7 @@
 #' @rdname add_on_exports
 new_cluster_spec <- function(cls, args, eng_args, mode, method, engine) {
 
-  #check_spec_mode_engine_val(cls, engine, mode)
+  check_spec_mode_engine_val(cls, engine, mode)
 
   out <- list(args = args, eng_args = eng_args,
               mode = mode, method = method, engine = engine)

R/convert_data.R

@@ -1,5 +1,3 @@
-# ------------------------------------------------------------------------------
-
 #' Helper functions to convert between formula and matrix interface
 #'
 #' @description
@@ -117,7 +115,6 @@
   res
 }
 
-
 check_form_dots <- function(x) {
   good_args <- c("subset", "weights")
   good_names <- names(x) %in% good_args

R/engines.R

@@ -81,7 +81,6 @@ set_engine_celery <- function(object, engine, ...) {
   )
 }
 
-
 stop_missing_engine <- function(cls) {
   info <-
     get_from_env_celery(cls) %>%

R/fit.R

@@ -88,88 +88,86 @@
 #' @rdname fit
 #' @export
 #' @export fit.cluster_spec
-fit.cluster_spec <-
-  function(object,
-           formula,
-           data,
-           control = control_celery(),
-           ...
-  ) {
-    if (object$mode == "unknown") {
-      rlang::abort("Please set the mode in the model specification.")
-    }
-    if (!identical(class(control), class(control_celery()))) {
-      rlang::abort("The 'control' argument should have class 'control_celery'.")
-    }
-    dots <- quos(...)
-    if (is.null(object$engine)) {
-      eng_vals <- possible_engines(object)
-      object$engine <- eng_vals[1]
-      if (control$verbosity > 0) {
-        rlang::warn(glue::glue("Engine set to `{object$engine}`."))
-      }
+fit.cluster_spec <- function(object,
+                             formula,
+                             data,
+                             control = control_celery(),
+                             ...) {
+  if (object$mode == "unknown") {
+    rlang::abort("Please set the mode in the model specification.")
+  }
+  if (!identical(class(control), class(control_celery()))) {
+    rlang::abort("The 'control' argument should have class 'control_celery'.")
+  }
+  dots <- quos(...)
+  if (is.null(object$engine)) {
+    eng_vals <- possible_engines(object)
+    object$engine <- eng_vals[1]
+    if (control$verbosity > 0) {
+      rlang::warn(glue::glue("Engine set to `{object$engine}`."))
     }
-
-    if (all(c("x", "y") %in% names(dots)))
-      rlang::abort("`fit.cluster_spec()` is for the formula methods. Use `fit_x()` instead.")
-    cl <- match.call(expand.dots = TRUE)
-    # Create an environment with the evaluated argument objects. This will be
-    # used when a model call is made later.
-    eval_env <- rlang::env()
-
-    eval_env$data <- data
-    eval_env$formula <- formula
-    fit_interface <-
-      check_interface(eval_env$formula, eval_env$data, cl, object)
-
-    # populate `method` with the details for this model type
-    object <- add_methods(object, engine = object$engine)
-
-    check_installs(object)
-
-    interfaces <- paste(fit_interface, object$method$fit$interface, sep = "_")
-
-    # Now call the wrappers that transition between the interface
-    # called here ("fit" interface) that will direct traffic to
-    # what the underlying model uses. For example, if a formula is
-    # used here, `fit_interface_formula` will determine if a
-    # translation has to be made if the model interface is x/y/
-    res <-
-      switch(
-        interfaces,
-        # homogeneous combinations:
-        formula_formula =
-          form_form(
-            object = object,
-            control = control,
-            env = eval_env
-          ),
-
-        # heterogenous combinations
-        formula_matrix =
-          form_x(
-            object = object,
-            control = control,
-            env = eval_env,
-            target = object$method$fit$interface,
-            ...
-          ),
-        formula_data.frame =
-          form_x(
-            object = object,
-            control = control,
-            env = eval_env,
-            target = object$method$fit$interface,
-            ...
-          ),
-
-        rlang::abort(glue::glue("{interfaces} is unknown."))
-      )
-    model_classes <- class(res$fit)
-    class(res) <- c(paste0("_", model_classes[1]), "cluster_fit")
-    res
   }
 
+  if (all(c("x", "y") %in% names(dots)))
+    rlang::abort("`fit.cluster_spec()` is for the formula methods. Use `fit_x()` instead.")
+  cl <- match.call(expand.dots = TRUE)
+  # Create an environment with the evaluated argument objects. This will be
+  # used when a model call is made later.
+  eval_env <- rlang::env()
+
+  eval_env$data <- data
+  eval_env$formula <- formula
+  fit_interface <-
+    check_interface(eval_env$formula, eval_env$data, cl, object)
+
+  # populate `method` with the details for this model type
+  object <- add_methods(object, engine = object$engine)
+
+  check_installs(object)
+
+  interfaces <- paste(fit_interface, object$method$fit$interface, sep = "_")
+
+  # Now call the wrappers that transition between the interface
+  # called here ("fit" interface) that will direct traffic to
+  # what the underlying model uses. For example, if a formula is
+  # used here, `fit_interface_formula` will determine if a
+  # translation has to be made if the model interface is x/y/
+  res <-
+    switch(
+      interfaces,
+      # homogeneous combinations:
+      formula_formula =
+        form_form(
+          object = object,
+          control = control,
+          env = eval_env
+        ),
+
+      # heterogenous combinations
+      formula_matrix =
+        form_x(
+          object = object,
+          control = control,
+          env = eval_env,
+          target = object$method$fit$interface,
+          ...
+        ),
+      formula_data.frame =
+        form_x(
+          object = object,
+          control = control,
+          env = eval_env,
+          target = object$method$fit$interface,
+          ...
+        ),
+
+      rlang::abort(glue::glue("{interfaces} is unknown."))
+    )
+  model_classes <- class(res$fit)
+  class(res) <- c(paste0("_", model_classes[1]), "cluster_fit")
+  res
+}
+
 check_interface <- function(formula, data, cl, model) {
   inher(formula, "formula", cl)
 
@@ -244,82 +242,78 @@ fit_x <- function(object, ...) {
 #' @export
 #' @export fit_x.cluster_spec
 fit_x.cluster_spec <-
-  function(object,
-           x,
-           control = control_celery(),
-           ...
-  ) {
-
-    if (!identical(class(control), class(control_celery()))) {
-      rlang::abort("The 'control' argument should have class 'control_celery'.")
-    }
-    if (is.null(colnames(x))) {
-      rlang::abort("'x' should have column names.")
-    }
+  function(object, x, control = control_celery(), ...) {
 
-    dots <- quos(...)
-    if (is.null(object$engine)) {
-      eng_vals <- possible_engines(object)
-      object$engine <- eng_vals[1]
-      if (control$verbosity > 0) {
-        rlang::warn(glue::glue("Engine set to `{object$engine}`."))
-      }
-    }
+  if (!identical(class(control), class(control_celery()))) {
+    rlang::abort("The 'control' argument should have class 'control_celery'.")
+  }
+  if (is.null(colnames(x))) {
+    rlang::abort("'x' should have column names.")
+  }
 
-    cl <- match.call(expand.dots = TRUE)
-    eval_env <- rlang::env()
-    eval_env$x <- x
-    fit_interface <- check_x_interface(eval_env$x, cl, object)
-
-    # populate `method` with the details for this model type
-    object <- add_methods(object, engine = object$engine)
-
-    check_installs(object)
-
-    interfaces <- paste(fit_interface, object$method$fit$interface, sep = "_")
-
-    # Now call the wrappers that transition between the interface
-    # called here ("fit" interface) that will direct traffic to
-    # what the underlying model uses. For example, if a formula is
-    # used here, `fit_interface_formula` will determine if a
-    # translation has to be made if the model interface is x/y/
-    res <-
-      switch(
-        interfaces,
-        # homogeneous combinations:
-        matrix_matrix = , data.frame_matrix =
-          x_x(
-            object = object,
-            env = eval_env,
-            control = control,
-            target = "matrix",
-            ...
-          ),
-
-        data.frame_data.frame = , matrix_data.frame =
-          x_x(
-            object = object,
-            env = eval_env,
-            control = control,
-            target = "data.frame",
-            ...
-          ),
-
-        # heterogenous combinations
-        matrix_formula = ,  data.frame_formula =
-          x_form(
-            object = object,
-            env = eval_env,
-            control = control,
-            ...
-          ),
-        rlang::abort(glue::glue("{interfaces} is unknown."))
-      )
-    model_classes <- class(res$fit)
-    class(res) <- c(paste0("_", model_classes[1]), "model_fit")
-    res
+  dots <- quos(...)
+  if (is.null(object$engine)) {
+    eng_vals <- possible_engines(object)
+    object$engine <- eng_vals[1]
+    if (control$verbosity > 0) {
+      rlang::warn(glue::glue("Engine set to `{object$engine}`."))
+    }
   }
 
+  cl <- match.call(expand.dots = TRUE)
+  eval_env <- rlang::env()
+  eval_env$x <- x
+  fit_interface <- check_x_interface(eval_env$x, cl, object)
+
+  # populate `method` with the details for this model type
+  object <- add_methods(object, engine = object$engine)
+
+  check_installs(object)
+
+  interfaces <- paste(fit_interface, object$method$fit$interface, sep = "_")
+
+  # Now call the wrappers that transition between the interface
+  # called here ("fit" interface) that will direct traffic to
+  # what the underlying model uses. For example, if a formula is
+  # used here, `fit_interface_formula` will determine if a
+  # translation has to be made if the model interface is x/y/
+  res <-
+    switch(
+      interfaces,
+      # homogeneous combinations:
+      matrix_matrix = , data.frame_matrix =
+        x_x(
+          object = object,
+          env = eval_env,
+          control = control,
+          target = "matrix",
+          ...
+        ),
+
+      data.frame_data.frame = , matrix_data.frame =
+        x_x(
+          object = object,
+          env = eval_env,
+          control = control,
+          target = "data.frame",
+          ...
+        ),
+
+      # heterogenous combinations
+      matrix_formula = ,  data.frame_formula =
+        x_form(
+          object = object,
+          env = eval_env,
+          control = control,
+          ...
+        ),
+      rlang::abort(glue::glue("{interfaces} is unknown."))
+    )
+  model_classes <- class(res$fit)
+  class(res) <- c(paste0("_", model_classes[1]), "model_fit")
+  res
+}
+
 check_x_interface <- function(x, cl, model) {
 
   sparse_ok <- allow_sparse(model)

R/misc.R

@@ -7,39 +7,3 @@ check_args <- function(object) {
 check_args.default <- function(object) {
   invisible(object)
 }
-
-#' Check to ensure that ellipses are empty
-#' @param ... Extra arguments.
-#' @return If an error is not thrown (from non-empty ellipses), a NULL list.
-#' @keywords internal
-#' @export
-check_empty_ellipse_celery <- function (...)  {
-  terms <- quos(...)
-  if (!rlang::is_empty(terms))
-    rlang::abort("Please pass other arguments to the model function via `set_engine_celery()`.")
-  terms
-}
-
-convert_arg <- function(x) {
-  if (rlang::is_quosure(x))
-    rlang::quo_get_expr(x)
-  else
-    x
-}
-
-print_arg_list <- function(x, ...) {
-  atomic <- vapply(x, is.atomic, logical(1))
-  x2 <- x
-  x2[!atomic] <-  lapply(x2[!atomic], deparserizer, ...)
-  res <- paste0("  ", names(x2), " = ", x2, collaspe = "\n")
-  cat(res, sep = "")
-}
-
-deparserizer <- function(x, limit = options()$width - 10) {
-  x <- deparse(x, width.cutoff = limit)
-  x <- gsub("^    ", "", x)
-  x <- paste0(x, collapse = "")
-  if (nchar(x) > limit)
-    x <- paste0(substring(x, first = 1, last = limit - 7), "<snip>")
-  x
-}