[Adephylo-commits] r7 - pkg/R

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

Author: jombart
Date: 2008-11-20 17:30:32 +0100 (Thu, 20 Nov 2008)
New Revision: 7

Modified:
   pkg/R/partition.R
Log:
Added function treePart


Modified: pkg/R/partition.R
===================================================================
--- pkg/R/partition.R	2008-11-20 16:17:41 UTC (rev 6)
+++ pkg/R/partition.R	2008-11-20 16:30:32 UTC (rev 7)
@@ -6,15 +6,14 @@
 ############
 # listTips
 ############
-listTips <- function(tree){
+listTips <- function(x){
     if(!require(phylobase)) stop("phylobase package is not installed")
 
-    x <- tree
-    ## conversion from phylo4 and phylo4d
+    ## conversion from phylo, phylo4 and phylo4d
     x <- as(x, "phylo4")
 
     ## check phylo4 object
-    if (is.character(checkval <- check_phylo4(res))) stop(checkval)
+    if (is.character(checkval <- check_phylo4(x))) stop(checkval)
 
     ## computations
     res <- lapply(nodeLabels(x), function(e) descendants(x, e))
@@ -23,3 +22,36 @@
 
     return(res)
 }
+
+
+
+
+
+###########
+# treePart
+###########
+treePart <- function(x){
+    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)
+
+    n <- nTips(x)
+
+    ## function coding one dummy vector
+    fDum <- function(vec){ # vec is a vector of tip numbers
+        dum <- integer(n)
+        dum[vec] <- 1
+        return(dum)
+    }
+
+    ## main computations
+    temp <- listTips(x)
+    res <- data.frame(lapply(temp,fDum))
+    row.names(res) <- x at tip.label
+
+    return(res)
+}