cluster

easystats · Nov 19, 2024 · 909c050 · 909c050
1 parent d3ca9a2
commit 909c050
Show file tree

Hide file tree

Showing 12 changed files with 188 additions and 349 deletions.
diff --git a/R/1_model_parameters.R b/R/1_model_parameters.R
@@ -16,7 +16,7 @@
 #' - [Bayesian][model_parameters.stanreg()]: **BayesFactor**, **blavaan**, **brms**,
 #'   **MCMCglmm**, **posterior**, **rstanarm**, `bayesQR`, `bcplm`, `BGGM`, `blmrm`,
 #'   `blrm`, `mcmc.list`, `MCMCglmm`, ...
-#' - [Clustering][model_parameters.kmeans()]: **hclust**, **kmeans**, **mclust**, **pam**, ...
+#' - [Clustering][model_parameters.hclust()]: **hclust**, **kmeans**, **mclust**, **pam**, ...
 #' - [Correlations, t-tests, etc.][model_parameters.htest()]: **lmtest**, `htest`,
 #'   `pairwise.htest`, ...
 #' - [Meta-Analysis][model_parameters.rma()]: **metaBMA**, **metafor**, **metaplus**, ...

diff --git a/R/cluster_performance.R b/R/cluster_performance.R
@@ -2,19 +2,28 @@
 #'
 #' Compute performance indices for clustering solutions.
 #'
-#' @inheritParams model_parameters.kmeans
+#' @inheritParams model_parameters.hclust
 #'
 #' @examples
 #' # kmeans
 #' model <- kmeans(iris[1:4], 3)
 #' cluster_performance(model)
+#'
+#' # hclust
+#' data <- iris[1:4]
+#' model <- hclust(dist(data))
+#' clusters <- cutree(model, 3)
+#' cluster_performance(model, data, clusters)
+#'
+#' # Retrieve performance from parameters
+#' params <- model_parameters(kmeans(iris[1:4], 3))
+#' cluster_performance(params)
 #' @export
 cluster_performance <- function(model, ...) {
   UseMethod("cluster_performance")
 }
 
 
-#' @rdname cluster_performance
 #' @export
 cluster_performance.kmeans <- function(model, ...) {
   out <- as.data.frame(model[c("totss", "betweenss", "tot.withinss")])
@@ -29,18 +38,7 @@ cluster_performance.kmeans <- function(model, ...) {
 }
 
 
-
-
-
 #' @rdname cluster_performance
-#' @examples
-#' # hclust
-#' data <- iris[1:4]
-#' model <- hclust(dist(data))
-#' clusters <- cutree(model, 3)
-#'
-#' rez <- cluster_performance(model, data, clusters)
-#' rez
 #' @export
 cluster_performance.hclust <- function(model, data, clusters, ...) {
   if (is.null(data)) {
@@ -60,13 +58,6 @@ cluster_performance.hclust <- function(model, data, clusters, ...) {
 }
 
 
-#' @rdname cluster_performance
-#' @examplesIf require("dbscan", quietly = TRUE)
-#' # DBSCAN
-#' model <- dbscan::dbscan(iris[1:4], eps = 1.45, minPts = 10)
-#'
-#' rez <- cluster_performance(model, iris[1:4])
-#' rez
 #' @export
 cluster_performance.dbscan <- function(model, data, ...) {
   if (is.null(data)) {
@@ -84,12 +75,6 @@ cluster_performance.dbscan <- function(model, data, ...) {
 # Base --------------------------------------------------------------------
 
 
-
-#' @rdname cluster_performance
-#' @examples
-#' # Retrieve performance from parameters
-#' params <- model_parameters(kmeans(iris[1:4], 3))
-#' cluster_performance(params)
 #' @export
 cluster_performance.parameters_clusters <- function(model, ...) {
   valid <- model$Cluster != 0 & model$Cluster != "0" # Valid clusters

diff --git a/R/methods_dbscan.R b/R/methods_dbscan.R
@@ -1,30 +1,3 @@
-#' @rdname model_parameters.kmeans
-#' @inheritParams cluster_centers
-#'
-#' @examples
-#' \donttest{
-#' # DBSCAN ---------------------------
-#' if (require("dbscan", quietly = TRUE)) {
-#'   model <- dbscan::dbscan(iris[1:4], eps = 1.45, minPts = 10)
-#'
-#'   rez <- model_parameters(model, iris[1:4])
-#'   rez
-#'
-#'   # Get clusters
-#'   predict(rez)
-#'
-#'   # Clusters centers in long form
-#'   attributes(rez)$means
-#'
-#'   # Between and Total Sum of Squares
-#'   attributes(rez)$Sum_Squares_Total
-#'   attributes(rez)$Sum_Squares_Between
-#'
-#'   # HDBSCAN
-#'   model <- dbscan::hdbscan(iris[1:4], minPts = 10)
-#'   model_parameters(model, iris[1:4])
-#' }
-#' }
 #' @export
 model_parameters.dbscan <- function(model, data = NULL, clusters = NULL, ...) {
   if (is.null(data)) {

diff --git a/R/methods_hclust.R b/R/methods_hclust.R
@@ -1,7 +1,29 @@
-#' @rdname model_parameters.kmeans
-#' @inheritParams cluster_centers
+#' Parameters from Cluster Models (k-means, ...)
+#'
+#' Format cluster models obtained for example by [kmeans()].
+#'
+#' @param model Cluster model.
+#' @inheritParams model_parameters.default
+#' @param ... Arguments passed to or from other methods.
+#'
+#' @examplesIf require("factoextra", quietly = TRUE) && require("dbscan", quietly = TRUE) && require("cluster", quietly = TRUE) && require("fpc", quietly = TRUE)
+#' \donttest{
+#' #
+#' # K-means -------------------------------
+#' model <- kmeans(iris[1:4], centers = 3)
+#' rez <- model_parameters(model)
+#' rez
+#'
+#' # Get clusters
+#' predict(rez)
+#'
+#' # Clusters centers in long form
+#' attributes(rez)$means
+#'
+#' # Between and Total Sum of Squares
+#' attributes(rez)$Sum_Squares_Total
+#' attributes(rez)$Sum_Squares_Between
 #'
-#' @examples
 #' #
 #' # Hierarchical clustering (hclust) ---------------------------
 #' data <- iris[1:4]
@@ -20,6 +42,52 @@
 #' # Between and Total Sum of Squares
 #' attributes(rez)$Total_Sum_Squares
 #' attributes(rez)$Between_Sum_Squares
+#'
+#' #
+#' # Hierarchical K-means (factoextra::hkclust) ----------------------
+#' data <- iris[1:4]
+#' model <- factoextra::hkmeans(data, k = 3)
+#'
+#' rez <- model_parameters(model)
+#' rez
+#'
+#' # Get clusters
+#' predict(rez)
+#'
+#' # Clusters centers in long form
+#' attributes(rez)$means
+#'
+#' # Between and Total Sum of Squares
+#' attributes(rez)$Sum_Squares_Total
+#' attributes(rez)$Sum_Squares_Between
+#'
+#' # K-Medoids (PAM and HPAM) ==============
+#' model <- cluster::pam(iris[1:4], k = 3)
+#' model_parameters(model)
+#'
+#' model <- fpc::pamk(iris[1:4], criterion = "ch")
+#' model_parameters(model)
+#'
+#' # DBSCAN ---------------------------
+#' model <- dbscan::dbscan(iris[1:4], eps = 1.45, minPts = 10)
+#'
+#' rez <- model_parameters(model, iris[1:4])
+#' rez
+#'
+#' # Get clusters
+#' predict(rez)
+#'
+#' # Clusters centers in long form
+#' attributes(rez)$means
+#'
+#' # Between and Total Sum of Squares
+#' attributes(rez)$Sum_Squares_Total
+#' attributes(rez)$Sum_Squares_Between
+#'
+#' # HDBSCAN
+#' model <- dbscan::hdbscan(iris[1:4], minPts = 10)
+#' model_parameters(model, iris[1:4])
+#' }
 #' @export
 model_parameters.hclust <- function(model, data = NULL, clusters = NULL, ...) {
   if (is.null(data)) {
@@ -58,34 +126,6 @@ model_parameters.hclust <- function(model, data = NULL, clusters = NULL, ...) {
 
 
 #' @inheritParams n_clusters
-#' @rdname model_parameters.kmeans
-#' @examples
-#' \donttest{
-#' #
-#' # pvclust (finds "significant" clusters) ---------------------------
-#' if (require("pvclust", quietly = TRUE)) {
-#'   data <- iris[1:4]
-#'   # NOTE: pvclust works on transposed data
-#'   model <- pvclust::pvclust(datawizard::data_transpose(data, verbose = FALSE),
-#'     method.dist = "euclidean",
-#'     nboot = 50,
-#'     quiet = TRUE
-#'   )
-#'
-#'   rez <- model_parameters(model, data, ci = 0.90)
-#'   rez
-#'
-#'   # Get clusters
-#'   predict(rez)
-#'
-#'   # Clusters centers in long form
-#'   attributes(rez)$means
-#'
-#'   # Between and Total Sum of Squares
-#'   attributes(rez)$Sum_Squares_Total
-#'   attributes(rez)$Sum_Squares_Between
-#' }
-#' }
 #' @export
 model_parameters.pvclust <- function(model, data = NULL, clusters = NULL, ci = 0.95, ...) {
   if (is.null(data)) {

diff --git a/R/methods_kmeans.R b/R/methods_kmeans.R
@@ -1,29 +1,3 @@
-#' Parameters from Cluster Models (k-means, ...)
-#'
-#' Format cluster models obtained for example by [kmeans()].
-#'
-#' @param model Cluster model.
-#' @inheritParams model_parameters.default
-#' @param ... Arguments passed to or from other methods.
-#'
-#' @examples
-#' \donttest{
-#' #
-#' # K-means -------------------------------
-#' model <- kmeans(iris[1:4], centers = 3)
-#' rez <- model_parameters(model)
-#' rez
-#'
-#' # Get clusters
-#' predict(rez)
-#'
-#' # Clusters centers in long form
-#' attributes(rez)$means
-#'
-#' # Between and Total Sum of Squares
-#' attributes(rez)$Sum_Squares_Total
-#' attributes(rez)$Sum_Squares_Between
-#' }
 #' @export
 model_parameters.kmeans <- function(model, ...) {
   params <- cbind(
@@ -64,32 +38,6 @@ model_parameters.kmeans <- function(model, ...) {
 # factoextra::hkmeans -----------------------------------------------------
 
 
-
-#' @rdname model_parameters.kmeans
-#' @inheritParams cluster_centers
-#'
-#' @examples
-#' \donttest{
-#' #
-#' # Hierarchical K-means (factoextra::hkclust) ----------------------
-#' if (require("factoextra", quietly = TRUE)) {
-#'   data <- iris[1:4]
-#'   model <- factoextra::hkmeans(data, k = 3)
-#'
-#'   rez <- model_parameters(model)
-#'   rez
-#'
-#'   # Get clusters
-#'   predict(rez)
-#'
-#'   # Clusters centers in long form
-#'   attributes(rez)$means
-#'
-#'   # Between and Total Sum of Squares
-#'   attributes(rez)$Sum_Squares_Total
-#'   attributes(rez)$Sum_Squares_Between
-#' }
-#' }
 #' @export
 model_parameters.hkmeans <- model_parameters.kmeans
 
@@ -98,8 +46,6 @@ model_parameters.hkmeans <- model_parameters.kmeans
 # Methods -------------------------------------------------------------------
 
 
-
-
 #' @export
 print.parameters_clusters <- function(x, digits = 2, ...) {
   clusterHeading <- "# Clustering Solution"

diff --git a/R/methods_mclust.R b/R/methods_mclust.R
@@ -1,10 +1,3 @@
-#' @rdname model_parameters.kmeans
-#'
-#' @examples
-#' if (require("mclust", quietly = TRUE)) {
-#'   model <- mclust::Mclust(iris[1:4], verbose = FALSE)
-#'   model_parameters(model)
-#' }
 #' @export
 model_parameters.Mclust <- function(model, data = NULL, clusters = NULL, ...) {
   if (is.null(data)) data <- as.data.frame(model$data)

diff --git a/R/methods_pam.R b/R/methods_pam.R
@@ -1,18 +1,3 @@
-#' @rdname model_parameters.kmeans
-#'
-#' @examples
-#' \donttest{
-#' #
-#' # K-Medoids (PAM and HPAM) ==============
-#' if (require("cluster", quietly = TRUE)) {
-#'   model <- cluster::pam(iris[1:4], k = 3)
-#'   model_parameters(model)
-#' }
-#' if (require("fpc", quietly = TRUE)) {
-#'   model <- fpc::pamk(iris[1:4], criterion = "ch")
-#'   model_parameters(model)
-#' }
-#' }
 #' @export
 model_parameters.pam <- function(model, data = NULL, clusters = NULL, ...) {
   if (is.null(data)) data <- as.data.frame(model$data)

diff --git a/man/cluster_performance.Rd b/man/cluster_performance.Rd