- tmp <- as.numeric(phy$edge)
- if (!is.null(phy$node.label)) {
- x <- unique(tmp)
- x <- x[x < 0]
- phy$node.label <- phy$node.label[-x]
- }
- n <- length(tmp)
- nodes <- tmp < 0
- ind.nodes <- (1:n)[nodes]
- ind.tips <- (1:n)[!nodes]
- new.nodes <- -as.numeric(factor(-tmp[nodes]))
- new.tips <- as.numeric(factor(tmp[!nodes]))
- tmp[ind.nodes] <- new.nodes
- tmp[ind.tips] <- new.tips
- dim(tmp) <- c(n / 2, 2)
- mode(tmp) <- "character"
- phy$edge <- tmp
- phy <- old2new.phylo(phy)
- if (!trim.internal || subtree) {
- S <- write.tree(phy)
- phy <- if (nobr) clado.build(S) else tree.build(S)
- }
- phy
+
+ if (!root.edge) phy$root.edge <- NULL
+
+ ## drop the edges
+ phy$edge <- phy$edge[keep, ]
+ if (wbl) phy$edge.length <- phy$edge.length[keep]
+
+ ## find the new terminal edges (works whatever 'subtree' and 'trim.internal'):
+ TERMS <- !(phy$edge[, 2] %in% phy$edge[, 1])
+
+ ## get the old No. of the nodes and tips that become tips:
+ oldNo.ofNewTips <- phy$edge[TERMS, 2]
+
+ n <- length(oldNo.ofNewTips) # the new number of tips in the tree
+
+ ## the tips may not be sorted in increasing order of their
+ ## in the 2nd col of edge, so no need to reorder $tip.label
+ phy$edge[TERMS, 2] <- rank(phy$edge[TERMS, 2])
+
+ ## make new tip labels if necessary:
+ if (subtree || !trim.internal) {
+ ## get the logical indices of the tips that are kept within 'oldNo.ofNewTips':
+ tips.kept <- oldNo.ofNewTips <= Ntip & !(oldNo.ofNewTips %in% tip)
+ new.tip.label <- character(n)
+ new.tip.label[tips.kept] <- phy$tip.label[-tip]
+ ## get the numbers of the nodes that become tips:
+ node2tip <- oldNo.ofNewTips[!tips.kept]
+ new.tip.label[!tips.kept] <- if (subtree) {
+ paste("[", N[node2tip], "_tips]", sep = "")
+ } else {
+ if (is.null(phy$node.label)) rep("NA", length(node2tip))
+ else phy$node.label[node2tip - Ntip]
+ }
+ if (!is.null(phy$node.label))
+ phy$node.label <- phy$node.label[-(node2tip - Ntip)]
+ phy$tip.label <- new.tip.label
+ } else phy$tip.label <- phy$tip.label[-tip]
+
+ ## update node.label if needed:
+ if (!is.null(phy$node.label))
+ phy$node.label <- phy$node.label[sort(unique(phy$edge[, 1])) - Ntip]
+
+ phy$Nnode <- dim(phy$edge)[1] - n + 1L # update phy$Nnode
+
+ ## The block below renumbers the nodes so that they conform
+ ## to the "phylo" format -- same as in root()
+ newNb <- integer(n + phy$Nnode)
+ newNb[NEWROOT] <- n + 1L
+ sndcol <- phy$edge[, 2] > n
+ ## executed from right to left, so newNb is modified before phy$edge:
+ phy$edge[sndcol, 2] <- newNb[phy$edge[sndcol, 2]] <-
+ (n + 2):(n + phy$Nnode)
+ phy$edge[, 1] <- newNb[phy$edge[, 1]]
+ storage.mode(phy$edge) <- "integer"
+ collapse.singles(phy)