2014-01-31 5 views
14

Didzis Elferts показал, как построить с dendogram использованием ggplot2 и ggdendro:Раскрасить Кластеры в Dendogram с ggplot2

horizontal dendrogram in R with labels

вот код:

labs = paste("sta_",1:50,sep="") #new labels 
rownames(USArrests)<-labs #set new row names 
hc <- hclust(dist(USArrests), "ave") 

library(ggplot2) 
library(ggdendro) 

#convert cluster object to use with ggplot 
dendr <- dendro_data(hc, type="rectangle") 

#your own labels are supplied in geom_text() and label=label 
ggplot() + 
    geom_segment(data=segment(dendr), aes(x=x, y=y, xend=xend, yend=yend)) + 
    geom_text(data=label(dendr), aes(x=x, y=y, label=label, hjust=0), size=3) + 
    coord_flip() + scale_y_reverse(expand=c(0.2, 0)) + 
    theme(axis.line.y=element_blank(), 
     axis.ticks.y=element_blank(), 
     axis.text.y=element_blank(), 
     axis.title.y=element_blank(), 
     panel.background=element_rect(fill="white"), 
     panel.grid=element_blank()) 

Кто-нибудь знает, как раскрасить разные кластеры? Например, вы хотите раскрасить 2 кластера (k = 2)?

ответ

15

Временное решение было бы построить кластерный объект с plot() и затем использовать функцию rect.hclust() нарисовать границу вокруг кластеров (Nunber кластеров устанавливается с помощью аргумента k=). Если результат rect.hclust() сохраняется как объект, он будет составлять список наблюдений, где каждый элемент списка содержит наблюдения, относящиеся к каждому кластеру.

plot(hc) 
gg<-rect.hclust(hc,k=2) 

Теперь этот список может быть преобразован в dataframe, где столбец clust содержит имена для кластеров (в этом примере две группы) - имена повторяются в соответствии с длиной списка elemets.

clust.gr<-data.frame(num=unlist(gg), 
    clust=rep(c("Clust1","Clust2"),times=sapply(gg,length))) 
head(clust.gr) 
     num clust 
sta_1 1 Clust1 
sta_2 2 Clust1 
sta_3 3 Clust1 
sta_5 5 Clust1 
sta_8 8 Clust1 
sta_9 9 Clust1 

кадр Новые данные объединяются с label() информации dendr объекта (dendro_data() результат).

text.df<-merge(label(dendr),clust.gr,by.x="label",by.y="row.names") 
head(text.df) 
    label x y num clust 
1 sta_1 8 0 1 Clust1 
2 sta_10 28 0 10 Clust2 
3 sta_11 41 0 11 Clust2 
4 sta_12 31 0 12 Clust2 
5 sta_13 10 0 13 Clust1 
6 sta_14 37 0 14 Clust2 

При построении использования дендрограммы text.df добавлять метки с geom_text() и использовать колонку clust для цветов.

ggplot() + 
    geom_segment(data=segment(dendr), aes(x=x, y=y, xend=xend, yend=yend)) + 
    geom_text(data=text.df, aes(x=x, y=y, label=label, hjust=0,color=clust), size=3) + 
    coord_flip() + scale_y_reverse(expand=c(0.2, 0)) + 
    theme(axis.line.y=element_blank(), 
     axis.ticks.y=element_blank(), 
     axis.text.y=element_blank(), 
     axis.title.y=element_blank(), 
     panel.background=element_rect(fill="white"), 
     panel.grid=element_blank()) 

enter image description here

13

Этот подход очень похож на @DidzisElferts', только немного проще.

df <- USArrests     # really bad idea to muck up internal datasets 
labs <- paste("sta_",1:50,sep="") # new labels 
rownames(df) <- labs    # set new row names 

library(ggplot2) 
library(ggdendro) 
hc  <- hclust(dist(df), "ave")   # heirarchal clustering 
dendr <- dendro_data(hc, type="rectangle") # convert for ggplot 
clust <- cutree(hc,k=2)     # find 2 clusters 
clust.df <- data.frame(label=names(clust), cluster=factor(clust)) 
# dendr[["labels"]] has the labels, merge with clust.df based on label column 
dendr[["labels"]] <- merge(dendr[["labels"]],clust.df, by="label") 
# plot the dendrogram; note use of color=cluster in geom_text(...) 
ggplot() + 
    geom_segment(data=segment(dendr), aes(x=x, y=y, xend=xend, yend=yend)) + 
    geom_text(data=label(dendr), aes(x, y, label=label, hjust=0, color=cluster), 
      size=3) + 
    coord_flip() + scale_y_reverse(expand=c(0.2, 0)) + 
    theme(axis.line.y=element_blank(), 
     axis.ticks.y=element_blank(), 
     axis.text.y=element_blank(), 
     axis.title.y=element_blank(), 
     panel.background=element_rect(fill="white"), 
     panel.grid=element_blank()) 

+0

+1 я новое, что есть еще одна функция, чтобы сократить дендрограммы, но забыл о cutree :) –

10

Добавление к @DidzisElferts' и код @ jlhoward, в сам дендрограммы может быть окрашена.

library(ggplot2) 
library(ggdendro) 
library(plyr) 
library(zoo) 

df <- USArrests      # really bad idea to muck up internal datasets 
labs <- paste("sta_", 1:50, sep = "") # new labels 
rownames(df) <- labs     # set new row names 

cut <- 4 # Number of clusters 
hc <- hclust(dist(df), "ave")    # hierarchical clustering 
dendr <- dendro_data(hc, type = "rectangle") 
clust <- cutree(hc, k = cut)    # find 'cut' clusters 
clust.df <- data.frame(label = names(clust), cluster = clust) 

# Split dendrogram into upper grey section and lower coloured section 
height <- unique(dendr$segments$y)[order(unique(dendr$segments$y), decreasing = TRUE)] 
cut.height <- mean(c(height[cut], height[cut-1])) 
dendr$segments$line <- ifelse(dendr$segments$y == dendr$segments$yend & 
    dendr$segments$y > cut.height, 1, 2) 
dendr$segments$line <- ifelse(dendr$segments$yend > cut.height, 1, dendr$segments$line) 

# Number the clusters 
dendr$segments$cluster <- c(-1, diff(dendr$segments$line)) 
change <- which(dendr$segments$cluster == 1) 
for (i in 1:cut) dendr$segments$cluster[change[i]] = i + 1 
dendr$segments$cluster <- ifelse(dendr$segments$line == 1, 1, 
      ifelse(dendr$segments$cluster == 0, NA, dendr$segments$cluster)) 
dendr$segments$cluster <- na.locf(dendr$segments$cluster) 

# Consistent numbering between segment$cluster and label$cluster 
clust.df$label <- factor(clust.df$label, levels = levels(dendr$labels$label)) 
clust.df <- arrange(clust.df, label) 
clust.df$cluster <- factor((clust.df$cluster), levels = unique(clust.df$cluster), labels = (1:cut) + 1) 
dendr[["labels"]] <- merge(dendr[["labels"]], clust.df, by = "label") 

# Positions for cluster labels 
n.rle <- rle(dendr$segments$cluster) 
N <- cumsum(n.rle$lengths) 
N <- N[seq(1, length(N), 2)] + 1 
N.df <- dendr$segments[N, ] 
N.df$cluster <- N.df$cluster - 1 

# Plot the dendrogram 
ggplot() + 
    geom_segment(data = segment(dendr), 
     aes(x=x, y=y, xend=xend, yend=yend, size=factor(line), colour=factor(cluster)), 
     lineend = "square", show.legend = FALSE) + 
    scale_colour_manual(values = c("grey60", rainbow(cut))) + 
    scale_size_manual(values = c(.1, 1)) + 
    geom_text(data = N.df, aes(x = x, y = y, label = factor(cluster), colour = factor(cluster + 1)), 
     hjust = 1.5, show.legend = FALSE) + 
    geom_text(data = label(dendr), aes(x, y, label = label, colour = factor(cluster)), 
     hjust = -0.2, size = 3, show.legend = FALSE) + 
    scale_y_reverse(expand = c(0.2, 0)) + 
    labs(x = NULL, y = NULL) + 
    coord_flip() + 
    theme(axis.line.y = element_blank(), 
     axis.ticks.y = element_blank(), 
     axis.text.y = element_blank(), 
     axis.title.y = element_blank(), 
     panel.background = element_rect(fill = "white"), 
     panel.grid = element_blank()) 

В 2-кластере и 4-кластерные решения: enter image description here

+0

Muito Muito Бом! Obrigado. – Jean

+0

Ao utilizar o método "ward.D" em 'hclust()' tive problemas com as etiquetas dos grupos gráfico. Решение não consegui. Десятки alguma dica para isto? – Jean

+0

O que citei acima acontece também com o "ave". Этикетка кластер em 'clust.df' не обязательно совпадает с диаграммой производства !!! – Jean

2

Короткий путь для достижения аналогичного результата состоит в использовании пакета dendextend (производный от этого хорошего overview).

df <- USArrests # really bad idea to muck up internal datasets 
labs <- paste("sta_",1:50,sep="") # new labels 
rownames(df) <- labs # set new row names 

require(magittr) 
require(ggplot) 
require(dendextend) 

dend <- df %>% dist %>% 
    hclust %>% as.dendrogram %>% 
    set("branches_k_color", k = 4) %>% set("branches_lwd", 0.7) %>% 
    set("labels_cex", 0.6) %>% set("labels_colors", k = 4) %>% 
    set("leaves_pch", 19) %>% set("leaves_cex", 0.5) 
ggd1 <- as.ggdend(dend) 
ggplot(ggd1, horiz = TRUE) 

Примечание: порядок состояний несколько отличается от приведенных выше, но не меняется.

enter image description here

+0

При таком подходе, как мы можем указать 'hclust (DIST (Д.Ф., метод = "евклидово "), метод =" ward.D2")'? –

+0

https://stackoverflow.com/users/4057186/wr ... ДФ%>% расстояние (метод = "евклидовой")%>% hclust (метод = "ward.D2")%>% ... Просто пропустить первый аргумент в каждой функции, потому что это вещь, которую вы конвейер к нему –