air whole package

Author: EmilHvitfeldt

R/aaa.R

@@ -3,17 +3,47 @@
 
 utils::globalVariables(
   c(
-    ".", "..object", ".cluster", ".iter_config", ".iter_model",
-    ".iter_preprocessor", ".msg_model", ".submodels", "call_info", "cluster",
-    "component", "component_id", "compute_intercept", "data", "dist", "engine",
-    "engine2", "exposed", "func", "id", "iteration", "lab", "name", "neighbor",
-    "new_data", "object", "orig_label", "original", "predictor_indicators",
-    "remove_intercept", "seed", "sil_width", "splits", "tunable", "type",
-    "value", "x", "y"
+    ".",
+    "..object",
+    ".cluster",
+    ".iter_config",
+    ".iter_model",
+    ".iter_preprocessor",
+    ".msg_model",
+    ".submodels",
+    "call_info",
+    "cluster",
+    "component",
+    "component_id",
+    "compute_intercept",
+    "data",
+    "dist",
+    "engine",
+    "engine2",
+    "exposed",
+    "func",
+    "id",
+    "iteration",
+    "lab",
+    "name",
+    "neighbor",
+    "new_data",
+    "object",
+    "orig_label",
+    "original",
+    "predictor_indicators",
+    "remove_intercept",
+    "seed",
+    "sil_width",
+    "splits",
+    "tunable",
+    "type",
+    "value",
+    "x",
+    "y"
   )
 )
 
-
 release_bullets <- function() {
   c(
     "Run `knit_engine_docs()` and `devtools::document()` to update docs"

R/append.R

@@ -1,9 +1,11 @@
 # https://github.com/tidymodels/tune/blob/main/R/pull.R#L136
-append_predictions <- function(collection,
-                               predictions,
-                               split,
-                               control,
-                               .config = NULL) {
+append_predictions <- function(
+  collection,
+  predictions,
+  split,
+  control,
+  .config = NULL
+) {
   if (!control$save_pred) {
     return(NULL)
   }
@@ -27,14 +29,16 @@ append_predictions <- function(collection,
   dplyr::bind_rows(collection, predictions)
 }
 
-append_metrics <- function(workflow,
-                           collection,
-                           predictions,
-                           metrics,
-                           param_names,
-                           event_level,
-                           split,
-                           .config = NULL) {
+append_metrics <- function(
+  workflow,
+  collection,
+  predictions,
+  metrics,
+  param_names,
+  event_level,
+  split,
+  .config = NULL
+) {
   if (inherits(predictions, "try-error")) {
     return(collection)
   }
@@ -54,20 +58,22 @@ append_metrics <- function(workflow,
   dplyr::bind_rows(collection, tmp_est)
 }
 
-append_extracts <- function(collection,
-                            workflow,
-                            grid,
-                            split,
-                            ctrl,
-                            .config = NULL) {
+append_extracts <- function(
+  collection,
+  workflow,
+  grid,
+  split,
+  ctrl,
+  .config = NULL
+) {
   extracts <-
     grid %>%
-    dplyr::bind_cols(labels(split)) %>%
-    dplyr::mutate(
-      .extracts = list(
-        extract_details(workflow, ctrl$extract)
+      dplyr::bind_cols(labels(split)) %>%
+      dplyr::mutate(
+        .extracts = list(
+          extract_details(workflow, ctrl$extract)
+        )
       )
-    )
 
   if (!rlang::is_null(.config)) {
     extracts <- cbind(extracts, .config)

R/arguments.R

@@ -8,10 +8,12 @@ check_eng_args <- function(args, obj, core_args) {
   if (length(common_args) > 0) {
     args <- args[!(names(args) %in% common_args)]
     common_args <- paste0(common_args, collapse = ", ")
-    rlang::warn(glue::glue(
-      "The following arguments cannot be manually modified ",
-      "and were removed: {common_args}."
-    ))
+    rlang::warn(
+      glue::glue(
+        "The following arguments cannot be manually modified ",
+        "and were removed: {common_args}."
+      )
+    )
   }
   args
 }
@@ -25,7 +27,8 @@ make_x_call <- function(object, target) {
   }
 
   object$method$fit$args[[unname(data_args["x"])]] <-
-    switch(target,
+    switch(
+      target,
       none = rlang::expr(x),
       data.frame = rlang::expr(maybe_data_frame(x)),
       matrix = rlang::expr(maybe_matrix(x)),

R/cluster_spec.R

@@ -11,15 +11,18 @@
 #' @keywords internal
 new_cluster_spec <- function(cls, args, eng_args, mode, method, engine) {
   modelenv::check_spec_mode_engine_val(
-    model = cls, 
+    model = cls,
     mode = mode,
     eng = engine,
     call = rlang::caller_env()
   )
 
   out <- list(
-    args = args, eng_args = eng_args,
-    mode = mode, method = method, engine = engine
+    args = args,
+    eng_args = eng_args,
+    mode = mode,
+    method = method,
+    engine = engine
   )
   class(out) <- make_classes_tidyclust(cls)
   out <- modelenv::new_unsupervised_spec(out)

R/compat-purrr.R

@@ -79,11 +79,16 @@ imap <- function(.x, .f, ...) {
 pmap <- function(.l, .f, ...) {
   .f <- as.function(.f)
   args <- .rlang_purrr_args_recycle(.l)
-  do.call("mapply", c(
-    FUN = list(quote(.f)),
-    args, MoreArgs = quote(list(...)),
-    SIMPLIFY = FALSE, USE.NAMES = FALSE
-  ))
+  do.call(
+    "mapply",
+    c(
+      FUN = list(quote(.f)),
+      args,
+      MoreArgs = quote(list(...)),
+      SIMPLIFY = FALSE,
+      USE.NAMES = FALSE
+    )
+  )
 }
 .rlang_purrr_args_recycle <- function(args) {
   lengths <- map_int(args, length)

R/convert_data.R

@@ -32,13 +32,15 @@
 #' @inheritParams fit.cluster_spec
 #' @rdname convert_helpers
 #' @keywords internal
-.convert_form_to_x_fit <- function(formula,
-                                   data,
-                                   ...,
-                                   na.action = na.omit,
-                                   indicators = "traditional",
-                                   composition = "data.frame",
-                                   remove_intercept = TRUE) {
+.convert_form_to_x_fit <- function(
+  formula,
+  data,
+  ...,
+  na.action = na.omit,
+  indicators = "traditional",
+  composition = "data.frame",
+  remove_intercept = TRUE
+) {
   if (!(composition %in% c("data.frame", "matrix"))) {
     rlang::abort("`composition` should be either 'data.frame' or 'matrix'.")
   }
@@ -155,9 +157,7 @@ local_one_hot_contrasts <- function(frame = rlang::caller_env()) {
 #' @inheritParams .convert_form_to_x_fit
 #' @rdname convert_helpers
 #' @keywords internal
-.convert_x_to_form_fit <- function(x,
-                                   weights = NULL,
-                                   remove_intercept = TRUE) {
+.convert_x_to_form_fit <- function(x, weights = NULL, remove_intercept = TRUE) {
   if (is.vector(x)) {
     rlang::abort("`x` cannot be a vector.")
   }
@@ -212,10 +212,12 @@ make_formula <- function(x, short = TRUE) {
 #' @inheritParams predict.cluster_fit
 #' @rdname convert_helpers
 #' @keywords internal
-.convert_form_to_x_new <- function(object,
-                                   new_data,
-                                   na.action = stats::na.pass,
-                                   composition = "data.frame") {
+.convert_form_to_x_new <- function(
+  object,
+  new_data,
+  na.action = stats::na.pass,
+  composition = "data.frame"
+) {
   if (!(composition %in% c("data.frame", "matrix"))) {
     rlang::abort("`composition` should be either 'data.frame' or 'matrix'.")
   }

R/dials-params.R

@@ -40,6 +40,12 @@ linkage_method <- function(values = values_linkage_method) {
 #' @rdname linkage_method
 #' @export
 values_linkage_method <- c(
-  "ward.D", "ward.D2", "single", "complete", "average", "mcquitty", "median",
+  "ward.D",
+  "ward.D2",
+  "single",
+  "complete",
+  "average",
+  "mcquitty",
+  "median",
   "centroid"
 )

R/engine_docs.R

@@ -19,17 +19,17 @@ knit_engine_docs <- function(pattern = NULL) {
   }
   outputs <- gsub("Rmd$", "md", files)
 
-  res <- map2(files, outputs, ~ try(knitr::knit(.x, .y), silent = TRUE))
-  is_error <- map_lgl(res, ~ inherits(.x, "try-error"))
+  res <- map2(files, outputs, ~try(knitr::knit(.x, .y), silent = TRUE))
+  is_error <- map_lgl(res, ~inherits(.x, "try-error"))
 
   if (any(is_error)) {
     # In some cases where there are issues, the md file is empty.
     errors <- res[which(is_error)]
     error_nms <- basename(files)[which(is_error)]
     errors <-
-      map_chr(errors, ~ cli::ansi_strip(as.character(.x))) %>%
-      map2_chr(error_nms, ~ paste0(.y, ": ", .x)) %>%
-      map_chr(~ gsub("Error in .f(.x[[i]], ...) :", "", .x, fixed = TRUE))
+      map_chr(errors, ~cli::ansi_strip(as.character(.x))) %>%
+        map2_chr(error_nms, ~paste0(.y, ": ", .x)) %>%
+        map_chr(~gsub("Error in .f(.x[[i]], ...) :", "", .x, fixed = TRUE))
     cat("There were failures duing knitting:\n\n")
     cat(errors)
     cat("\n\n")

R/engines.R

@@ -31,15 +31,16 @@ set_engine.cluster_spec <- function(object, engine, ...) {
 stop_missing_engine <- function(cls, call = rlang::caller_env()) {
   info <-
     modelenv::get_from_env(cls) %>%
-    dplyr::group_by(mode) %>%
-    dplyr::summarize(
-      msg = paste0(
-        unique(mode), " {",
-        paste0(unique(engine), collapse = ", "),
-        "}"
-      ),
-      .groups = "drop"
-    )
+      dplyr::group_by(mode) %>%
+      dplyr::summarize(
+        msg = paste0(
+          unique(mode),
+          " {",
+          paste0(unique(engine), collapse = ", "),
+          "}"
+        ),
+        .groups = "drop"
+      )
   if (nrow(info) == 0) {
     rlang::abort(glue::glue("No known engines for `{cls}()`."), call = call)
   }

R/extract_cluster_assignment.R

@@ -111,9 +111,11 @@ extract_cluster_assignment.kmodes <- function(object, ...) {
 }
 
 #' @export
-extract_cluster_assignment.hclust <- function(object,
-                                              ...,
-                                              call = rlang::caller_env(0)) {
+extract_cluster_assignment.hclust <- function(
+  object,
+  ...,
+  call = rlang::caller_env(0)
+) {
   # if k or h is passed in the dots, use those.  Otherwise, use attributes
   # from original model specification
   args <- list(...)
@@ -159,10 +161,12 @@ extract_cluster_assignment.hclust <- function(object,
 
 # ------------------------------------------------------------------------------
 
-cluster_assignment_tibble <- function(clusters,
-                                      n_clusters,
-                                      ...,
-                                      prefix = "Cluster_") {
+cluster_assignment_tibble <- function(
+  clusters,
+  n_clusters,
+  ...,
+  prefix = "Cluster_"
+) {
   reorder_clusts <- order(union(unique(clusters), seq_len(n_clusters)))
   names <- paste0(prefix, seq_len(n_clusters))
   res <- names[reorder_clusts][clusters]