-## root.R (2009-09-09)
+## root.R (2010-02-11)
## Root of Phylogenetic Trees
-## Copyright 2004-2009 Emmanuel Paradis
+## Copyright 2004-2010 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
is.rooted <- function(phy)
{
if (!inherits(phy, "phylo"))
- stop('object "phy" is not of class "phylo"')
+ stop('object "phy" is not of class "phylo"')
if (!is.null(phy$root.edge)) TRUE
else
- if (tabulate(phy$edge[, 1])[length(phy$tip.label) + 1] > 2)
- FALSE else TRUE
+ if (tabulate(phy$edge[, 1])[length(phy$tip.label) + 1] > 2)
+ FALSE else TRUE
}
unroot <- function(phy)
{
if (!inherits(phy, "phylo"))
- stop('object "phy" is not of class "phylo"')
+ stop('object "phy" is not of class "phylo"')
if (dim(phy$edge)[1] < 3)
- stop("cannot unroot a tree with two edges.")
+ stop("cannot unroot a tree with less than three edges.")
## delete FIRST the root.edge (in case this is sufficient to
## unroot the tree, i.e. there is a multichotomy at the root)
if (!is.null(phy$root.edge)) phy$root.edge <- NULL
## nodes by adding 1, except the root (this remains the
## origin of the tree).
nb.tip <- length(phy$tip.label)
- ROOT <- nb.tip + 1
+ ROOT <- nb.tip + 1L
EDGEROOT <- which(phy$edge[, 1] == ROOT)
## j: the target where to stick the edge
## i: the edge to delete
- if (phy$edge[EDGEROOT[1], 2] == ROOT + 1) {
+ if (phy$edge[EDGEROOT[1], 2] == ROOT + 1L) {
j <- EDGEROOT[2]
i <- EDGEROOT[1]
} else {
## cladewise order.
phy$edge <- phy$edge[-i, ]
nodes <- phy$edge > ROOT # renumber all nodes except the root
- phy$edge[nodes] <- phy$edge[nodes] - 1
+ phy$edge[nodes] <- phy$edge[nodes] - 1L
if (!is.null(phy$edge.length)) {
phy$edge.length[j] <- phy$edge.length[j] + phy$edge.length[i]
phy$edge.length <- phy$edge.length[-i]
}
- phy$Nnode <- phy$Nnode - 1
+ phy$Nnode <- phy$Nnode - 1L
if (!is.null(phy$node.label))
phy$node.label <- phy$node.label[-2]
phy
}
-root <- function(phy, outgroup, node = NULL, resolve.root = FALSE)
+root <- function(phy, outgroup, node = NULL,
+ resolve.root = FALSE, interactive = FALSE)
{
if (!inherits(phy, "phylo"))
- stop('object "phy" is not of class "phylo"')
+ stop('object "phy" is not of class "phylo"')
phy <- reorder(phy)
n <- length(phy$tip.label)
- ROOT <- n + 1
+ ROOT <- n + 1L
+ if (interactive) {
+ node <- identify(phy)$nodes
+ cat("You have set resolve.root =", resolve.root, "\n")
+ }
if (!is.null(node)) {
if (node <= n)
stop("incorrect node#: should be greater than the number of taxa")