Albero tagliato e rettangoli intorno ai cluster per un dendrogramma orizzontale in R

Question

Sto provando a tracciare i risultati di un clustering gerarchico in R come un dendrogramma, con rettangoli che identificano i cluster.

Il seguente codice fa il trucco per un dendrogramma verticale, ma per un dendrogramma orizzontale, (horiz=TRUE), i rettangoli non vengono disegnati. C'è un modo per fare lo stesso anche per i dendrogrammi orizzontali.

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

Inoltre vorrei tracciare una linea per tagliare l'albero ad un valore di distanza desiderato. Come tracciarlo in R. La funzione cutree restituisce i cluster, ma è anche possibile tracciarla.

cutree(hca, k = 3) 

L'output desiderato che sto cercando è come questo.

Come arrivare a questo fatto in R?

Answer 1

Sia jlhoward e risposte Backlin sono buoni.

Quello che si potrebbe provare è utilizzare il pacchetto dendextend, progettato esattamente per questo genere di cose. Ha una funzione rect.dendrogram che funziona come rect.hclust, ma con un parametro horiz (più un certo controllo sulla posizione del bordo del rect). Per trovare l'altezza rilevante puoi usare la funzione heights_per_k.dendrogram (che è molto più veloce quando usi anche il pacchetto dendextendRcpp)

Ecco un semplice esempio di come si otterrebbe lo stesso risultato degli esempi precedenti (con un ulteriore vantaggio di rami colorati, solo per divertimento):

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

Per ottenere solo il lavoro fatto (anche se in modo abbastanza brutto) si può solo scambiare manualmente le coordinate nella chiamata a rect in 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) 
} 

e chiamare rhc come hai chiamato rect.hclust:

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

Answer 3

Ecco una soluzione che utilizza ggplot e il pacchetto ggdendro. Come bonus aggiuntivo, si possono colorare le etichette per cluster ...

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