From cc266bd204f991845994007b428ba9e20f92963c Mon Sep 17 00:00:00 2001
From: paradis <paradis@6e262413-ae40-0410-9e79-b911bd7a66b7>
Date: Fri, 5 Aug 2011 05:05:00 +0000
Subject: [PATCH] bug fix in root()

git-svn-id: https://svn.mpl.ird.fr/ape/dev/ape@168 6e262413-ae40-0410-9e79-b911bd7a66b7
---
 DESCRIPTION |  2 +-
 NEWS        |  5 ++++-
 R/root.R    | 41 ++++++++++++++---------------------------
 3 files changed, 19 insertions(+), 29 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index de29863..1f06121 100644
--- 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 0fb7119..7b43668 100644
--- 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 5691bb5..8526b8f 100644
--- 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)
-- 
2.39.2