In tidyclust: A Common API to Clustering

# pillar/cli options to try to lock down formatting
options(useFancyQuotes = FALSE)
options(dplyr.print_min = 6, dplyr.print_max = 6)
options(cli.width = 85)
options(crayon.enabled = FALSE)
options(pillar.min_title_chars = Inf)

library(tidyclust)
library(workflows)

# ------------------------------------------------------------------------------
# These are required to build md docs for parsnip and extensions

check_pkg_for_docs <- function(x){
  purrr::map(x, ~ rlang::check_installed(.x))
  purrr::map(x, ~ require(.x, character.only = TRUE))
}

rmd_pkgs <- c("tune", "glue", "dplyr", "tidyclust", "dials")

check_pkg_for_docs(rmd_pkgs)

combine_words <- function(x) {
  if (isTRUE(length(x) > 2)) {
    last <- ", and "
  } else {
    last <- " and "
  }

  glue::glue_collapse(x, ", ", last = last)
}

descr_models <- function(mod, eng) {
  res <- modelenv::get_from_env(mod) %>%
    dplyr::filter(engine == eng) %>%
    dplyr::distinct() %>%
    purrr::pluck("mode")

  if (length(res) == 1) {
    txt <- "is a single mode:"
  } else {
    txt <- "are multiple modes:"
  }
  paste("For this engine, there", txt, combine_words(res))
}

get_dials <- function(x) {
  if (any(names(x) == "range")) {
    cl <- rlang::call2(x$fun, .ns = x$pkg, range = x$range)
  } else {
    cl <- rlang::call2(x$fun, .ns = x$pkg)
  }

  rlang::eval_tidy(cl)
}

make_parameter_list <- function(x, defaults) {
  x %>%
    tune::tunable() %>%
    dplyr::select(-source, -component, -component_id, tidyclust = name) %>%
    dplyr::mutate(
      dials = purrr::map(call_info, get_dials),
      label = purrr::map_chr(dials, ~ .x$label),
      type = purrr::map_chr(dials, ~ .x$type)
    ) %>%
    dplyr::inner_join(defaults, by = "tidyclust") %>%
    dplyr::mutate(
      item =
        glue::glue("- `{tidyclust}`: {label} (type: {type}, default: {default})\n\n")
    )
}

options(width = 80)