factoextra包–层次聚类图美化

Xwyturbo / 2022-11-15

  library(readxl)
  library(tidyverse)

## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.3.6      ✔ purrr   0.3.5 
## ✔ tibble  3.1.8      ✔ dplyr   1.0.10
## ✔ tidyr   1.2.1      ✔ stringr 1.4.1 
## ✔ readr   2.1.3      ✔ forcats 0.5.2 
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()

  library(ggpubr)
  library(factoextra)

## Warning: package 'factoextra' was built under R version 4.2.2

## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa

  sd_dataset <- read_xlsx("D:/wenyu/Rrojects/sui_de/sui_de_1107/sd_dataset.xlsx")
  
  #  层次聚类，先生成距离矩阵。
  d1 <- dist(sd_dataset[,15:28],"canberra")
  hc7 <- hclust(d1,"ward.D2")
  tree = as.dendrogram(hc7)
  
  c2 <- cutree(hc7,2)
  table(c2)

## c2
##   1   2 
## 244 421

  plot(cut(tree, h=25)$upper, horiz=FALSE)
  rect.hclust(hc7,2)

  c3 <- cutree(hc7,3)
  table(c3)

## c3
##   1   2   3 
## 244 149 272

  plot(cut(tree, h=25)$upper, horiz=FALSE)
  rect.hclust(hc7,3)

  c4 <- cutree(hc7,4)
  table(c4)

## c4
##   1   2   3   4 
## 244 149 193  79

  plot(cut(tree, h=25)$upper, horiz=FALSE)
  rect.hclust(hc7,4)

  c5 <- cutree(hc7,5)
  table(c5)

## c5
##   1   2   3   4   5 
## 108 149 136 193  79

  plot(cut(tree, h=25)$upper, horiz=FALSE)
  rect.hclust(hc7,5)

  #install.packages('ggdendro')
  #install.packages('factoextra')
  library(ggdendro)

## Warning: package 'ggdendro' was built under R version 4.2.2

  library(ggplot2)
  library(factoextra)
  library(ggpubr)
  library(ggsci)
  
  # 查询出版配色
  pal_aaas(palette = c("default"), alpha = 1)(5)

## [1] "#3B4992FF" "#EE0000FF" "#008B45FF" "#631879FF" "#008280FF"

  pal_npg(palette = c("nrc"), alpha = 1)(8)

## [1] "#E64B35FF" "#4DBBD5FF" "#00A087FF" "#3C5488FF" "#F39B7FFF" "#8491B4FF"
## [7] "#91D1C2FF" "#DC0000FF"

  ggdendrogram(hc7)

  c5 <- cutree(hc7,5)
  table(c5)

## c5
##   1   2   3   4   5 
## 108 149 136 193  79

  c4 <- cutree(hc7,4)
  table(c4)

## c4
##   1   2   3   4 
## 244 149 193  79

  c3 <- cutree(hc7,3)
  table(c3)

## c3
##   1   2   3 
## 244 149 272

  c2 <- cutree(hc7,2)
  table(c2)

## c2
##   1   2 
## 244 421

  p52 <- fviz_dend(hc7,k = 2,
            xlab = "",
            ylab = "Height",
            main = "",
            k_colors = c("#3B4992FF","#EE0000FF"),
            ggtheme = theme_bw())

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

p52

  p53 <- fviz_dend(hc7,k = 3,
                   xlab = "",
                   ylab = "Height",
                   main = "",
                   k_colors = c("#3B4992FF","#EE0000FF","#008B45FF"),
                   ggtheme = theme_bw())

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

p53

  p54 <- fviz_dend(hc7,k = 4,
                   xlab = "",
                   ylab = "Height",
                   main = "",
                   k_colors = c("#3B4992FF","#EE0000FF",
                                "#008B45FF","#631879FF"),
                   ggtheme = theme_bw())

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

p54

  p55 <- fviz_dend(hc7,k = 5,
                   xlab = "",
                   ylab = "Height",
                   main = "",
                   k_colors = c("#3B4992FF","#F39B7FFF",
                                "#EE0000FF",
                                "#008280FF","#631879FF"),
                   ggtheme = theme_bw())

## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

p55

  # ggexport(p52,filename = "聚类谱系图2.tiff",
  #          width = 2000,height = 2000,
  #          res = 600)   ##批量注释Ctrl+shift+C