Drzewo cięte i prostokąty wokół skupisk dla poziomego dendrogramu w R

Question

Próbuję narysować wyniki hierarchicznego grupowania w R jako dendrogram, z prostokątami identyfikującymi klastry.

Poniższy kod wykonuje triadę dla pionowego dendrogramu, ale dla poziomego dendrogramu (horiz=TRUE) prostokąty nie są rysowane. Czy istnieje sposób, aby zrobić to samo dla poziomych dendrogramów.

library("cluster") 
dst <- daisy(iris, metric = c("gower"), stand = FALSE) 
hca <- hclust(dst, method = "average") 
plot(as.dendrogram(hca), horiz = FALSE) 
rect.hclust(hca, k = 3, border = "red") 

Ponadto chciałbym wykreślić linię do cięcia drzewa o pożądanej wartości odległości. Jak wykreślić to w R. Funkcja cutree zwraca klastry, ale możliwe jest również wykreślić go.

cutree(hca, k = 3) 

Pożądany wynik, którego szukam, jest taki.

Jak aby to zrobić w R?

Answer 1

Zarówno jlhoward i odpowiedzi Backlin są dobre.

Co można również wypróbować, używając pakietu dendextend, zaprojektowanego specjalnie do tego typu rzeczy. Ma funkcję rect.dendrogram, która działa jak rect.hclust, ale z parametrem poziomym (plus trochę większą kontrolę nad położeniem krawędzi prostokąta). Aby znaleźć odpowiednią wysokość, możesz skorzystać z funkcji heights_per_k.dendrogram (która jest znacznie szybsza, gdy używasz także pakietu).

Oto prosty przykład, jak uzyskać taki sam wynik jak w powyższych przykładach (z dodatkowym bonusem kolorowych gałęzi, po prostu dla zabawy):

install.packages("dendextend") 
install.packages("dendextendRcpp") 

library("dendextend") 
library("dendextendRcpp") 

# using piping to get the dend 
dend <- iris[,-5] %>% dist %>% hclust %>% as.dendrogram 

# plot + color the dend's branches before, based on 3 clusters: 
dend %>% color_branches(k=3) %>% plot(horiz=TRUE, main = "The dendextend package \n Gives extended functionality to R's dendrogram object") 

# add horiz rect 
dend %>% rect.dendrogram(k=3,horiz=TRUE) 

# add horiz (well, vertical) line: 
abline(v = heights_per_k.dendrogram(dend)["3"] + .6, lwd = 2, lty = 2, col = "blue") 

Answer 2

po prostu otrzymać pracę (choć w dość brzydki sposób) można po prostu ręcznie zamienić współrzędne w wywołaniu rect w rect.hclust:

rhc <- function (tree, k = NULL, which = NULL, x = NULL, h = NULL, border = 2, 
    cluster = NULL) 
{ 
    if (length(h) > 1L | length(k) > 1L) 
     stop("'k' and 'h' must be a scalar") 
    if (!is.null(h)) { 
     if (!is.null(k)) 
      stop("specify exactly one of 'k' and 'h'") 
     k <- min(which(rev(tree$height) < h)) 
     k <- max(k, 2) 
    } 
    else if (is.null(k)) 
     stop("specify exactly one of 'k' and 'h'") 
    if (k < 2 | k > length(tree$height)) 
     stop(gettextf("k must be between 2 and %d", length(tree$height)), 
      domain = NA) 
    if (is.null(cluster)) 
     cluster <- cutree(tree, k = k) 
    clustab <- table(cluster)[unique(cluster[tree$order])] 
    m <- c(0, cumsum(clustab)) 
    if (!is.null(x)) { 
     if (!is.null(which)) 
      stop("specify exactly one of 'which' and 'x'") 
     which <- x 
     for (n in seq_along(x)) which[n] <- max(which(m < x[n])) 
    } 
    else if (is.null(which)) 
     which <- 1L:k 
    if (any(which > k)) 
     stop(gettextf("all elements of 'which' must be between 1 and %d", 
      k), domain = NA) 
    border <- rep_len(border, length(which)) 
    retval <- list() 
    for (n in seq_along(which)) { 
     rect(
      ybottom = m[which[n]] + 0.66, 
      xright = par("usr")[3L], 
      ytop = m[which[n] + 1] + 0.33, 
      xleft = mean(rev(tree$height)[(k - 1):k]), 
      border = border[n]) 
     retval[[n]] <- which(cluster == as.integer(names(clustab)[which[n]])) 
    } 
    invisible(retval) 
} 

i nazywają rhc jak nazwałeś rect.hclust:

rhc(hca, k = 3, border = "red") 

Answer 3

Oto rozwiązanie przy użyciu ggplot i pakiet ggdendro. Jako dodatkowy bonus, możemy pokolorować etykiety przez klaster ...

library(cluster) 
dst <- daisy(iris, metric = c("gower"), stand = FALSE) 
hca <- hclust(dst, method = "average") 
k  <- 3 
clust <- cutree(hca,k=k) # k clusters 

library(ggplot2) 
library(ggdendro)  # for dendro_data(...) 
dendr <- dendro_data(hca, type="rectangle") # convert for ggplot 
clust.df <- data.frame(label=rownames(iris), cluster=factor(clust)) 
dendr[["labels"]] <- merge(dendr[["labels"]],clust.df, by="label") 
rect <- aggregate(x~cluster,label(dendr),range) 
rect <- data.frame(rect$cluster,rect$x) 
ymax <- mean(hca$height[length(hca$height)-((k-2):(k-1))]) 

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) + 
    geom_rect(data=rect, aes(xmin=X1-.3, xmax=X2+.3, ymin=0, ymax=ymax), 
      color="red", fill=NA)+ 
    geom_hline(yintercept=0.33, color="blue")+ 
    coord_flip() + scale_y_reverse(expand=c(0.2, 0)) + 
    theme_dendro()