# Comparing soft and hierarchical clusterings with element-centric similarity

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')

    mean(df.iris$cmeans.hc.ecs)
    #> [1] 0.614915

## Session info

    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