- while (!all(phy$edge[, 2][as.numeric(phy$edge[, 2]) < 0] %in% phy$edge[, 1])) {
- temp <- phy$edge[, 2][as.numeric(phy$edge[, 2]) < 0]
- k <- temp %in% phy$edge[, 1]
- ind <- phy$edge[, 2] %in% temp[!k]
- phy$edge <- phy$edge[!ind, ]
- if (!nobr) phy$edge.length <- phy$edge.length[!ind]
+ if (root.edge && !is.null(phy$root.edge))
+ NewRootEdge <- NewRootEdge + phy$root.edge
+ phy$root.edge <- NewRootEdge
+ }
+
+ phy$edge <- phy$edge[keep, ]
+ if (wbl) phy$edge.length <- phy$edge.length[keep]
+ TIPS <- phy$edge[, 2] <= Ntip
+ tip <- phy$edge[TIPS, 2]
+ ## Fix by Ludovic Mallet and Mahendra Mariadassou (2011-11-21):
+ name <- vector("character", length(tip))
+ name[order(tip)] <- phy$tip.label[tip]
+ phy$tip.label <- name
+ ## End of fix
+ ## keep the ordering so no need to reorder tip.label:
+ phy$edge[TIPS, 2] <- order(tip)
+ if (!is.null(phy$node.label))
+ phy$node.label <- phy$node.label[sort(unique(phy$edge[, 1])) - Ntip]
+ Ntip <- length(phy$tip.label)
+ phy$Nnode <- dim(phy$edge)[1] - Ntip + 1L
+ ## The block below renumbers the nodes so that they conform
+ ## to the "phylo" format -- same as in root()
+ newNb <- integer(Ntip + phy$Nnode)
+ newNb[node] <- Ntip + 1L
+ sndcol <- phy$edge[, 2] > Ntip
+ ## executed from right to left, so newNb is modified before phy$edge:
+ phy$edge[sndcol, 2] <- newNb[phy$edge[sndcol, 2]] <-
+ (Ntip + 2):(Ntip + phy$Nnode)
+ phy$edge[, 1] <- newNb[phy$edge[, 1]]
+ phy
+}
+
+drop.tip <-
+ function(phy, tip, trim.internal = TRUE, subtree = FALSE,
+ root.edge = 0, rooted = is.rooted(phy), interactive = FALSE)
+{
+ if (!inherits(phy, "phylo"))
+ stop('object "phy" is not of class "phylo"')
+ if (!length(tip)) return(phy)
+
+ Ntip <- length(phy$tip.label)
+ ## find the tips to drop:
+ if (interactive) {
+ cat("Left-click close to the tips you want to drop; right-click when finished...\n")
+ xy <- locator()
+ nToDrop <- length(xy$x)
+ tip <- integer(nToDrop)
+ lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
+ for (i in 1:nToDrop) {
+ d <- sqrt((xy$x[i] - lastPP$xx)^2 + (xy$y[i] - lastPP$yy)^2)
+ tip[i] <- which.min(d)