[Adephylo-commits] r85 - pkg/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Dec 5 19:43:49 CET 2008


Author: jombart
Date: 2008-12-05 19:43:49 +0100 (Fri, 05 Dec 2008)
New Revision: 85

Modified:
   pkg/R/partition.R
Log:
Started stuff for orthobasis of classical orthogram. Succeeded to get the values used to sort dummy vectors.


Modified: pkg/R/partition.R
===================================================================
--- pkg/R/partition.R	2008-12-05 14:11:14 UTC (rev 84)
+++ pkg/R/partition.R	2008-12-05 18:43:49 UTC (rev 85)
@@ -36,7 +36,7 @@
 ###########
 # treePart
 ###########
-treePart <- function(x){
+treePart <- function(x, res=c("basis", "orthobasis")){
     if(!require(phylobase)) stop("phylobase package is not installed")
 
     ## conversion from phylo, phylo4 and phylo4d
@@ -60,5 +60,48 @@
     row.names(res) <- x at tip.label
     res <- res[,-1]
 
-    return(res)
+    if(res=="basis"){
+        return(res)
+    }
+
+
+
+    ## If orthobasis is required ##
+
+    ## Find values 'w' for all nodes
+    ##
+    ## Notations:
+    ## - n: an internal node (HTU)
+    ## - Dn: the set of all internal nodes descending from 'n'
+    ## - En: the set 'n U Dn' (that is, Dn plus n itself)
+    ## - ndd(e): the number of direct descendants from a node 'e'
+    ##
+    ## Then the values 'w' are computed as:
+    ##
+    ## w(n) = sum_{e \in En} lgamma( ndd(e) + 1)
+    ##
+
+    nbOfDD <- sapply(listDD(x), length) # nb of DD for each node
+    HTU.idx <- (n+1):(n+nNodes(x)) # index of internal nodes (HTU)
+    names(nbOfDD) <- HTU.idx # used to match the results of Dn
+
+    findAlldHTU <- function(node){ # find all HTU descending from a node
+        res <- descendants(x, node, which="all") # tips and HTU
+        res <- res[res > n] # only HTU (here, just node numbers are kept
+        if(length(res)==0) return(NULL)
+        return(res)
+    }
+
+
+    listAlldHTU <- lapply(HTU.idx, function(node) c(node,findAlldHTU(node))) # ='Dn': for each HTU, list all HTU descending from it
+
+    w <- sapply(listAlldHTU, function(e) sum(lgamma(nbOfDD[as.character(e)]+1))) # w(n)
+    ## w stores the w(n) values.
+
+
+
+    ## sorting of dummy vectors according to val
+
+    ## discard dummy vectors for each node with smallest value
+
 } # end treePart



More information about the Adephylo-commits mailing list