存储在R中的树已经将顶点存储为多角剖分，只需要用三角形表示多角剖分来绘制树。
据我所知，ape中没有这样的函数，但是如果您稍微修改一下绘图函数，您可以将其关闭

# Step 1: make edges for descendent nodes invisible in plot:
groups <- c("A", "B", "C", "D")
group_edges <- numeric(0)
for(group in groups){
  group_edges <- c(group_edges,getMRCA(tree.test,tree.test$tip.label[grepl(group, tree.test$tip.label)]))
}
edge.width <- rep(1, nrow(tree.test$edge))
edge.width[tree.test$edge[,1] %in% group_edges ] <- 0

# Step 2: plot the tree with the hidden edges
plot(tree.test, show.tip.label = F, edge.width = edge.width)

# Step 3: add triangles
add_polytomy_triangle <- function(phy, group){
  root <- length(phy$tip.label)+1
  group_node_labels <- phy$tip.label[grepl(group, phy$tip.label)]
  group_nodes <- which(phy$tip.label %in% group_node_labels)
  group_mrca <- getMRCA(phy,group_nodes)

  tip_coord1 <- c(dist.nodes(phy)[root, group_nodes[1]], group_nodes[1])
  tip_coord2 <- c(dist.nodes(phy)[root, group_nodes[1]], group_nodes[length(group_nodes)])
  node_coord <- c(dist.nodes(phy)[root, group_mrca], mean(c(tip_coord1[2], tip_coord2[2])))

  xcoords <- c(tip_coord1[1], tip_coord2[1], node_coord[1])
  ycoords <- c(tip_coord1[2], tip_coord2[2], node_coord[2])
  polygon(xcoords, ycoords)
}

然后，您只需循环遍历这些组以添加三角形

for(group in groups){
  add_polytomy_triangle(tree.test, group)
}

我也一直在寻找这种工具，不是为了折叠分类群，而是为了基于数字支持值折叠内部节点。
ape包中的di2multi函数可以将节点折叠成多边形，但目前它只能通过分支长度阈值来实现，下面是一个粗略的修改，允许通过节点支持值阈值（默认阈值= 0.5）来折叠。
使用风险自担，但它对我的根贝叶斯树起作用。

di2multi4node <- function (phy, tol = 0.5) 
  # Adapted di2multi function from the ape package to plot polytomies
  # based on numeric node support values
  # (di2multi does this based on edge lengths)
  # Needs adjustment for unrooted trees as currently skips the first edge
{
  if (is.null(phy$edge.length)) 
    stop("the tree has no branch length")
  if (is.na(as.numeric(phy$node.label[2])))
    stop("node labels can't be converted to numeric values")
  if (is.null(phy$node.label))
    stop("the tree has no node labels")
  ind <- which(phy$edge[, 2] > length(phy$tip.label))[as.numeric(phy$node.label[2:length(phy$node.label)]) < tol]
  n <- length(ind)
  if (!n) 
    return(phy)
  foo <- function(ancestor, des2del) {
    wh <- which(phy$edge[, 1] == des2del)
    for (k in wh) {
      if (phy$edge[k, 2] %in% node2del) 
        foo(ancestor, phy$edge[k, 2])
      else phy$edge[k, 1] <<- ancestor
    }
  }
  node2del <- phy$edge[ind, 2]
  anc <- phy$edge[ind, 1]
  for (i in 1:n) {
    if (anc[i] %in% node2del) 
      next
    foo(anc[i], node2del[i])
  }
  phy$edge <- phy$edge[-ind, ]
  phy$edge.length <- phy$edge.length[-ind]
  phy$Nnode <- phy$Nnode - n
  sel <- phy$edge > min(node2del)
  for (i in which(sel)) phy$edge[i] <- phy$edge[i] - sum(node2del < 
                                                           phy$edge[i])
  if (!is.null(phy$node.label)) 
    phy$node.label <- phy$node.label[-(node2del - length(phy$tip.label))]
  phy
}

这是我基于phytools::phylo.toBackbone函数的答案，请参见http://blog.phytools.org/2013/09/even-more-on-plotting-subtrees-as.html和http://blog.phytools.org/2013/10/finding-edge-lengths-of-all-terminal.html。首先，在代码末尾加载函数。

library(ape)
library(phytools)  #phylo.toBackbone
library(phangorn) 

cat("((A_1:0.05,E_2:0.03,A_3:0.2,A_4:0.1,A_5:0.1,A_6:0.1,A_7:0.35,A_8:0.4,A_9:01,A_10:0.2):0.9,((((B_1:0.05,B_2:0.05):0.5,B_3:0.02,B_4:0.04):0.6,(C_1:0.6,C_2:0.08):0.7):0.5,(D_1:0.3,D_2:0.4,D_3:0.5,D_4:0.7,D_5:0.4):1.2):0.5);"
    , file = "ex.tre", sep = "\n")

phy <- read.tree("ex.tre")
groups <- c("A", "B|C", "D") 

backboneoftree<-makebackbone(groups,phy)
#   tip.label clade.label  N     depth
# 1       A_1           A 10 0.2481818
# 2       B_1         B|C  6 0.9400000
# 3       D_1           D  5 0.4600000
    
{
    tryCatch(dev.off(),error=function(e){""})
    par(fig=c(0,0.5,0,1), mar = c(0, 0, 2, 0))
    plot(phy, main="Original" )
    par(fig=c(0.5,1,0,1), oma = c(0, 0, 1.2, 0), xpd=NA, new=T)
    plot(backboneoftree)
    title(main="Clades")
}

makebackbone <- function(groupings,phy){ 
    
    listofspecies  <- phy$tip.label
    listtopreserve <- character()
    newedgelengths <- meandistnode<- lengthofclades<- numeric()
    
    for (i in 1:length(groupings)){
        bestmrca<-getMRCA(phy,grep(groupings[i], phy$tip.label) )
        mrcatips<-phy$tip.label[unlist(phangorn::Descendants(phy,bestmrca, type="tips") )]
        listtopreserve[i] <- mrcatips[1]
        meandistnode[i]   <- mean(dist.nodes(phy)[unlist(lapply(mrcatips,  
                                  function(x) grep(x, phy$tip.label) ) ),bestmrca] )
        lengthofclades[i] <- length(mrcatips)
        provtree          <- drop.tip(phy,mrcatips, trim.internal=F, subtree = T)
        n3                <- length(provtree$tip.label)
        newedgelengths[i] <- setNames(provtree$edge.length[sapply(1:n3,function(x,y) 
            which(y==x),
            y=provtree$edge[,2])],
            provtree$tip.label)[provtree$tip.label[grep("tips",provtree$tip.label)] ]
    }  
    newtree <- drop.tip(phy,setdiff(listofspecies,listtopreserve), 
                      trim.internal = T)
    n       <- length(newtree$tip.label)
    
    newtree$edge.length[sapply(1:n,function(x,y) 
        which(y==x),
        y=newtree$edge[,2])] <- newedgelengths + meandistnode
    
    trans           <- data.frame(tip.label=newtree$tip.label,clade.label=groupings,
                              N=lengthofclades, depth=meandistnode )
    rownames(trans) <- NULL
    print(trans)
    backboneoftree  <- phytools::phylo.toBackbone(newtree,trans)
    return(backboneoftree)
}

编辑：我没有试过这个，但它可能是另一个答案：“将树的顶端分支（即粗细或）转换为三角形的脚本和函数，两者的宽度与某些参数（例如，进化枝的物种数）相关（tip.branches.R）”https://www.en.sysbot.bio.lmu.de/people/employees/cusimano/use_r/index.html

我认为脚本终于达到了我的目的。根据@CactusWoman提供的答案，我对代码做了一些修改，这样脚本将尝试找到与我的搜索模式匹配的最大分支的MRCA。这解决了不合并非多分支分支的问题，或者因为一个匹配节点错误地位于正确分支之外而折叠整个树的问题。
此外，我还包括了一个参数，它表示给定分支中模式丰度比的限制，因此我们可以选择并折叠/分组至少90%的尖端与搜索模式匹配的分支。

library(geiger)
library(phylobase)
library(ape)

#functions
find_best_mrca <- function(phy, group, threshold){

     group_matches <- phy$tip.label[grepl(group, phy$tip.label, ignore.case=TRUE)]
     group_mrca <- getMRCA(phy,phy$tip.label[grepl(group, phy$tip.label, ignore.case=TRUE)])
     group_leaves <- tips(phy, group_mrca)
     match_ratio <- length(group_matches)/length(group_leaves)

      if( match_ratio < threshold){

           #start searching for children nodes that have more than 95% of descendants matching to the search pattern
           mrca_children <- descendants(as(phy,"phylo4"), group_mrca, type="all")
           i <- 1
           new_ratios <- NULL
           nleaves <- NULL
           names(mrca_children) <- NULL

           for(new_mrca in mrca_children){
                child_leaves <- tips(tree.test, new_mrca)
                child_matches <- grep(group, child_leaves, ignore.case=TRUE)
                new_ratios[i] <- length(child_matches)/length(child_leaves)
                nleaves[i] <- length(tips(phy, new_mrca))
                i <- i+1
           }


           match_result <- data.frame(mrca_children, new_ratios, nleaves)

           match_result_sorted <- match_result[order(-match_result$nleaves,match_result$new_ratios),]
           found <- numeric(0);

           print(match_result_sorted)

           for(line in 1:nrow(match_result_sorted)){
                 if(match_result_sorted$ new_ratios[line]>=threshold){
                     return(match_result_sorted$mrca_children[line])
                     found <- 1
                 }

           }

           if(found==0){return(found)}
      }else{return(group_mrca)}



}

add_triangle <- function(phy, group,phylo_plot){

     group_node_labels <- phy$tip.label[grepl(group, phy$tip.label)]
     group_mrca <- getMRCA(phy,group_node_labels)
     group_nodes <- descendants(as(tree.test,"phylo4"), group_mrca, type="tips")
     names(group_nodes) <- NULL

     x<-phylo_plot$xx
     y<-phylo_plot$yy

     x1 <- max(x[group_nodes])
     x2 <-max(x[group_nodes])
     x3 <- x[group_mrca]

     y1 <- min(y[group_nodes])
     y2 <- max(y[group_nodes])
     y3 <-  y[group_mrca]

     xcoords <- c(x1,x2,x3)
     ycoords <- c(y1,y2,y3)

     polygon(xcoords, ycoords)

     return(c(x2,y3))

}


#main

  cat("((A_1:0.05,E_2:0.03,A_3:0.2,A_4:0.1,A_5:0.1,A_6:0.1,A_7:0.35,A_8:0.4,A_9:01,A_10:0.2):0.9,((((B_1:0.05,B_2:0.05):0.5,B_3:0.02,B_4:0.04):0.6,(C_1:0.6,C_2:0.08):0.7):0.5,(D_1:0.3,D_2:0.4,D_3:0.5,D_4:0.7,D_5:0.4):1.2):0.5);", file = "ex.tre", sep = "\n")
tree.test <- read.tree("ex.tre")

# Step 1: Find the best MRCA that matches to the keywords or search patten

groups <- c("A", "B|C", "D")
group_labels <- groups

group_edges <- numeric(0)
edge.width <- rep(1, nrow(tree.test$edge))
count <- 1

for(group in groups){

    best_mrca <- find_best_mrca(tree.test, group, 0.90)

    group_leaves <- tips(tree.test, best_mrca)

    groups[count] <- paste(group_leaves, collapse="|")
    group_edges <- c(group_edges,best_mrca)

    #Step2: Remove the edges of the branches that will be collapsed, so they become invisible
    edge.width[tree.test$edge[,1] %in% c(group_edges[count],descendants(as(tree.test,"phylo4"), group_edges[count], type="all")) ] <- 0
    count = count +1

}

#Step 3: plot the tree hiding the branches that will be collapsed/grouped

last_plot.phylo <- plot(tree.test, show.tip.label = F, edge.width = edge.width)

#And save a copy of the plot so we can extract the xy coordinates of the nodes
#To get the x & y coordinates of a plotted tree created using plot.phylo
#or plotTree, we can steal from inside tiplabels:
last_phylo_plot<-get("last_plot.phylo",envir=.PlotPhyloEnv)

#Step 4: Add triangles and labels to the collapsed nodes
for(i in 1:length(groups)){

  text_coords <- add_triangle(tree.test, groups[i],last_phylo_plot)

  text(text_coords[1],text_coords[2],labels=group_labels[i], pos=4)

}

这并不能解决把进化枝描述成三角形的问题，但它确实有助于折叠低支持度的节点。ggtree库有一个函数as.polytomy，可以用来根据支持度值折叠节点。
例如，要将引导数据库压缩到50%以下，可以用途：

polytree = as.polytomy(raxtree, feature='node.label', fun=function(x) as.numeric(x) < 50)