bug fix in root()

git-svn-id: https://svn.mpl.ird.fr/ape/dev/ape@34 6e262413-ae40-0410-9e79-b911bd7a66b7

diff --git a/Changes b/Changes
index f8562e43cd76dbd0cf09154e6a382422054c1fea..e63867fd5d815263850cedd7f7fd02228b1e2c0e 100644 (file)
--- a/Changes
+++ b/Changes
@@ -7,6 +7,12 @@ NEW FEATURES
       set of DNA sequences.
 
 
+BUG FIXES
+
+    o root() failed with resolve.root = TRUE when the root was already
+      the specified root.
+
+
 OTHER CHANGES
 
     o unique.multiPhylo() is faster thanks to a suggestion by Vladimir

diff --git a/DESCRIPTION b/DESCRIPTION
index a9c4fc02c3ddfc591f896fe6221523e4158978e4..48797b0a2a121536f18aacd9d0fad26fb8a89ae9 100644 (file)
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: ape
 Version: 2.2-1
-Date: 2008-06-09
+Date: 2008-06-12
 Title: Analyses of Phylogenetics and Evolution
 Author: Emmanuel Paradis, Ben Bolker, Julien Claude, Hoa Sien Cuong,
   Richard Desper, Benoit Durand, Julien Dutheil, Olivier Gascuel,

diff --git a/R/root.R b/R/root.R
index e7c916b55e61679f5088bf892c36918d08b4e888..a11fa1e73d521a61dcddbe3f5bc863fef778109d 100644 (file)
--- a/R/root.R
+++ b/R/root.R
@@ -1,4 +1,4 @@
-## root.R (2008-02-12)
+## root.R (2008-06-12)
 
 ##   Root of Phylogenetic Trees
 
@@ -113,14 +113,39 @@ root <- function(phy, outgroup, node = NULL, resolve.root = FALSE)
             if (!all(outgroup == desc)) stop(msg)
         } else newroot <- phy$edge[which(phy$edge[, 2] == outgroup), 1]
     }
-    if (newroot == ROOT) return(phy)
+    N <- Nedge(phy)
+    oldNnode <- phy$Nnode
+    if (newroot == ROOT) {
+        if (resolve.root) {
+            snw <- which(phy$edge[, 1] == newroot)
+            if (length(snw) > 2) {
+                a <- snw[1]:(snw[2] - 1)
+                b <- snw[2]:N
+                newnod <- oldNnode + n + 1
+                phy$edge[snw[-1], 1] <- newnod
+                phy$edge <- rbind(phy$edge[a, ], c(ROOT, newnod),
+                                  phy$edge[b, ])
+                if (!is.null(phy$edge.length))
+                phy$edge.length <-
+                    c(phy$edge.length[a], 0, phy$edge.length[b])
+                phy$Nnode <- phy$Nnode + 1
+                ## node renumbering (see comments below)
+                newNb <- integer(n + oldNnode)
+                newNb[newroot] <- n + 1L
+                sndcol <- phy$edge[, 2] > n
+                phy$edge[sndcol, 2] <- newNb[phy$edge[sndcol, 2]] <-
+                    (n + 2):(n + phy$Nnode)
+                phy$edge[, 1] <- newNb[phy$edge[, 1]]
+            }
+        }
+        return(phy)
+    }
 
     phy$root.edge <- NULL # just in case...
     Nclade <- tabulate(phy$edge[, 1])[ROOT] # degree of the root node
     ## if only 2 edges connect to the root, we have to fuse them:
     fuseRoot <- Nclade == 2
 
-    N <- Nedge(phy)
     start <- which(phy$edge[, 1] == ROOT)
     end <- c(start[-1] - 1, N)
     o <- integer(N)
@@ -218,7 +243,6 @@ root <- function(phy, outgroup, node = NULL, resolve.root = FALSE)
     ne <- length(s)
     o[NEXT:(NEXT + ne - 1L)] <- s
 
-    oldNnode <- phy$Nnode
     if (fuseRoot) {
         phy$Nnode <- oldNnode - 1
         N <- N - 1L