Merge pull request #92 from tidymodels/RC0.1.0

Rc0.1.0

Author: EmilHvitfeldt

.Rbuildignore

@@ -10,3 +10,5 @@
 ^\.github$
 ^dev$
 ^vignettes/articles$
+^cran-comments\.md$
+^CRAN-SUBMISSION$

DESCRIPTION

@@ -1,14 +1,14 @@
 Package: tidyclust
 Title: A Common API to Clustering
-Version: 0.0.0.9000
+Version: 0.1.0
 Authors@R: c(
     person("Emil", "Hvitfeldt", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-0679-1945")),
     person("Kelly", "Bodwin", , "[email protected]", role = "aut"),
-    person("RStudio", role = c("cph", "fnd"))
+    person("Posit Software, PBC.", role = c("cph", "fnd"))
   )
 Description: A common interface to specifying clustering models, in the
-    same style as `parsnip`. Creates unified interface across different
+    same style as 'parsnip'. Creates unified interface across different
     functions and computational engines.
 License: MIT + file LICENSE
 URL: https://github.com/tidymodels/tidyclust
@@ -45,8 +45,6 @@ Suggests:
     rmarkdown,
     testthat (>= 3.0.0),
     workflows (>= 1.1.2)
-VignetteBuilder: 
-    knitr
 Config/Needs/website: pkgdown, tidymodels, tidyverse, palmerpenguins,
     patchwork, ggforce
 Config/testthat/edition: 3

NAMESPACE

@@ -49,13 +49,8 @@ S3method(tune_cluster,workflow)
 S3method(update,hier_clust)
 S3method(update,k_means)
 export("%>%")
-export(.convert_form_to_x_fit)
-export(.convert_form_to_x_new)
-export(.convert_x_to_form_fit)
-export(.convert_x_to_form_new)
 export(ClusterR_kmeans_fit)
 export(augment)
-export(check_empty_ellipse_tidyclust)
 export(cluster_metric_set)
 export(control_cluster)
 export(extract_centroids)

R/arguments.R

@@ -65,6 +65,10 @@ make_form_call <- function(object, env = NULL) {
   fit_call
 }
 
+#' Change arguments of a cluster specification
+#'
+#' @inheritParams parsnip::set_args
+#' @return An updated `cluster_spec` object.
 #' @export
 set_args.cluster_spec <- function(object, ...) {
   the_dots <- enquos(...)
@@ -90,6 +94,10 @@ set_args.cluster_spec <- function(object, ...) {
   )
 }
 
+#' Change mode of a cluster specification
+#'
+#' @inheritParams parsnip::set_mode
+#' @return An updated `cluster_spec` object.
 #' @export
 set_mode.cluster_spec <- function(object, mode) {
   cls <- class(object)[1]

R/augment.R

@@ -9,6 +9,8 @@
 #' @param new_data A data frame or matrix.
 #' @param ... Not currently used.
 #' @rdname augment
+#' @return A `tibble::tibble()` with containing `new_data` with columns added
+#'   depending on the mode of the model.
 #' @examples
 #' kmeans_spec <- k_means(num_clusters = 5) %>%
 #'   set_engine("stats")

R/cluster_spec.R

@@ -3,9 +3,10 @@
 #' These functions are helpful when creating new packages that will register new
 #' cluster specifications.
 #'
+#' @return A `cluster_spec` object made to work with tidyclust.
+#'
 #' @export
 #' @keywords internal
-#' @rdname add_on_exports
 new_cluster_spec <- function(cls, args, eng_args, mode, method, engine) {
   modelenv::check_spec_mode_engine_val(model = cls, mode = mode, eng = engine)
 

R/convert_data.R

@@ -30,7 +30,6 @@
 #' @inheritParams fit.cluster_spec
 #' @rdname convert_helpers
 #' @keywords internal
-#' @export
 .convert_form_to_x_fit <- function(formula,
                                    data,
                                    ...,
@@ -149,10 +148,8 @@ local_one_hot_contrasts <- function(frame = rlang::caller_env()) {
 #' @param weights A numeric vector containing the weights.
 #' @inheritParams fit.cluster_spec
 #' @inheritParams .convert_form_to_x_fit
-#'
 #' @rdname convert_helpers
 #' @keywords internal
-#' @export
 .convert_x_to_form_fit <- function(x,
                                    weights = NULL,
                                    remove_intercept = TRUE) {
@@ -210,7 +207,6 @@ make_formula <- function(x, short = TRUE) {
 #' @inheritParams predict.cluster_fit
 #' @rdname convert_helpers
 #' @keywords internal
-#' @export
 .convert_form_to_x_new <- function(object,
                                    new_data,
                                    na.action = stats::na.pass,
@@ -262,7 +258,6 @@ make_formula <- function(x, short = TRUE) {
 
 #' @rdname convert_helpers
 #' @keywords internal
-#' @export
 .convert_x_to_form_new <- function(object, new_data) {
   new_data <- new_data[, object$x_var, drop = FALSE]
   if (!is.data.frame(new_data)) {

R/engines.R

@@ -1,3 +1,7 @@
+#' Change engine of a cluster specification
+#'
+#' @inheritParams parsnip::set_engine
+#' @return An updated `cluster_spec` object.
 #' @export
 set_engine.cluster_spec <- function(object, engine, ...) {
   mod_type <- class(object)[1]

R/extract.R

@@ -1,3 +1,50 @@
+#' Extract elements of a tidyclust model object
+#'
+#' @description
+#' These functions extract various elements from a clustering object. If they do
+#' not exist yet, an error is thrown.
+#'
+#' - `extract_fit_engine()` returns the engine specific fit embedded within
+#'   a tidyclust model fit. For example, when using [tidyclust::k_means()]
+#'   with the `"lm"` engine, this returns the underlying `kmeans` object.
+#'
+#' - `extract_parameter_set_dials()` returns a set of dials parameter objects.
+#'
+#' @param x A `cluster_fit` object or a `cluster_spec` object.
+#' @param ... Not currently used.
+#' @details
+#' Extracting the underlying engine fit can be helpful for describing the
+#'  model (via `print()`, `summary()`, `plot()`, etc.) or for variable
+#'  importance/explainers.
+#'
+#'  However, users should not invoke the `predict()` method on an extracted
+#'  model. There may be preprocessing operations that `tidyclust` has executed
+#'  on the data prior to giving it to the model. Bypassing these can lead to
+#'  errors or silently generating incorrect predictions.
+#'
+#' **Good**:
+#' ```r
+#'    tidyclust_fit %>% predict(new_data)
+#' ```
+#'
+#' **Bad**:
+#' ```r
+#'    tidyclust_fit %>% extract_fit_engine() %>% predict(new_data)
+#' ```
+#' @return
+#' The extracted value from the tidyclust object, `x`, as described in the
+#' description section.
+#'
+#' @name extract-tidyclust
+#' @examples
+#' kmeans_spec <- k_means(num_clusters = 2)
+#' kmeans_fit <- fit(kmeans_spec, ~ ., data = mtcars)
+#'
+#' extract_fit_engine(kmeans_fit)
+NULL
+
+
+#' @rdname extract-tidyclust
 #' @export
 extract_fit_engine.cluster_fit <- function (x, ...) {
   if (any(names(x) == "fit")) {

R/extract_assignment.R

@@ -3,6 +3,8 @@
 #' @param object An cluster_spec object.
 #' @param ... Other arguments passed to methods.
 #'
+#' @return A `tibble::tibble()` with 1 column `.cluster`.
+#'
 #' @examples
 #' kmeans_spec <- k_means(num_clusters = 5) %>%
 #'   set_engine("stats")

R/extract_characterization.R

@@ -3,6 +3,8 @@
 #' @param object An cluster_spec object.
 #' @param ... Other arguments passed to methods.
 #'
+#' @return A `tibble::tibble()` with 1 row for each centroid and their position.
+#'
 #' @examples
 #' set.seed(1234)
 #' kmeans_spec <- k_means(num_clusters = 5) %>%

R/extract_parameter_set_dials.R

@@ -1,3 +1,4 @@
+#' @rdname extract-tidyclust
 #' @export
 extract_parameter_set_dials.cluster_spec <- function(x, ...) {
   all_args <- generics::tunable(x)

R/fit.R

@@ -79,6 +79,7 @@
 #'   [hardhat::frequency_weights()] and [hardhat::importance_weights()] for
 #'   examples.
 #' @rdname fit
+#' @return A fitted `cluster_fit` object.
 #' @export
 #' @export fit.cluster_spec
 fit.cluster_spec <- function(object,

R/hier_clust.R

@@ -18,6 +18,8 @@
 #'   `"complete"`, `"average"` (= UPGMA), `"mcquitty"` (= WPGMA), `"median"` (=
 #'   WPGMC) or `"centroid"` (= UPGMC).
 #'
+#' @return A `hier_clust` cluster specification.
+#'
 #' @examples
 #' # Show all engines
 #' modelenv::get_from_env("hier_clust")

R/k_means.R

@@ -12,6 +12,8 @@
 #'   model is `"stats"`.
 #' @param num_clusters Positive integer, number of clusters in model.
 #'
+#' @return A `k_means` cluster specification.
+#'
 #' @examples
 #' # Show all engines
 #' modelenv::get_from_env("k_means")

R/load_ns.R

@@ -1,3 +1,12 @@
+#' Quietly load package namespace
+#'
+#' For one or more packages, load the namespace. This is used during parallel
+#' processing since the different parallel backends handle the package
+#' environments differently.
+#' @param x A character vector of packages.
+#' @param infra Should base tidymodels packages be loaded as well?
+#' @return An invisible NULL.
+#' @keywords internal
 #' @export
 load_pkgs.cluster_spec <- function(x, infra = TRUE, ...) {
   pkgs <- required_pkgs(x)

R/metric-aaa.R

@@ -7,6 +7,8 @@
 #'
 #' @param fn A function.
 #'
+#' @return A `cluster_metric` object.
+#'
 #' @param direction A string. One of:
 #'   - `"maximize"`
 #'   - `"minimize"`
@@ -34,13 +36,16 @@ new_cluster_metric <- function(fn, direction) {
 
 #' Combine metric functions
 #'
-#' `metric_set()` allows you to combine multiple metric functions together into
-#' a new function that calculates all of them at once.
+#' `cluster_metric_set()` allows you to combine multiple metric functions
+#' together into a new function that calculates all of them at once.
 #'
 #' @param ... The bare names of the functions to be included in the metric set.
 #'   These functions must be cluster metrics such as [sse_total()],
 #'   [sse_ratio()], or [silhouette_avg()].
 #'
+#' @return A `cluster_metric_set()` object, combining the use of all input
+#'   metrics.
+#'
 #' @details All functions must be:
 #' - Only cluster metrics
 #' @export

R/metric-sse.R

@@ -69,6 +69,8 @@ sse_within <- function(object, new_data = NULL,
 #' @details Not to be confused with [sse_within()] that returns a tibble
 #'   with within-cluster SSE, one row for each cluster.
 #'
+#' @return A tibble with 3 columns; `.metric`, `.estimator`, and `.estimate`.
+#'
 #' @family cluster metric
 #'
 #' @examples
@@ -131,6 +133,8 @@ sse_within_total_impl <- function(object, new_data = NULL,
 #'   to Euclidean distance on processed data.
 #' @param ... Other arguments passed to methods.
 #'
+#' @return A tibble with 3 columns; `.metric`, `.estimator`, and `.estimate`.
+#'
 #' @family cluster metric
 #'
 #' @examples
@@ -209,6 +213,8 @@ sse_total_impl <- function(object,
 #'   to Euclidean distance on processed data.
 #' @param ... Other arguments passed to methods.
 #'
+#' @return A tibble with 3 columns; `.metric`, `.estimator`, and `.estimate`.
+#'
 #' @family cluster metric
 #'
 #' @examples

R/predict_cluster.R

@@ -2,6 +2,8 @@
 #'
 #' These are internal functions not meant to be directly called by the user.
 #'
+#' @return A `tibble::tibble()`.
+#'
 #' @keywords internal
 #' @rdname other_predict
 #' @inheritParams predict_cluster.cluster_fit
@@ -11,6 +13,7 @@ predict_cluster <- function(object, ...) {
 }
 
 #' @keywords internal
+#' @return A `tibble::tibble()`.
 #' @rdname other_predict
 #' @inheritParams predict.cluster_fit
 #' @method predict_cluster cluster_fit

R/predict_helpers.R

@@ -7,9 +7,7 @@ stats_kmeans_predict <- function(object, new_data, prefix = "Cluster_") {
 }
 
 clusterR_kmeans_predict <- function(object, new_data, prefix = "Cluster_") {
-  res <- object$centroids[unique(object$clusters), , drop = FALSE]
-  res <- flexclust::dist2(res, new_data)
-  res <- apply(res, 2, which.min)
+  res <- predict(object, new_data)
   res <- paste0(prefix, res)
   factor(res)
 }

R/symbol.R

@@ -88,6 +88,7 @@ is_windows <- function() {
 #' Get colors for tidyclust text.
 #'
 #' @keywords internal
+#' @return a list of `cli` functions.
 #' @export
 #' @rdname empty_ellipses
 get_tidyclust_colors <- function() tidyclust_color

R/translate.R

@@ -2,7 +2,7 @@
 #'
 #' `translate_tidyclust()` will translate_tidyclust a model specification into a
 #' code object that is specific to a particular engine (e.g. R package). It
-#' translate_tidyclusts generic parameters to their counterparts.
+#' translate tidyclust generic parameters to their counterparts.
 #'
 #' @param x A model specification.
 #' @param engine The computational engine for the model (see `?set_engine`).
@@ -25,6 +25,8 @@
 #'   to understand what the underlying syntax would be. It should not be used to
 #'   modify the cluster specification.
 #'
+#' @return Prints translated code.
+#'
 #' @export
 translate_tidyclust <- function(x, ...) {
   UseMethod("translate_tidyclust")
@@ -142,11 +144,6 @@ deharmonize <- function(args, key) {
   args[!is.na(merged$original)]
 }
 
-#' 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_tidyclust <- function(...) {
   terms <- quos(...)
   if (!rlang::is_empty(terms)) {

R/tune_cluster.R

@@ -43,7 +43,7 @@
 #' grid <- tibble(num_clusters = 1:3)
 #'
 #' set.seed(4400)
-#' folds <- vfold_cv(mtcars)
+#' folds <- vfold_cv(mtcars, v = 2)
 #'
 #' res <- tune_cluster(
 #'   wflow,
@@ -326,15 +326,6 @@ tune_cluster_loop_iter <- function(split,
   load_pkgs(workflow)
   load_namespace(control$pkgs)
 
-  # After package loading to avoid potential package RNG manipulation
-  if (!is.null(seed)) {
-    # `assign()`-ing the random seed alters the `kind` type to L'Ecuyer-CMRG,
-    # so we have to ensure it is restored on exit
-    old_kind <- RNGkind()[[1]]
-    assign(".Random.seed", seed, envir = globalenv())
-    on.exit(RNGkind(kind = old_kind), add = TRUE)
-  }
-
   control_parsnip <- parsnip::control_parsnip(verbosity = 0, catch = TRUE)
   control_workflow <- workflows::control_workflow(control_parsnip)