Skip to content

Commit 909c050

Browse files
strengejackestrengejacke
committed
cluster
1 parent d3ca9a2 commit 909c050

12 files changed

+188
-349
lines changed

‎R/1_model_parameters.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@
1616
#' - [Bayesian][model_parameters.stanreg()]: **BayesFactor**, **blavaan**, **brms**,
1717
#' **MCMCglmm**, **posterior**, **rstanarm**, `bayesQR`, `bcplm`, `BGGM`, `blmrm`,
1818
#' `blrm`, `mcmc.list`, `MCMCglmm`, ...
19-
#' - [Clustering][model_parameters.kmeans()]: **hclust**, **kmeans**, **mclust**, **pam**, ...
19+
#' - [Clustering][model_parameters.hclust()]: **hclust**, **kmeans**, **mclust**, **pam**, ...
2020
#' - [Correlations, t-tests, etc.][model_parameters.htest()]: **lmtest**, `htest`,
2121
#' `pairwise.htest`, ...
2222
#' - [Meta-Analysis][model_parameters.rma()]: **metaBMA**, **metafor**, **metaplus**, ...

‎R/cluster_performance.R‎

Lines changed: 11 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -2,19 +2,28 @@
22
#'
33
#' Compute performance indices for clustering solutions.
44
#'
5-
#' @inheritParams model_parameters.kmeans
5+
#' @inheritParams model_parameters.hclust
66
#'
77
#' @examples
88
#' # kmeans
99
#' model <- kmeans(iris[1:4], 3)
1010
#' cluster_performance(model)
11+
#'
12+
#' # hclust
13+
#' data <- iris[1:4]
14+
#' model <- hclust(dist(data))
15+
#' clusters <- cutree(model, 3)
16+
#' cluster_performance(model, data, clusters)
17+
#'
18+
#' # Retrieve performance from parameters
19+
#' params <- model_parameters(kmeans(iris[1:4], 3))
20+
#' cluster_performance(params)
1121
#' @export
1222
cluster_performance <- function(model, ...) {
1323
UseMethod("cluster_performance")
1424
}
1525

1626

17-
#' @rdname cluster_performance
1827
#' @export
1928
cluster_performance.kmeans <- function(model, ...) {
2029
out <- as.data.frame(model[c("totss", "betweenss", "tot.withinss")])
@@ -29,18 +38,7 @@ cluster_performance.kmeans <- function(model, ...) {
2938
}
3039

3140

32-
33-
34-
3541
#' @rdname cluster_performance
36-
#' @examples
37-
#' # hclust
38-
#' data <- iris[1:4]
39-
#' model <- hclust(dist(data))
40-
#' clusters <- cutree(model, 3)
41-
#'
42-
#' rez <- cluster_performance(model, data, clusters)
43-
#' rez
4442
#' @export
4543
cluster_performance.hclust <- function(model, data, clusters, ...) {
4644
if (is.null(data)) {
@@ -60,13 +58,6 @@ cluster_performance.hclust <- function(model, data, clusters, ...) {
6058
}
6159

6260

63-
#' @rdname cluster_performance
64-
#' @examplesIf require("dbscan", quietly = TRUE)
65-
#' # DBSCAN
66-
#' model <- dbscan::dbscan(iris[1:4], eps = 1.45, minPts = 10)
67-
#'
68-
#' rez <- cluster_performance(model, iris[1:4])
69-
#' rez
7061
#' @export
7162
cluster_performance.dbscan <- function(model, data, ...) {
7263
if (is.null(data)) {
@@ -84,12 +75,6 @@ cluster_performance.dbscan <- function(model, data, ...) {
8475
# Base --------------------------------------------------------------------
8576

8677

87-
88-
#' @rdname cluster_performance
89-
#' @examples
90-
#' # Retrieve performance from parameters
91-
#' params <- model_parameters(kmeans(iris[1:4], 3))
92-
#' cluster_performance(params)
9378
#' @export
9479
cluster_performance.parameters_clusters <- function(model, ...) {
9580
valid <- model$Cluster != 0 & model$Cluster != "0" # Valid clusters

‎R/methods_dbscan.R‎

Lines changed: 0 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -1,30 +1,3 @@
1-
#' @rdname model_parameters.kmeans
2-
#' @inheritParams cluster_centers
3-
#'
4-
#' @examples
5-
#' \donttest{
6-
#' # DBSCAN ---------------------------
7-
#' if (require("dbscan", quietly = TRUE)) {
8-
#' model <- dbscan::dbscan(iris[1:4], eps = 1.45, minPts = 10)
9-
#'
10-
#' rez <- model_parameters(model, iris[1:4])
11-
#' rez
12-
#'
13-
#' # Get clusters
14-
#' predict(rez)
15-
#'
16-
#' # Clusters centers in long form
17-
#' attributes(rez)$means
18-
#'
19-
#' # Between and Total Sum of Squares
20-
#' attributes(rez)$Sum_Squares_Total
21-
#' attributes(rez)$Sum_Squares_Between
22-
#'
23-
#' # HDBSCAN
24-
#' model <- dbscan::hdbscan(iris[1:4], minPts = 10)
25-
#' model_parameters(model, iris[1:4])
26-
#' }
27-
#' }
281
#' @export
292
model_parameters.dbscan <- function(model, data = NULL, clusters = NULL, ...) {
303
if (is.null(data)) {

‎R/methods_hclust.R‎

Lines changed: 71 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,29 @@
1-
#' @rdname model_parameters.kmeans
2-
#' @inheritParams cluster_centers
1+
#' Parameters from Cluster Models (k-means, ...)
2+
#'
3+
#' Format cluster models obtained for example by [kmeans()].
4+
#'
5+
#' @param model Cluster model.
6+
#' @inheritParams model_parameters.default
7+
#' @param ... Arguments passed to or from other methods.
8+
#'
9+
#' @examplesIf require("factoextra", quietly = TRUE) && require("dbscan", quietly = TRUE) && require("cluster", quietly = TRUE) && require("fpc", quietly = TRUE)
10+
#' \donttest{
11+
#' #
12+
#' # K-means -------------------------------
13+
#' model <- kmeans(iris[1:4], centers = 3)
14+
#' rez <- model_parameters(model)
15+
#' rez
16+
#'
17+
#' # Get clusters
18+
#' predict(rez)
19+
#'
20+
#' # Clusters centers in long form
21+
#' attributes(rez)$means
22+
#'
23+
#' # Between and Total Sum of Squares
24+
#' attributes(rez)$Sum_Squares_Total
25+
#' attributes(rez)$Sum_Squares_Between
326
#'
4-
#' @examples
527
#' #
628
#' # Hierarchical clustering (hclust) ---------------------------
729
#' data <- iris[1:4]
@@ -20,6 +42,52 @@
2042
#' # Between and Total Sum of Squares
2143
#' attributes(rez)$Total_Sum_Squares
2244
#' attributes(rez)$Between_Sum_Squares
45+
#'
46+
#' #
47+
#' # Hierarchical K-means (factoextra::hkclust) ----------------------
48+
#' data <- iris[1:4]
49+
#' model <- factoextra::hkmeans(data, k = 3)
50+
#'
51+
#' rez <- model_parameters(model)
52+
#' rez
53+
#'
54+
#' # Get clusters
55+
#' predict(rez)
56+
#'
57+
#' # Clusters centers in long form
58+
#' attributes(rez)$means
59+
#'
60+
#' # Between and Total Sum of Squares
61+
#' attributes(rez)$Sum_Squares_Total
62+
#' attributes(rez)$Sum_Squares_Between
63+
#'
64+
#' # K-Medoids (PAM and HPAM) ==============
65+
#' model <- cluster::pam(iris[1:4], k = 3)
66+
#' model_parameters(model)
67+
#'
68+
#' model <- fpc::pamk(iris[1:4], criterion = "ch")
69+
#' model_parameters(model)
70+
#'
71+
#' # DBSCAN ---------------------------
72+
#' model <- dbscan::dbscan(iris[1:4], eps = 1.45, minPts = 10)
73+
#'
74+
#' rez <- model_parameters(model, iris[1:4])
75+
#' rez
76+
#'
77+
#' # Get clusters
78+
#' predict(rez)
79+
#'
80+
#' # Clusters centers in long form
81+
#' attributes(rez)$means
82+
#'
83+
#' # Between and Total Sum of Squares
84+
#' attributes(rez)$Sum_Squares_Total
85+
#' attributes(rez)$Sum_Squares_Between
86+
#'
87+
#' # HDBSCAN
88+
#' model <- dbscan::hdbscan(iris[1:4], minPts = 10)
89+
#' model_parameters(model, iris[1:4])
90+
#' }
2391
#' @export
2492
model_parameters.hclust <- function(model, data = NULL, clusters = NULL, ...) {
2593
if (is.null(data)) {
@@ -58,34 +126,6 @@ model_parameters.hclust <- function(model, data = NULL, clusters = NULL, ...) {
58126

59127

60128
#' @inheritParams n_clusters
61-
#' @rdname model_parameters.kmeans
62-
#' @examples
63-
#' \donttest{
64-
#' #
65-
#' # pvclust (finds "significant" clusters) ---------------------------
66-
#' if (require("pvclust", quietly = TRUE)) {
67-
#' data <- iris[1:4]
68-
#' # NOTE: pvclust works on transposed data
69-
#' model <- pvclust::pvclust(datawizard::data_transpose(data, verbose = FALSE),
70-
#' method.dist = "euclidean",
71-
#' nboot = 50,
72-
#' quiet = TRUE
73-
#' )
74-
#'
75-
#' rez <- model_parameters(model, data, ci = 0.90)
76-
#' rez
77-
#'
78-
#' # Get clusters
79-
#' predict(rez)
80-
#'
81-
#' # Clusters centers in long form
82-
#' attributes(rez)$means
83-
#'
84-
#' # Between and Total Sum of Squares
85-
#' attributes(rez)$Sum_Squares_Total
86-
#' attributes(rez)$Sum_Squares_Between
87-
#' }
88-
#' }
89129
#' @export
90130
model_parameters.pvclust <- function(model, data = NULL, clusters = NULL, ci = 0.95, ...) {
91131
if (is.null(data)) {

‎R/methods_kmeans.R‎

Lines changed: 0 additions & 54 deletions
Original file line numberDiff line numberDiff line change
@@ -1,29 +1,3 @@
1-
#' Parameters from Cluster Models (k-means, ...)
2-
#'
3-
#' Format cluster models obtained for example by [kmeans()].
4-
#'
5-
#' @param model Cluster model.
6-
#' @inheritParams model_parameters.default
7-
#' @param ... Arguments passed to or from other methods.
8-
#'
9-
#' @examples
10-
#' \donttest{
11-
#' #
12-
#' # K-means -------------------------------
13-
#' model <- kmeans(iris[1:4], centers = 3)
14-
#' rez <- model_parameters(model)
15-
#' rez
16-
#'
17-
#' # Get clusters
18-
#' predict(rez)
19-
#'
20-
#' # Clusters centers in long form
21-
#' attributes(rez)$means
22-
#'
23-
#' # Between and Total Sum of Squares
24-
#' attributes(rez)$Sum_Squares_Total
25-
#' attributes(rez)$Sum_Squares_Between
26-
#' }
271
#' @export
282
model_parameters.kmeans <- function(model, ...) {
293
params <- cbind(
@@ -64,32 +38,6 @@ model_parameters.kmeans <- function(model, ...) {
6438
# factoextra::hkmeans -----------------------------------------------------
6539

6640

67-
68-
#' @rdname model_parameters.kmeans
69-
#' @inheritParams cluster_centers
70-
#'
71-
#' @examples
72-
#' \donttest{
73-
#' #
74-
#' # Hierarchical K-means (factoextra::hkclust) ----------------------
75-
#' if (require("factoextra", quietly = TRUE)) {
76-
#' data <- iris[1:4]
77-
#' model <- factoextra::hkmeans(data, k = 3)
78-
#'
79-
#' rez <- model_parameters(model)
80-
#' rez
81-
#'
82-
#' # Get clusters
83-
#' predict(rez)
84-
#'
85-
#' # Clusters centers in long form
86-
#' attributes(rez)$means
87-
#'
88-
#' # Between and Total Sum of Squares
89-
#' attributes(rez)$Sum_Squares_Total
90-
#' attributes(rez)$Sum_Squares_Between
91-
#' }
92-
#' }
9341
#' @export
9442
model_parameters.hkmeans <- model_parameters.kmeans
9543

@@ -98,8 +46,6 @@ model_parameters.hkmeans <- model_parameters.kmeans
9846
# Methods -------------------------------------------------------------------
9947

10048

101-
102-
10349
#' @export
10450
print.parameters_clusters <- function(x, digits = 2, ...) {
10551
clusterHeading <- "# Clustering Solution"

‎R/methods_mclust.R‎

Lines changed: 0 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,3 @@
1-
#' @rdname model_parameters.kmeans
2-
#'
3-
#' @examples
4-
#' if (require("mclust", quietly = TRUE)) {
5-
#' model <- mclust::Mclust(iris[1:4], verbose = FALSE)
6-
#' model_parameters(model)
7-
#' }
81
#' @export
92
model_parameters.Mclust <- function(model, data = NULL, clusters = NULL, ...) {
103
if (is.null(data)) data <- as.data.frame(model$data)

‎R/methods_pam.R‎

Lines changed: 0 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,3 @@
1-
#' @rdname model_parameters.kmeans
2-
#'
3-
#' @examples
4-
#' \donttest{
5-
#' #
6-
#' # K-Medoids (PAM and HPAM) ==============
7-
#' if (require("cluster", quietly = TRUE)) {
8-
#' model <- cluster::pam(iris[1:4], k = 3)
9-
#' model_parameters(model)
10-
#' }
11-
#' if (require("fpc", quietly = TRUE)) {
12-
#' model <- fpc::pamk(iris[1:4], criterion = "ch")
13-
#' model_parameters(model)
14-
#' }
15-
#' }
161
#' @export
172
model_parameters.pam <- function(model, data = NULL, clusters = NULL, ...) {
183
if (is.null(data)) data <- as.data.frame(model$data)

‎man/cluster_performance.Rd‎

Lines changed: 2 additions & 22 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)