bug fix in root()

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

diff --git a/DESCRIPTION b/DESCRIPTION
index de29863942b951e632fc324d8915fe9908ad3d8e..1f06121079e15ee0678a85394a74f650bcd4477d 100644 (file)
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,5 +1,5 @@
 Package: ape
-Version: 2.7-3
+Version: 2.7-5
 Date: 2011-07-18
 Title: Analyses of Phylogenetics and Evolution
 Author: Emmanuel Paradis, Ben Bolker, Julien Claude, Hoa Sien Cuong, Richard Desper, Benoit Durand, Julien Dutheil, Olivier Gascuel, Christoph Heibl, Daniel Lawson, Vincent Lefort, Pierre Legendre, Jim Lemon, Yvonnick Noel, Johan Nylander, Rainer Opgen-Rhein, Klaus Schliep, Korbinian Strimmer, Damien de Vienne

diff --git a/NEWS b/NEWS
index 0fb711979f9b827a89a072ca869d5606a6b1e201..7b43668c946918a267b1a726a6bd4b73aeff8b2a 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -31,7 +31,10 @@ BUG FIXES
       incompatible splits occur in 50% of the trees (especially with
       small number of trees).
 
-    o c() with "multiPhylo" did not work correctly.
+    o c() with "multiPhylo" did not work correctly (thanks to Klaus
+      Schliep for the fix).
+
+    o root() failed in some cases with an outgroup made of several tips.
 
 
 

diff --git a/R/root.R b/R/root.R
index 5691bb518f01e9b1105b7b886c5ca48952b02e61..8526b8f3d4f74add15240b88eca14a8267785496 100644 (file)
--- a/R/root.R
+++ b/R/root.R
@@ -1,4 +1,4 @@
-## root.R (2011-04-29)
+## root.R (2011-08-05)
 
 ##   Root of Phylogenetic Trees
 
@@ -91,34 +91,21 @@ root <- function(phy, outgroup, node = NULL,
         ## First check that the outgroup is monophyletic--
         ## unless there's only one tip specified of course
         if (length(outgroup) > 1) {
-            seq.nod <- .Call("seq_root2tip", phy$edge, n,
-                             phy$Nnode, PACKAGE = "ape")
-            sn <- seq.nod[outgroup]
-            ## We go from the root to the tips: the sequence of nodes
-            ## is identical until the MRCA:
-            newroot <- ROOT
-            i <- 2 # we start at the 2nd position since the root
-                   # of the tree is a common ancestor to all tips
-            repeat {
-                x <- unique(unlist(lapply(sn, "[", i)))
-                if (length(x) != 1) break
-                newroot <- x
-                i <- i + 1
-            }
-            ## Check that all descendants of this node
-            ## are included in the outgroup.
-            ## (below is slightly faster than calling "bipartition")
-            desc <- which(unlist(lapply(seq.nod,
-                                        function(x) any(x %in% newroot))))
-            msg <- "the specified outgroup is not monophyletic"
+            pp <- prop.part(phy)
             ingroup <- (1:n)[-outgroup]
-            ## 'outgroup' and 'desc' are already sorted:
-            if (newroot != ROOT) {
-                if (!identical(outgroup, desc) && !identical(ingroup, desc))
-                    stop(msg)
-            } else { # otherwise check monophyly of the ingroup
-                if (!is.monophyletic(phy, ingroup)) stop(msg)
+            newroot <- 0L
+            for (i in 2:phy$Nnode) {
+                if (identical(pp[[i]], ingroup)) {
+                    newroot <- i + n
+                    break
+                }
+                if (identical(pp[[i]], outgroup)) {
+                    newroot <- phy$edge[which(phy$edge[, 2] == i + n), 1]
+                    break
+                }
             }
+            if (!newroot)
+                stop("the specified outgroup is not monophyletic")
         } else newroot <- phy$edge[which(phy$edge[, 2] == outgroup), 1]
     }
     N <- Nedge(phy)