[Adephylo-commits] r17 - pkg/R

[noreply at r-forge.r-project.org]

Author: jombart
Date: 2008-11-21 14:23:56 +0100 (Fri, 21 Nov 2008)
New Revision: 17

Added:
   pkg/R/distances.R
   pkg/R/utils.R
Modified:
   pkg/R/partition.R
Log:
reorganized R files more clearly. 


Added: pkg/R/distances.R
===================================================================
--- pkg/R/distances.R	                        (rev 0)
+++ pkg/R/distances.R	2008-11-21 13:23:56 UTC (rev 17)
@@ -0,0 +1,26 @@
+###########
+# 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(x, tip)
+    root <- getnodes(x, nTips(x)+1)
+    ancTip <- ancestors(x, tip, which="all")
+
+    pathNodes <- setdiff(ancTip, root) # only internal nodes, without root
+    pathNodes <- c(tip, pathNodes)
+
+    pathNodes <- getnodes(x, pathNodes)
+
+    res <- sumEdgeLength(x, pathNodes)
+
+    return(res)
+} # end distRoot

Modified: pkg/R/partition.R
===================================================================
--- pkg/R/partition.R	2008-11-21 13:17:20 UTC (rev 16)
+++ pkg/R/partition.R	2008-11-21 13:23:56 UTC (rev 17)
@@ -88,74 +88,3 @@
 
     return(res)
 } # end treePart
-
-
-
-
-
-###############
-# shortestPath
-###############
-## shortestPath <- function(x, node1, node2){
-##     if(!require(phylobase)) stop("phylobase package is not installed")
-
-##     ## conversion from phylo, phylo4 and phylo4d
-##     x <- as(x, "phylo4")
-
-##     ## come checks
-##     if (is.character(checkval <- check_phylo4(x))) stop(checkval)
-##     t1 <- getnodes(x, node1)
-##     t2 <- getnodes(x, node2)
-##     if(any(is.na(c(t1,t2)))) stop("wrong node specified")
-##     if(t1==t2) return(NULL)
-
-##     ## main computations
-##     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
-##     ## add the common ancestor if it differs from t1 or t2
-##     if(!comAnc %in% c(t1,t2)){
-##         res <- c(comAnc,res)
-##     }
-
-##     res <- getnodes(x, res)
-
-##     return(res)
-## } # end shortestPath
-
-
-
-
-
-###########
-# 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(x, tip)
-    root <- getnodes(x, nTips(x)+1)
-    ancTip <- ancestors(x, tip, which="all")
-
-    pathNodes <- setdiff(ancTip, root) # only internal nodes, without root
-    pathNodes <- c(tip, pathNodes)
-
-    pathNodes <- getnodes(x, pathNodes)
-
-    res <- sumEdgeLength(x, pathNodes)
-
-    return(res)
-} # end distRoot

Added: pkg/R/utils.R
===================================================================
--- pkg/R/utils.R	                        (rev 0)
+++ pkg/R/utils.R	2008-11-21 13:23:56 UTC (rev 17)
@@ -0,0 +1,36 @@
+###############
+# shortestPath -> moved to phylobase
+###############
+## shortestPath <- function(x, node1, node2){
+##     if(!require(phylobase)) stop("phylobase package is not installed")
+
+##     ## conversion from phylo, phylo4 and phylo4d
+##     x <- as(x, "phylo4")
+
+##     ## come checks
+##     if (is.character(checkval <- check_phylo4(x))) stop(checkval)
+##     t1 <- getnodes(x, node1)
+##     t2 <- getnodes(x, node2)
+##     if(any(is.na(c(t1,t2)))) stop("wrong node specified")
+##     if(t1==t2) return(NULL)
+
+##     ## main computations
+##     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
+##     ## add the common ancestor if it differs from t1 or t2
+##     if(!comAnc %in% c(t1,t2)){
+##         res <- c(comAnc,res)
+##     }
+
+##     res <- getnodes(x, res)
+
+##     return(res)
+## } # end shortestPath
+