在给定公差截止值的情况下折叠树状图答案

【问题标题】：Collapsing a dendrogram given a tolerance cutoff在给定公差截止值的情况下折叠树状图
【发布时间】：2017-01-31 08:00:00
【问题描述】：

在给定公差截止值的情况下，我想折叠 dendrogram 的分支。

我正在关注dendextend 的collapse_branch example。

require(dendextend)
dend <- iris[1:5,-5] %>% dist %>% hclust %>% as.dendrogram 
dend %>% ladderize %>% plot(horiz = TRUE); abline(v = .2, col = 2, lty = 2)

与dendextend 的example 中的dendrograms 不同，我想用三角形替换所有折叠的分支（即垂直红色虚线的任何分支），类似于分支的方式如图所示（来自this link)：

如果这要求太多，我会满足于在公差截止处切割树枝。

【问题讨论】：

标签： r dendrogram dendextend

【解决方案1】：

获取三角形确实有点过分，但你可以给树枝上色。通过使用color_branches：

library(dendextend)
dend <- iris[1:5,-5] %>% dist %>% hclust %>% as.dendrogram 
dend %>% color_branches(h=0.2) %>% ladderize %>% plot(horiz = TRUE); abline(v = .2, col = 2, lty = 2)
# OR
# dend %>% color_branches(k=4) %>% ladderize %>% plot(horiz = TRUE); abline(v = .2, col = 2, lty = 2)

您还可以使用find_k 选择集群的数量，它使用轮廓系数（在本例中为 2）：

require(dendextend)
dend <- iris[1:5,-5] %>% dist %>% hclust %>% as.dendrogram 
find_k(dend)$k
dend %>% color_branches(k=find_k(.)$k) %>% ladderize %>% plot(horiz = TRUE); abline(v = .2, col = 2, lty = 2)

【讨论】：

非常好。真的不可能在公差截止水平上切割树状图吗？如果一个树状图有很多叶子，但有意义的簇的数量要小得多（因此公差截止值会非常高），那么切割的树状图将比拥有它的默认“丛林”更容易查看一直到树叶。

【解决方案2】：

可以使用apepackage到drop.tip的：

require(ape)
require(dendextend)
require(data.tree)

dend <- iris[1:5,-5] %>% dist %>% hclust %>% as.dendrogram 
tol.level <- 0.28
dend %>% plot(horiz = TRUE); abline(v=tol.level,col="red",lty=2)

所以我们的容忍度是 0.28，因此我们想要折叠叶子 (1,5) 和 (3,4)，因为它们的祖先节点的深度低于 tol.level

#convert dendrogram to data.tree
dend.dt <- as.Node(dend)

#get vector of leaves per each internal node
node.list <- lapply(dend.dt$Get(function(node) node$leaves,filterFun = isNotLeaf),function(n) unname(sapply(unlist(n,recursive = T),function(l) l$name)))
#get vector of per each internal node
node.depth.df <- data.frame(depth=c(t(sapply(Traverse(dend.dt,traversal="pre-order",pruneFun=isNotLeaf),function(x) c(x$plotHeight)))),stringsAsFactors=F)

to.drop.leave.names <- c(sapply(which(node.depth.df$depth < tol.level),function(i) node.list[[i]]))

#convert dendrogram to phylo
phylo.dend <- as.phylo(dend)
phylo.dend <- drop.tip(phylo.dend,tip=to.drop.leave.names,interactive=FALSE,trim.internal=FALSE)
plot(phylo.dend,use.edge.length=F)

现在我们可以将其转换回dendrogram (Chronogram)

new.dend <- chronos(phylo.dend)

【讨论】：