Arbres coupés et rectangles autour des clusters pour un dendrogramme horizontal dans R

Question

J'essaie de tracer les résultats d'un clustering hiérarchique dans R comme un dendrogramme, avec des rectangles identifiant des clusters.

Le code suivant fait l'affaire pour un dendrogramme vertical, mais pour un dendrogramme horizontal, (horiz=TRUE), les rectangles ne sont pas dessinés. Y a-t-il un moyen de faire de même pour les dendrogrammes horizontaux?

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

En outre, je voudrais tracer une ligne pour couper l'arbre à une valeur de distance souhaitée. Comment tracer cela dans R. La fonction cutree renvoie les clusters, mais est-il possible de le tracer aussi bien.

cutree(hca, k = 3) 

La sortie désirée que je cherche est comme ceci.

Comment cela se fasse dans la R?

Answer 1

Les deux jlhoward et réponses Backlin sont bons.

Ce que vous pouvez également essayer est d'utiliser le paquet dendextend, conçu exactement pour ce genre de chose. Il a une fonction rect.dendrogram qui fonctionne comme rect.hclust, mais avec un paramètre horiz (plus un peu plus de contrôle sur l'emplacement du bord du rect). Pour trouver la hauteur appropriée, vous pouvez utiliser la fonction heights_per_k.dendrogram (qui est beaucoup plus rapide si vous utilisez également le package dendextendRcpp)

Voici un exemple simple pour obtenir le même résultat que dans les exemples ci-dessus (avec un bonus supplémentaire) des branches de couleur, juste pour le plaisir):

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

Pour simplement faire le travail (bien que d'une manière assez laid), vous pouvez simplement échanger manuellement les coordonnées dans l'appel à rect en 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) 
} 

et appeler rhc comme vous avez appelé rect.hclust:

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

Answer 3

est ici une solution à l'aide ggplot et le paquet ggdendro. En prime, on peut colorer les étiquettes par grappe ...

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