In this vignette we will illustrate how element-centric similarity can be used to compare different kinds of clustering results: flat disjoint clusterings, flat overlapping clusterings, and hierarchical clusterings.
library(ClustAssess)
library(e1071)
library(dbscan)
library(ggplot2)
suppressPackageStartupMessages(library(dendextend))
# we will use the Iris dataset for this vignette
data = as.matrix(iris[,1:4])
df.iris = as.data.frame(prcomp(data)$x)
df.iris$species = iris$Species
ggplot(df.iris, aes(x=PC1, y=PC2, color=species)) +
geom_point() +
labs(title='Iris PCA')
Next, we cluster the data using three different approaches.
# a flat, disjoint clustering with DBscan
db.res = dbscan(data, eps=1)$cluster
df.iris$db.cluster = as.factor(db.res)
ggplot(df.iris, aes(x=PC1, y=PC2, color=db.cluster)) +
geom_point() +
labs(title='DBScan clustering')
# an overlapping clustering with soft k-means
cmeans.res = cmeans(data, centers=6)$membership
# get the strongest cluster assignment for each observation to plot
# but we will still use the soft cluster assignments to calculate ECS
df.iris$cmeans.cluster = as.factor(apply(cmeans.res, 1, which.max))
ggplot(df.iris, aes(x=PC1, y=PC2, color=cmeans.cluster)) +
geom_point() +
labs(title='c-means clustering')
# a hierarchical clustering
distances = dist(data, method='euclidean')
hc.res = hclust(distances, method='complete')
# plot the resulting dendrogram
node.colors = c('blue', 'red', 'green')
hc.res %>% as.dendrogram() %>%
set("leaves_pch", 19) %>%
set("leaves_cex", 0.5) %>%
set("leaves_col", node.colors[df.iris$species]) %>%
plot(main='Complete linkage hierarchical clustering', leaflab='none')
Now, we will compare the clustering results using element-centric similarity. ECS allows us to compare different kinds of clustering results, including the overlapping clustering and the hierarchical clustering we just calculated. The results tell us how similarly each observation was clustered by the two methods; the higher the ECS, the more similar the clustering of that observation.
# which observations are clustered more similarly?
# first compare flat disjoint and flat soft clusterings
df.iris$dbscan.cmeans.ecs = element_sim_elscore(db.res,
cmeans.res)
ggplot(df.iris, aes(x=PC1, y=PC2, color=dbscan.cmeans.ecs)) +
geom_point() +
labs(title='DBScan vs c-means similarity')
mean(df.iris$dbscan.cmeans.ecs)
#> [1] 0.4675256
# next compare flat disjoint and hierarchical disjoint clusterings
df.iris$dbscan.hc.ecs = element_sim_elscore(db.res,
hc.res)
ggplot(df.iris, aes(x=PC1, y=PC2, color=dbscan.hc.ecs)) +
geom_point() +
labs(title='DBScan vs hclust similarity')
mean(df.iris$dbscan.hc.ecs)
#> [1] 0.5875193
# finally compare flat soft and hierarchical disjoint clusterings
df.iris$cmeans.hc.ecs = element_sim_elscore(cmeans.res,
hc.res)
ggplot(df.iris, aes(x=PC1, y=PC2, color=cmeans.hc.ecs)) +
geom_point() +
labs(title='c-means vs hclust similarity')
sessionInfo()
#> R version 4.0.3 (2020-10-10)
#> Platform: x86_64-pc-linux-gnu (64-bit)
#> Running under: Debian GNU/Linux 10 (buster)
#>
#> Matrix products: default
#> BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.8.0
#> LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.8.0
#>
#> locale:
#> [1] LC_CTYPE=en_GB.UTF-8 LC_NUMERIC=C
#> [3] LC_TIME=en_GB.UTF-8 LC_COLLATE=C
#> [5] LC_MONETARY=en_GB.UTF-8 LC_MESSAGES=en_GB.UTF-8
#> [7] LC_PAPER=en_GB.UTF-8 LC_NAME=C
#> [9] LC_ADDRESS=C LC_TELEPHONE=C
#> [11] LC_MEASUREMENT=en_GB.UTF-8 LC_IDENTIFICATION=C
#>
#> attached base packages:
#> [1] stats graphics grDevices utils datasets methods base
#>
#> other attached packages:
#> [1] dendextend_1.15.2 ggplot2_3.3.5 dbscan_1.1-9 e1071_1.7-9
#> [5] ClustAssess_0.3.0 SeuratObject_4.0.4 Seurat_4.1.0
#>
#> loaded via a namespace (and not attached):
#> [1] Rtsne_0.15 colorspace_2.0-2 deldir_1.0-6
#> [4] class_7.3-20 ellipsis_0.3.2 ggridges_0.5.3
#> [7] proxy_0.4-26 spatstat.data_2.1-2 farver_2.1.0
#> [10] leiden_0.3.9 listenv_0.8.0 ggrepel_0.9.1
#> [13] fansi_1.0.0 codetools_0.2-18 splines_4.0.3
#> [16] knitr_1.37 polyclip_1.10-0 jsonlite_1.7.2
#> [19] ica_1.0-2 cluster_2.1.2 png_0.1-7
#> [22] uwot_0.1.11 shiny_1.7.1 sctransform_0.3.3
#> [25] spatstat.sparse_2.1-0 compiler_4.0.3 httr_1.4.2
#> [28] assertthat_0.2.1 Matrix_1.4-0 fastmap_1.1.0
#> [31] lazyeval_0.2.2 later_1.3.0 prettyunits_1.1.1
#> [34] htmltools_0.5.2 tools_4.0.3 igraph_1.2.11
#> [37] gtable_0.3.0 glue_1.6.0 RANN_2.6.1
#> [40] reshape2_1.4.4 dplyr_1.0.7 Rcpp_1.0.8
#> [43] scattermore_0.7 jquerylib_0.1.4 vctrs_0.3.8
#> [46] nlme_3.1-155 iterators_1.0.13 lmtest_0.9-39
#> [49] fastcluster_1.2.3 xfun_0.29 stringr_1.4.0
#> [52] globals_0.14.0 mime_0.12 miniUI_0.1.1.1
#> [55] lifecycle_1.0.1 irlba_2.3.5 goftest_1.2-3
#> [58] future_1.23.0 MASS_7.3-55 zoo_1.8-9
#> [61] scales_1.1.1 spatstat.core_2.3-2 hms_1.1.1
#> [64] promises_1.2.0.1 spatstat.utils_2.3-0 parallel_4.0.3
#> [67] RColorBrewer_1.1-2 yaml_2.2.1 reticulate_1.22
#> [70] pbapply_1.5-0 gridExtra_2.3 sass_0.4.0
#> [73] rpart_4.1-15 stringi_1.7.6 highr_0.9
#> [76] foreach_1.5.1 rlang_0.4.12 pkgconfig_2.0.3
#> [79] matrixStats_0.61.0 evaluate_0.14 lattice_0.20-45
#> [82] ROCR_1.0-11 purrr_0.3.4 tensor_1.5
#> [85] labeling_0.4.2 patchwork_1.1.1 htmlwidgets_1.5.4
#> [88] cowplot_1.1.1 tidyselect_1.1.1 parallelly_1.30.0
#> [91] RcppAnnoy_0.0.19 plyr_1.8.6 magrittr_2.0.1
#> [94] R6_2.5.1 generics_0.1.1 DBI_1.1.2
#> [97] withr_2.4.3 pillar_1.6.4 mgcv_1.8-38
#> [100] fitdistrplus_1.1-6 survival_3.2-13 abind_1.4-5
#> [103] tibble_3.1.6 future.apply_1.8.1 crayon_1.4.2
#> [106] KernSmooth_2.23-20 utf8_1.2.2 spatstat.geom_2.3-1
#> [109] plotly_4.10.0 rmarkdown_2.11 viridis_0.6.2
#> [112] progress_1.2.2 grid_4.0.3 data.table_1.14.2
#> [115] digest_0.6.29 xtable_1.8-4 tidyr_1.1.4
#> [118] httpuv_1.6.5 munsell_0.5.0 viridisLite_0.4.0
#> [121] bslib_0.3.1