[Adephylo-commits] r9 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Nov 20 19:25:52 CET 2008
Author: jombart
Date: 2008-11-20 19:25:52 +0100 (Thu, 20 Nov 2008)
New Revision: 9
Modified:
pkg/R/partition.R
Log:
Added a path2tips function.
Modified: pkg/R/partition.R
===================================================================
--- pkg/R/partition.R 2008-11-20 17:21:32 UTC (rev 8)
+++ pkg/R/partition.R 2008-11-20 18:25:52 UTC (rev 9)
@@ -85,4 +85,59 @@
res <- res[,-1]
return(res)
+} # end treePart
+
+
+
+
+
+############
+# path2tips
+############
+path2tips <- function(x, tip1, tip2){
+ if(!require(phylobase)) stop("phylobase package is not installed")
+
+ ## conversion from phylo, phylo4 and phylo4d
+ x <- as(x, "phylo4")
+
+ ## check phylo4 object
+ if (is.character(checkval <- check_phylo4(x))) stop(checkval)
+
+ ## main computations
+ t1 <- getnodes(x,tip1)
+ t2 <- getnodes(x,tip2)
+
+ comAnc <- MRCA(x, t1, t2) # common ancestor
+ desComAnc <- descendants(x, comAnc, which="all")
+ ancT1 <- ancestors(x, t1, which="all")
+ path1 <- intersect(desComAnc, ancT1) # path: common anc -> t1
+
+ ancT2 <- ancestors(x, t2, which="all")
+ path2 <- intersect(desComAnc, ancT2) # path: common anc -> t2
+
+ res <- union(path1, path2) # union of the path
+ res <- getnodes(res)
+
+ return(res)
}
+
+
+
+
+
+###########
+# distRoot
+###########
+distRoot <- function(x, tip){
+ if(!require(phylobase)) stop("phylobase package is not installed")
+
+ ## conversion from phylo, phylo4 and phylo4d
+ x <- as(x, "phylo4")
+
+ ## check phylo4 object
+ if (is.character(checkval <- check_phylo4(x))) stop(checkval)
+
+ ## main computations
+ tip <- getnodes(tip)
+
+}
More information about the Adephylo-commits
mailing list