r - 如何根据 R 树形图中的类对分支进行着色？

Question

我希望可视化聚类算法的表现(具有一定的距离度量)。我有样本及其相应的类。 为了可视化，我进行了聚类，并希望根据聚类中的项目对树状图的分​​支进行着色。颜色将是层次集群中大多数项目对应的颜色(由数据\类给出)。

示例:如果我的聚类算法选择索引 1,21,24 作为某个聚类(在某个级别)，并且我有一个 csv 文件，每行中包含与 1,2,1 相对应的类号。我希望这条边的颜色为 1。

示例代码:

require(cluster)
suppressPackageStartupMessages(library(dendextend))
dir <- 'distance_metrics/'
filename <- 'aligned.csv'
my.data <- read.csv(paste(dir, filename, sep=""), header = T, row.names = 1)
my.dist <- as.dist(my.data)
real.clusters <-read.csv("clusters", header = T, row.names = 1)
clustered <- diana(my.dist)
# dend <- colour_branches(???dend, max(real.clusters)???)
plot(dend)

编辑: 另一个示例部分代码

dir <- 'distance_metrics/' # csv in here contains a symmetric matrix
clust.dir <- "clusters/" #csv in here contains a column vector with classes
my.data <- read.csv(paste(dir, filename, sep=""), header = T, row.names = 1)
filename <- 'table.csv'
my.dist <- as.dist(my.data)
real.clusters <-read.csv(paste(clust.dir, filename, sep=""), header = T, row.names = 1)
clustered <- diana(my.dist)
dnd <- as.dendrogram(clustered)

Answer 1

可以使用dendrapply在“树状图”对象(只是深度嵌套的列表)上递归设置节点和边缘颜色属性。 cluster 包还为“diana”类对象提供了一个 as.dendrogram 方法，因此对象类型之间的转换是无缝的。使用 diana 聚类并借用 @Edvardoss iris 示例中的一些代码，您可以创建彩色树状图，如下所示:

library(cluster)
set.seed(999)
iris2 <- iris[sample(x = 1:150,size = 50,replace = F),]
clust <- diana(iris2)
dnd <- as.dendrogram(clust)

## Duplicate rownames aren't allowed, so we need to set the "labels"
## attributes recursively. We also label inner nodes here. 
rectify_labels <- function(node, df){
  newlab <- df$Species[unlist(node, use.names = FALSE)]
  attr(node, "label") <- (newlab)
  return(node)
}
dnd <- dendrapply(dnd, rectify_labels, df = iris2)

## Create a color palette as a data.frame with one row for each spp
uniqspp <- as.character(unique(iris$Species))
colormap <- data.frame(Species = uniqspp, color = rainbow(n = length(uniqspp)))
colormap[, 2] <- c("red", "blue", "green")
colormap

## Now color the inner dendrogram edges
color_dendro <- function(node, colormap){
  if(is.leaf(node)){
    nodecol <- colormap$color[match(attr(node, "label"), colormap$Species)]
    attr(node, "nodePar") <- list(pch = NA, lab.col = nodecol)
    attr(node, "edgePar") <- list(col = nodecol)
  }else{
    spp <- attr(node, "label")
    dominantspp <- levels(spp)[which.max(tabulate(spp))]
    edgecol <- colormap$color[match(dominantspp, colormap$Species)]
    attr(node, "edgePar") <- list(col = edgecol)
  }
  return(node)
}
dnd <- dendrapply(dnd, color_dendro, colormap = colormap)

## Plot the dendrogram
plot(dnd)