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

Question

我想在给定容差截止值的情况下折叠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中的dendrogram不同，我想将所有折叠的分支(即，垂直红色虚线上的任何分支)替换为三角形，类似于此图(来自this link) )中的分支表示方式

​

​

如果这要求太高，我会满足于在容忍度临界点上砍掉树枝。

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

​

​

也可以使用使用轮廓系数(在本例中为2)的find_k拾取簇数：

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)

​

​

Answer 2

您可以使用ape package到drop.tip's：

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)