R/algorithmDB.R

In rtemis: Schema-Driven Machine Learning and Visualization

# algorithmDB.R
# ::rtemis::
# 2025- EDG rtemis.org

# Supervised Learning ----
# Columns: `name`, then the task and data traits, as "TRUE" /
# "FALSE" strings -- `rbind(c(...))` coerces every cell to character.
#
# `classification`, `regression`, `survival`
#                         which tasks the algorithm performs. `survival` is
#                         recorded but *not published* in `traits/v1`: rtemis
#                         resolves an outcome to Classification or Regression
#                         only and dispatches no survival run, so publishing it
#                         would offer a capability nothing can act on. Add it to
#                         `trait_columns` in `data-raw/generate_checks.R` when
#                         survival runs exist.
# `handles_missing_data`  whether it accepts a training set containing `NA`.
#                         This is the same fact each `train_` method states as
#                         `check_supervised(allow_missing = )`, declared here so
#                         that a check can read it without running the method.
# `handles_p_greater_than_n`
#                         whether a fit with more predictors than cases is
#                         usable. FALSE where the fit is an unregularized least
#                         squares and goes rank-deficient -- GLM and GAM
#                         directly, GLMTree through the GLM in each leaf. TRUE
#                         where the algorithm regularizes, selects, or cannot be
#                         rank-deficient at all: NNLS's non-negativity makes the
#                         solution sparse, and Isotonic is univariate, so p
#                         exceeds n only when there are no cases.
#
# Both are `NA` for the meta learners: a stacked ensemble takes whatever its
# base learners take, so the answer is a property of the library it is given,
# not of the algorithm.
supervised_algorithms <- data.frame(rbind(
  c(
    "BART",
    TRUE,
    TRUE,
    FALSE,
    FALSE,
    TRUE
  ),
  c(
    "CART",
    TRUE,
    TRUE,
    TRUE,
    TRUE,
    TRUE
  ),
  c(
    "ConditionalSuperLearner",
    TRUE,
    TRUE,
    FALSE,
    NA,
    NA
  ),
  c("GAM", TRUE, TRUE, FALSE, FALSE, FALSE),
  c("GLM", TRUE, TRUE, FALSE, FALSE, FALSE),
  c("GLMNET", TRUE, TRUE, TRUE, FALSE, TRUE),
  c(
    "GLMTree",
    TRUE,
    TRUE,
    FALSE,
    FALSE,
    FALSE
  ),
  c("HAL", TRUE, TRUE, FALSE, FALSE, TRUE),
  c("Isotonic", TRUE, TRUE, FALSE, FALSE, TRUE),
  c(
    "MonotonicHAL",
    TRUE,
    TRUE,
    FALSE,
    FALSE,
    TRUE
  ),
  c("KNN", TRUE, TRUE, FALSE, FALSE, TRUE),
  c("LightCART", TRUE, TRUE, FALSE, TRUE, TRUE),
  c("LightGBM", TRUE, TRUE, FALSE, TRUE, TRUE),
  c("LightRF", TRUE, TRUE, FALSE, TRUE, TRUE),
  c("LightRuleFit", TRUE, TRUE, FALSE, TRUE, TRUE),
  c("LINAD", TRUE, TRUE, FALSE, FALSE, TRUE),
  c(
    "LINADForest",
    TRUE,
    TRUE,
    FALSE,
    FALSE,
    TRUE
  ),
  c(
    "MARS",
    TRUE,
    TRUE,
    FALSE,
    FALSE,
    TRUE
  ),
  c("MLP", TRUE, TRUE, FALSE, FALSE, TRUE),
  c(
    "ModalityStacking",
    TRUE,
    TRUE,
    FALSE,
    NA,
    NA
  ),
  c("NNLS", TRUE, TRUE, FALSE, FALSE, TRUE),
  c("Ranger", TRUE, TRUE, FALSE, TRUE, TRUE),
  c(
    "SuperLearner",
    TRUE,
    TRUE,
    FALSE,
    NA,
    NA
  ),
  c(
    "LinearSVM",
    TRUE,
    TRUE,
    FALSE,
    FALSE,
    TRUE
  ),
  c(
    "RadialSVM",
    TRUE,
    TRUE,
    FALSE,
    FALSE,
    TRUE
  ),
  c("SPLS", TRUE, TRUE, FALSE, FALSE, TRUE),
  c(
    "TabNet",
    TRUE,
    TRUE,
    FALSE,
    FALSE,
    TRUE
  )
))
colnames(supervised_algorithms) <- c(
  "name",
  "classification",
  "regression",
  "survival",
  "handles_missing_data",
  "handles_p_greater_than_n"
)

supervised_algorithms <- data.frame(
  name = supervised_algorithms[["name"]],
  description = unname(schema_algorithm_descriptions(Hyperparameters)[
    supervised_algorithms[["name"]]
  ]),
  supervised_algorithms[-1L]
)


# %% SUPERVISED_BACKENDS ----
# The packages that fit each supervised algorithm, cited by `writeup()`.
# "stats" is part of R. An empty entry is an algorithm implemented in rtemis
# (LINAD, LINADForest) or a meta learner, whose base learners name their own.
# Each `train_` method checks the same packages with `check_dependencies()`;
# `test_SupervisedWriteup.R` keeps the two in agreement.
SUPERVISED_BACKENDS <- list(
  BART = "stochtree",
  CART = "rpart",
  ConditionalSuperLearner = character(),
  GAM = "mgcv",
  GLM = "stats",
  GLMNET = "glmnet",
  GLMTree = "partykit",
  HAL = "hal9001",
  Isotonic = "stats",
  MonotonicHAL = "hal9001",
  KNN = "kknn",
  LightCART = "lightgbm",
  LightGBM = "lightgbm",
  LightRF = "lightgbm",
  LightRuleFit = c("lightgbm", "glmnet"),
  LINAD = character(),
  LINADForest = character(),
  MARS = "earth",
  MLP = "torch",
  ModalityStacking = character(),
  NNLS = "nnls",
  Ranger = "ranger",
  SuperLearner = character(),
  LinearSVM = "e1071",
  RadialSVM = "e1071",
  SPLS = "spls",
  TabNet = c("torch", "tabnet")
)
stopifnot(setequal(names(SUPERVISED_BACKENDS), supervised_algorithms[["name"]]))


# %% SUPERVISED_INTERNAL_SELECTION ----
# Algorithms whose fit selects a quantity from the data beyond the
# hyperparameters it is given: a penalty by internal cross-validation (GLMNET,
# HAL, MonotonicHAL, the lasso stage of LightRuleFit), a number of iterations
# or epochs by early stopping (LightGBM, MLP, TabNet), a tree size on
# validation cases (LINAD, LINADForest), model size by generalized
# cross-validation (MARS), smoothing parameters (GAM), and ensemble weights
# from cross-fitted predictions (the meta learners). `writeup()` describes the
# selection where a `writeup_selection()` method exists and lists it as not
# reported otherwise.
SUPERVISED_INTERNAL_SELECTION <- c(
  "ConditionalSuperLearner",
  "GAM",
  "GLMNET",
  "HAL",
  "LightGBM",
  "LightRuleFit",
  "LINAD",
  "LINADForest",
  "MARS",
  "MLP",
  "ModalityStacking",
  "MonotonicHAL",
  "SuperLearner",
  "TabNet"
)
stopifnot(all(
  SUPERVISED_INTERNAL_SELECTION %in% supervised_algorithms[["name"]]
))


# %% algorithm_trait ----
#' Read one logical trait of a supervised algorithm
#'
#' @param algorithm Character: Algorithm name.
#' @param trait Character: Column of `supervised_algorithms` to read.
#'
#' @return Logical: TRUE, FALSE, or `NA` where the answer belongs to the
#'   algorithm's base learners rather than to the algorithm (the meta learners),
#'   or where the name is not a known algorithm.
#'
#' @author EDG
#' @keywords internal
#' @noRd
algorithm_trait <- function(algorithm, trait) {
  idx <- match(
    tolower(algorithm),
    tolower(supervised_algorithms[["name"]])
  )
  if (is.na(idx)) {
    return(NA)
  }
  as.logical(supervised_algorithms[[trait]][[idx]])
} # /rtemis::algorithm_trait


# %% algorithm_handles_p_gt_n ----
#' Does an algorithm give a usable fit with more predictors than cases?
#'
#' @param algorithm Character: Algorithm name.
#'
#' @return Logical, `NA` where the answer is not the algorithm's to give.
#'
#' @author EDG
#' @keywords internal
#' @noRd
algorithm_handles_p_gt_n <- function(algorithm) {
  algorithm_trait(algorithm, "handles_p_greater_than_n")
} # /rtemis::algorithm_handles_p_gt_n


# %% algorithm_allows_missing ----
#' Does an algorithm accept a training set containing `NA`?
#'
#' Reads the `handles_missing_data` trait, which mirrors what the algorithm's `train_` method
#' passes as `check_supervised(allow_missing = )`.
#'
#' @param algorithm Character: Algorithm name.
#'
#' @return Logical: TRUE, FALSE, or `NA` where the answer belongs to the
#'   algorithm's base learners rather than to the algorithm (the meta learners),
#'   or where the name is not a known algorithm.
#'
#' @author EDG
#' @keywords internal
#' @noRd
algorithm_allows_missing <- function(algorithm) {
  algorithm_trait(algorithm, "handles_missing_data")
} # /rtemis::algorithm_allows_missing


supervised_multiclass <- c(
  "GLMNET",
  "CART",
  "KNN",
  "LightCART",
  "LightRF",
  "LightGBM",
  "LinearSVM",
  "MARS",
  "MLP",
  "RadialSVM",
  "Ranger",
  "SPLS"
)

# %% explanation_algorithms ----
# What `explain()` does to each algorithm, and whether the answer is exact.
#
# Applicability is data, not dispatch: the estimator cannot be chosen from the
# fitted object's class, because one backend class can back two algorithms that
# warrant different estimators -- LinearSVM and RadialSVM are both `e1071::svm`.
# So `explain()` reads the estimator from here and tells `explain_super()` what
# to compute, which is the opposite of `varimp_super()`'s arrangement.
#
# `exact` is NA where exactness is a property of the *fitted* model rather than
# of the algorithm: SPLS, LinearSVM and GAM have a single additive map only for
# a regression or binary fit -- a multiclass one is scores identified up to a
# constant, one-vs-one voting, and one linear predictor per non-reference
# class, respectively; and MARS and HAL are additive
# in their features only when the fit selected no term reading two of them,
# which for both is a search setting rather than a property of the algorithm.
# Each is checked at explain time and refused with the reason.
#
# The three ensembles take the kernel estimator rather than a weighted sum of
# their bases' explanations. The sum is exact for a linear meta-learner, but it
# needs every base to answer the *same* question, and rtemis's exact estimators
# are each locked to one value function -- LinearSHAP is interventional-only,
# LightGBM's TreeSHAP conditional-only -- so a mixed library has none in common.
#
# Only eight algorithms are unconditionally exact: exactness is usually a
# property of the fitted model, and this column says which.
#
# Built column-wise so `exact` is `logical`, for the reason `decom_algorithms`
# gives.
explanation_algorithms <- data.frame(
  name = c(
    "BART",
    "CART",
    "ConditionalSuperLearner",
    "GAM",
    "GLM",
    "GLMNET",
    "GLMTree",
    "HAL",
    "Isotonic",
    "MonotonicHAL",
    "KNN",
    "LightCART",
    "LightGBM",
    "LightRF",
    "LightRuleFit",
    "LINAD",
    "LINADForest",
    "MARS",
    "MLP",
    "ModalityStacking",
    "NNLS",
    "Ranger",
    "SuperLearner",
    "LinearSVM",
    "RadialSVM",
    "SPLS",
    "TabNet"
  ),
  estimator = c(
    "KernelSHAP",
    "TreeSHAP",
    "ExpertSHAP",
    "GAMTerms",
    "LinearSHAP",
    "LinearSHAP",
    "KernelSHAP",
    "HALBasis",
    "Isotonic",
    "HALBasis",
    "KernelSHAP",
    "TreeSHAP",
    "TreeSHAP",
    "TreeSHAP",
    "KernelSHAP",
    "KernelSHAP",
    "KernelSHAP",
    "MARSBasis",
    "KernelSHAP",
    "KernelSHAP",
    "LinearSHAP",
    "KernelSHAP",
    "KernelSHAP",
    "LinearSHAP",
    "KernelSHAP",
    "LinearSHAP",
    "KernelSHAP"
  ),
  exact = c(
    FALSE,
    TRUE,
    NA,
    NA,
    TRUE,
    TRUE,
    FALSE,
    NA,
    TRUE,
    NA,
    FALSE,
    TRUE,
    TRUE,
    TRUE,
    FALSE,
    FALSE,
    FALSE,
    NA,
    FALSE,
    FALSE,
    TRUE,
    FALSE,
    FALSE,
    NA,
    FALSE,
    NA,
    FALSE
  ),
  rationale = c(
    "No additive structure to read; the posterior gives a better uncertainty story than SHAP does.",
    "TreeSHAP over a single tree is a short traversal and is exact.",
    "An oracle routes each case to one expert, which predicts it alone -- so the expert explains it, exactly, with its own estimator.",
    "predict(type = 'terms') returns the additive decomposition for a regression or binary fit; a multiclass fit has one linear predictor per non-reference class.",
    "Coefficients give phi_j = beta_j * (x_j - E[x_j]) in closed form.",
    "Coefficients give phi_j = beta_j * (x_j - E[x_j]) in closed form.",
    "Linear within a leaf, but the tree routes on the same features, so a leaf's coefficients account for only part of what the model did.",
    "A lasso over basis functions, exact where every selected basis reads one feature -- which needs max_degree = 1.",
    "One feature carries the whole deviation from the baseline.",
    "A lasso over basis functions, exact where every selected basis reads one feature -- which needs max_degree = 1.",
    "No parametric structure to read; distances are not additive in the features.",
    "TreeSHAP over a single tree is a short traversal and is exact.",
    "predict(type = 'contrib') returns contributions from the booster itself.",
    "predict(type = 'contrib') returns contributions from the booster itself.",
    "A sparse linear model over rules, not a booster; a rule is a conjunction of conditions, so it is not additive in single features.",
    "Linear within a leaf, but the splits that route a case read the same features, so its coefficients account for only part of what it did.",
    "One tree is linear within a leaf and already only partly readable from its coefficients; a mean over trees, each routing on the same features, is no more additive in them.",
    "Additive in its basis functions for a regression fit; classification adds a GLM over them, and an interaction term reads two features.",
    "A network has no additive structure to read; Expected Gradients would be cheaper but is deferred.",
    "A weighted sum of base explanations is exact for a linear meta-learner only when every base computes the same value function, and each exact estimator computes one value function.",
    "Coefficients give phi_j = beta_j * (x_j - E[x_j]) in closed form.",
    "TreeSHAP covers rpart and LightGBM trees; a ranger forest is explained with the kernel estimator.",
    "A weighted sum of base explanations is exact for a linear meta-learner only when every base computes the same value function, and each exact estimator computes one value function.",
    "The decision function is linear for a regression or binary fit; multiclass is one-vs-one voting.",
    "The kernel makes the decision function nonlinear in the features.",
    "Linear in the features for regression and binary; multiclass scores are identified only up to a constant.",
    "Attention masks are native and free but are not Shapley values."
  ),
  stringsAsFactors = FALSE
)

# The value function each algorithm's default estimator computes, derived rather
# than restated so the two cannot disagree.
explanation_algorithms[["perturbation"]] <- unname(
  SHAP_ESTIMATOR_PERTURBATION[explanation_algorithms[["estimator"]]]
)


# %% explanation_methods ----
#' Explanation Methods per Algorithm
#'
#' What [explain] does to a model fitted by each supervised algorithm: which
#' estimator `setup_SHAP(estimator = "auto")` resolves to, whether that answer
#' is exact, which value function it computes, and why.
#'
#' @details
#' The columns:
#'
#' \describe{
#'   \item{`name`}{The algorithm, as named by `setup_<name>()`.}
#'   \item{`estimator`}{The estimator `"auto"` resolves to. `"KernelSHAP"` is
#'     the model-agnostic fallback and applies to every algorithm; the others
#'     are exact and algorithm-specific.}
#'   \item{`exact`}{TRUE if the estimator returns Shapley values rather than an
#'     estimate of them, NA where that depends on the fitted model rather than
#'     on the algorithm -- an ensemble whose meta-learner turned out to be
#'     linear, or a model that has one linear map for a regression or binary
#'     outcome but not for a multiclass one. An NA row explains what it did
#'     when asked, and refuses with a message naming the reason when it cannot.}
#'   \item{`perturbation`}{The value function computed when
#'     `setup_SHAP(perturbation = )` is left NULL.}
#'   \item{`rationale`}{Why this estimator, in one line.}
#' }
#'
#' `estimator = "kernel"` is always available, so a row whose `exact` is FALSE
#' is saying that `estimator = "exact"` has nothing to offer for it -- not that
#' the algorithm cannot be explained.
#'
#' @param algorithm Optional Character: Name of a supervised algorithm, matched
#' case-insensitively. NULL returns every algorithm.
#'
#' @return data.frame: One row per algorithm.
#'
#' @author EDG
#' @export
#' @examples
#' explanation_methods()
#' explanation_methods("Ranger")
#' # Which algorithms have an exact estimator?
#' em <- explanation_methods()
#' em[["name"]][!is.na(em[["exact"]]) & em[["exact"]]]
explanation_methods <- function(algorithm = NULL) {
  if (is.null(algorithm)) {
    return(explanation_algorithms)
  }
  methods <- explanation_algorithms[
    explanation_algorithms[["name"]] == .get_alg_name(algorithm),
    ,
    drop = FALSE
  ]
  rownames(methods) <- NULL
  methods
} # /rtemis::explanation_methods


# Algorithms whose fit is constrained monotonic non-decreasing, which is what
# makes an algorithm usable as a calibration map: a map that reorders scores
# changes the ranking of the predictions and so changes AUC. `calibrate()`
# accepts any `Hyperparameters` object, because it trains one like any other
# model, but only these carry that guarantee. The first is the default.
calibration_algorithms <- c(
  "Isotonic",
  "MonotonicHAL"
)


# %% .get_alg_name ----
#' Resolve a supervised algorithm name
#'
#' Matches `algorithm` case-insensitively against the supervised algorithm
#' catalog and returns the canonical name, which names the algorithm's
#' `setup_<name>()` function.
#'
#' Exported for `rtemis.server`, which resolves algorithm names received over the
#' wire.
#'
#' @param algorithm Character: Algorithm name, in any letter case.
#'
#' @return Character: Canonical algorithm name.
#'
#' @author EDG
#' @keywords internal
#' @export
#' @examples
#' .get_alg_name("lightgbm")
.get_alg_name <- function(algorithm) {
  algname <- supervised_algorithms[["name"]][
    tolower(algorithm) == tolower(supervised_algorithms[["name"]])
  ]
  if (length(algname) == 0) {
    rtemis.core::abort(
      "Incorrect algorithm specified: ",
      algorithm,
      class = c("rtemis_value_error", "rtemis_input_error")
    )
  }
  algname
} # /rtemis::.get_alg_name


# %% .supervised_algorithms ----
#' Supervised algorithm catalog
#'
#' Returns the supervised algorithm catalog: one row per algorithm, with its
#' canonical name, description, supported tasks, and data traits.
#'
#' Exported for `rtemis.server`, which serves the catalog to its clients.
#'
#' @return data.frame with columns `name` and `description` (character), and
#'   `classification`, `regression`, `survival`, `handles_missing_data`, and
#'   `handles_p_greater_than_n` (logical). A data trait is `NA` for a meta
#'   learner, whose traits are those of its base learners.
#'
#' @author EDG
#' @keywords internal
#' @export
#' @examples
#' .supervised_algorithms()[, c("name", "classification", "regression")]
.supervised_algorithms <- function() {
  out <- supervised_algorithms
  trait_columns <- setdiff(names(out), c("name", "description"))
  out[trait_columns] <- lapply(out[trait_columns], as.logical)
  out
} # /rtemis::.supervised_algorithms


#' Get algorithm description
#'
#' @param algorithm Character: Algorithm name.
#'
#' @return Character: Algorithm description.
#'
#' @author EDG
#'
#' @keywords internal
#' @noRd
desc_alg <- function(algorithm) {
  algdesc <- supervised_algorithms[["description"]][
    tolower(algorithm) == tolower(supervised_algorithms[["name"]])
  ]
  if (length(algdesc) == 0) {
    rtemis.core::abort(
      "Incorrect algorithm specified: ",
      algorithm,
      class = c("rtemis_value_error", "rtemis_input_error")
    )
  }
  algdesc
} # /rtemis::desc_alg

#' Algorithm description with short name
#'
#' @param algorithm Character: Algorithm name.
#'
#' @return Character: Algorithm description with short name in parentheses.
#'
#' @author EDG
#'
#' @keywords internal
#' @noRd
desc_abb_alg <- function(algorithm) {
  paste0(
    desc_alg(algorithm),
    " (",
    .get_alg_name(algorithm),
    ")"
  )
} # /rtemis::desc_abb_alg

get_train_fn <- function(algorithm) {
  paste0("train_", .get_alg_name(algorithm))
} # /rtemis::get_train_fn

get_default_hyperparameters <- function(algorithm) {
  do.call(paste0("setup_", .get_alg_name(algorithm)), list())
} # /rtemis::get_default_hyperparameters


# Clustering ----
clust_algorithms <- local({
  descriptions <- schema_algorithm_descriptions(ClusteringConfig)
  descriptions <- descriptions[order(names(descriptions))]
  data.frame(name = names(descriptions), description = unname(descriptions))
})


# %% .get_clust_name ----
#' Resolve a clustering algorithm name
#'
#' Matches `algorithm` case-insensitively against the clustering algorithm
#' catalog and returns the canonical name, which names the algorithm's
#' `setup_<name>()` function.
#'
#' Exported for `rtemis.server`, which resolves algorithm names received over the
#' wire.
#'
#' @param algorithm Character: Algorithm name, in any letter case.
#'
#' @return Character: Canonical algorithm name.
#'
#' @author EDG
#' @keywords internal
#' @export
#' @examples
#' .get_clust_name("kmeans")
.get_clust_name <- function(algorithm) {
  clustname <- clust_algorithms[, 1][
    tolower(algorithm) == tolower(clust_algorithms[, 1])
  ]
  if (length(clustname) == 0) {
    rtemis.core::abort(
      "Incorrect clustering algorithm specified: ",
      algorithm,
      class = c("rtemis_value_error", "rtemis_input_error")
    )
  }
  clustname
} # /rtemis::.get_clust_name


get_clust_desc <- function(algorithm) {
  clustdesc <- clust_algorithms[, 2][
    tolower(algorithm) == tolower(clust_algorithms[, 1])
  ]
  if (length(clustdesc) == 0) {
    rtemis.core::abort(
      "Incorrect clustering algorithm specified: ",
      algorithm,
      class = c("rtemis_value_error", "rtemis_input_error")
    )
  }
  clustdesc
} # /rtemis::get_clust_desc

get_clust_fn <- function(algorithm) {
  paste0("cluster_", .get_clust_name(algorithm))
} # /rtemis::get_clust_fn

get_default_clusterparams <- function(algorithm) {
  do.call(paste0("setup_", .get_clust_name(algorithm)), list())
}

get_clustpredict_fn <- function(algorithm) {
  paste0("clustpredict_", .get_clust_name(algorithm))
}

get_clust_setup_fn <- function(algorithm) {
  paste0("setup_", .get_clust_name(algorithm))
} # /rtemis::get_clust_setup_fn


# Decomposition ----
# Admission criterion for this table: a symmetric decomposition method models
# the joint structure of one or more variables without designating any variable
# or variable set as the outcome. An algorithm that designates an outcome is a
# supervised algorithm and belongs in `supervised_algorithms` -- PLS, for
# instance. A two-block method with no outcome, such as CCA, is
# cross-decomposition and belongs in neither table, because it has neither
# `decomp()`'s shape nor `train()`'s. That criterion, not a column, is what
# decides where a new algorithm goes.
#
# Built column-wise so the logical columns are `logical`. `rbind(c(...))`
# coerces every cell to character, which is why `supervised_algorithms` carries
# "TRUE"/"FALSE" strings.
decom_algorithms <- data.frame(
  name = c(
    "Autoencoder",
    "ICA",
    "Isomap",
    "MDS",
    "NMF",
    "PCA",
    "PCoA",
    "tSNE",
    "UMAP",
    "VariationalAutoencoder"
  ),
  description = unname(schema_algorithm_descriptions(DecompositionConfig)[c(
    "Autoencoder",
    "ICA",
    "Isomap",
    "MDS",
    "NMF",
    "PCA",
    "PCoA",
    "tSNE",
    "UMAP",
    "VariationalAutoencoder"
  )]),
  linear = c(FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE),
  can_apply = c(TRUE, TRUE, FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, TRUE),
  invertible = c(
    TRUE,
    TRUE,
    FALSE,
    FALSE,
    TRUE,
    TRUE,
    FALSE,
    FALSE,
    FALSE,
    TRUE
  ),
  orthogonal = c(
    FALSE,
    FALSE,
    FALSE,
    TRUE,
    FALSE,
    TRUE,
    TRUE,
    FALSE,
    FALSE,
    FALSE
  ),
  ordered = c(
    FALSE,
    FALSE,
    FALSE,
    FALSE,
    FALSE,
    TRUE,
    TRUE,
    FALSE,
    FALSE,
    FALSE
  ),
  deterministic = c(
    FALSE,
    FALSE,
    TRUE,
    FALSE,
    FALSE,
    TRUE,
    TRUE,
    FALSE,
    FALSE,
    FALSE
  ),
  preserves = c(
    "reconstruction",
    "variance",
    "global",
    "global",
    "reconstruction",
    "variance",
    "global",
    "local",
    "local",
    "reconstruction"
  ),
  nonneg = c(
    FALSE,
    FALSE,
    FALSE,
    FALSE,
    TRUE,
    FALSE,
    FALSE,
    FALSE,
    FALSE,
    FALSE
  ),
  threaded = c(
    TRUE,
    FALSE,
    FALSE,
    FALSE,
    FALSE,
    FALSE,
    FALSE,
    TRUE,
    TRUE,
    TRUE
  ),
  package = c(
    "torch",
    "fastICA",
    "vegan",
    "vegan",
    "NMF",
    "stats",
    "vegan",
    "Rtsne",
    "uwot",
    "torch"
  ),
  stringsAsFactors = FALSE
)

# %% decom_algorithms_applicable ----
# The algorithms whose fitted result can be applied to new data, derived so it
# cannot disagree with the table. Tests assert that `can_apply` is TRUE exactly
# when `method(apply_decomp_, <Alg>Config)` exists.
decom_algorithms_applicable <- decom_algorithms[["name"]][
  decom_algorithms[["can_apply"]]
]

# %% decom_algorithms_invertible ----
# The algorithms whose components map back to input space, derived for the same
# reason: tests assert that `invertible` is TRUE exactly when
# `method(reconstruct_, <Alg>Config)` exists.
decom_algorithms_invertible <- decom_algorithms[["name"]][
  decom_algorithms[["invertible"]]
]


# %% .get_decom_name ----
#' Resolve a decomposition algorithm name
#'
#' Matches `algorithm` case-insensitively against the decomposition algorithm
#' catalog and returns the canonical name, which names the algorithm's
#' `setup_<name>()` function.
#'
#' Exported for `rtemis.server`, which resolves algorithm names received over the
#' wire.
#'
#' @param algorithm Character: Algorithm name, in any letter case.
#'
#' @return Character: Canonical algorithm name.
#'
#' @author EDG
#' @keywords internal
#' @export
#' @examples
#' .get_decom_name("pca")
.get_decom_name <- function(algorithm) {
  decomname <- decom_algorithms[["name"]][
    tolower(algorithm) == tolower(decom_algorithms[["name"]])
  ]
  if (length(decomname) == 0) {
    rtemis.core::abort(
      "Incorrect decomposition algorithm specified: ",
      algorithm,
      class = c("rtemis_value_error", "rtemis_input_error")
    )
  }
  decomname
} # /rtemis::.get_decom_name


get_decom_desc <- function(algorithm) {
  decomdesc <- decom_algorithms[["description"]][
    tolower(algorithm) == tolower(decom_algorithms[["name"]])
  ]
  if (length(decomdesc) == 0) {
    rtemis.core::abort(
      "Incorrect decomposition algorithm specified: ",
      algorithm,
      class = c("rtemis_value_error", "rtemis_input_error")
    )
  }
  decomdesc
} # /rtemis::get_decom_desc

get_default_decomparams <- function(algorithm) {
  do.call(paste0("setup_", .get_decom_name(algorithm)), list())
} # /rtemis::get_default_decomparams

get_decom_setup_fn <- function(algorithm) {
  paste0("setup_", .get_decom_name(algorithm))
} # /rtemis::get_decom_setup_fn


# %% decomposition_traits ----
#' Decomposition Algorithm Traits
#'
#' Machine-readable properties of each decomposition algorithm available to
#' [decomp]: whether the map is linear, whether it can be applied to new data,
#' whether it inverts, and what its objective preserves.
#'
#' @details
#' The columns:
#'
#' \describe{
#'   \item{`name`}{The name used by `setup_<name>()` and `decomp(algorithm =)`.}
#'   \item{`description`}{Full name of the algorithm.}
#'   \item{`linear`}{The map from input space to component space is linear.}
#'   \item{`can_apply`}{A fitted result can be applied to new data with
#'     [apply_decomp].}
#'   \item{`invertible`}{There is an inverse map from component space back to
#'     input space, so reconstruction error is defined.}
#'   \item{`orthogonal`}{Components are mutually orthogonal.}
#'   \item{`ordered`}{Components come in a meaningful order, so "the first j"
#'     is well-defined.}
#'   \item{`deterministic`}{The same input and configuration give the same
#'     result without setting a seed.}
#'   \item{`preserves`}{What the objective preserves: `"variance"`,
#'     `"global"`, `"local"`, or `"reconstruction"`.}
#'   \item{`nonneg`}{Requires non-negative input and produces non-negative
#'     factors.}
#'   \item{`threaded`}{The fit runs on as many threads as the execution
#'     config gives the algorithm (`n_workers_algorithm`, or the worker count).
#'     Like `can_apply`, it states what rtemis implements.}
#'   \item{`package`}{Package supplying the backend implementation.}
#' }
#'
#' `can_apply` states what rtemis implements, not what is mathematically
#' possible. Parametric tSNE exists and Isomap admits a Nystrom-style
#' out-of-sample extension; neither is implemented here, so both are `FALSE`.
#' The column's contract is that [apply_decomp] on a fitted result of this
#' algorithm returns components.
#'
#' @param algorithm Optional Character: Name of a decomposition algorithm,
#' matched case-insensitively. `NULL` returns every algorithm.
#'
#' @return data.frame: One row per algorithm, one column per trait.
#'
#' @author EDG
#' @export
#' @examples
#' decomposition_traits()
#' decomposition_traits("PCA")
#' # Which algorithms support out-of-sample projection?
#' decomposition_traits()[["name"]][decomposition_traits()[["can_apply"]]]
decomposition_traits <- function(algorithm = NULL) {
  if (is.null(algorithm)) {
    return(decom_algorithms)
  }
  traits <- decom_algorithms[
    decom_algorithms[["name"]] == .get_decom_name(algorithm),
    ,
    drop = FALSE
  ]
  rownames(traits) <- NULL
  traits
} # /rtemis::decomposition_traits


#' Available Algorithms
#'
#' Print available algorithms for supervised learning, clustering, and decomposition.
#'
#' Each algorithm is set up with `setup_{Algorithm}()`, using the name printed
#' here: `setup_LightGBM()`, `setup_KMeans()`, `setup_PCA()`. Pass the result to
#' [train], [cluster], or [decomp].
#'
#' @rdname available_algorithms
#' @aliases available_algorithms
#'
#' @param verbosity Integer: Verbosity level.
#' @return Named list of algorithm descriptions, invisibly.
#'
#' @author EDG
#' @export
#' @examples
#' available_supervised()
#' # Train with one of them, at its default hyperparameters:
#' # train(iris, hyperparameters = setup_LightGBM())
available_supervised <- function(verbosity = 1L) {
  algs <- structure(
    supervised_algorithms[["description"]],
    names = supervised_algorithms[["name"]],
    class = "list"
  )
  if (verbosity > 0L) {
    printls(algs, print_class = FALSE, limit = -1L)
  }
  invisible(algs)
}

#' @rdname available_algorithms
#' @export
#' @examples
#' available_clustering()
available_clustering <- function(verbosity = 1L) {
  algs <- structure(
    clust_algorithms[, 2],
    names = clust_algorithms[, 1],
    class = "list"
  )
  if (verbosity > 0L) {
    printls(algs, print_class = FALSE, limit = -1L)
  }
  invisible(algs)
}


#' @rdname available_algorithms
#' @export
#' @examples
#' available_calibration()
#' # Calibrate with one of them:
#' # calibrate(mod, hyperparameters = setup_Isotonic())
available_calibration <- function(verbosity = 1L) {
  # Read the descriptions from the supervised table, so a calibrator is
  # described the same way wherever it is listed.
  idx <- match(calibration_algorithms, supervised_algorithms[["name"]])
  algs <- structure(
    supervised_algorithms[["description"]][idx],
    names = supervised_algorithms[["name"]][idx],
    class = "list"
  )
  if (verbosity > 0L) {
    printls(algs, print_class = FALSE, limit = -1L)
  }
  invisible(algs)
}


#' @rdname available_algorithms
#'
#' @param traits Logical: If TRUE, `available_decomposition()` prints and
#' returns the full trait table from [decomposition_traits] instead of the
#' named list of descriptions.
#'
#' @export
#' @examples
#' available_decomposition()
#' available_decomposition(traits = TRUE)
available_decomposition <- function(verbosity = 1L, traits = FALSE) {
  if (traits) {
    algs <- decomposition_traits()
    if (verbosity > 0L) {
      print(algs)
    }
    return(invisible(algs))
  }
  algs <- structure(
    decom_algorithms[["description"]],
    names = decom_algorithms[["name"]],
    class = "list"
  )
  if (verbosity > 0L) {
    printls(algs, print_class = FALSE, limit = -1L)
  }
  invisible(algs)
}