[Phylobase-commits] r384 - pkg/R

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

Author: pdc
Date: 2008-12-21 07:16:58 +0100 (Sun, 21 Dec 2008)
New Revision: 384

Modified:
   pkg/R/setAs-Methods.R
Log:
update handling of order -- as(phy, 'phylo') now applies an attribute mapping preorder -> cladewise and postorder -> pruningwise.

note that pruningwise is not exactly the same as postorder, but appears not to crash ape

Modified: pkg/R/setAs-Methods.R
===================================================================
--- pkg/R/setAs-Methods.R	2008-12-21 04:42:09 UTC (rev 383)
+++ pkg/R/setAs-Methods.R	2008-12-21 06:16:58 UTC (rev 384)
@@ -1,7 +1,8 @@
 #######################################################
 ## Importing from ape
 setAs("phylo", "phylo4", function(from, to) {
-    #fixme SWK kludgy fix may not work well with unrooted trees
+    ## fixme SWK kludgy fix may not work well with unrooted trees
+    ## TODO should we also attempt to get order information?
     if (is.rooted(from)) {
         root.edge <- as.numeric(setdiff(unique(from$edge[,1]), unique(from$edge[,2])))
         from$edge <- rbind(from$edge,c(NA,root.edge))
@@ -60,27 +61,32 @@
 ## })
 
 setAs("phylo4", "phylo", function(from, to) {
-  if (inherits(from,"phylo4d"))
-    warning("losing data while coercing phylo4d to phylo")
-  brlen <- from at edge.length
-  rootpos <- which(nodeId(from,"all")==rootNode(from))
-  if (isRooted(from)) brlen <- brlen[-rootpos]
-  edgemat <- unname(from at edge[-rootpos,])
-  y <- list(edge = edgemat,
-            Nnode = from at Nnode,
-            tip.label = from at tip.label,
-            edge.length = brlen,
-            node.label = from at node.label)
-  class(y) <- "phylo"
-  if (length(y$edge.length) == 0)
-    y$edge.length <- NULL
-  if (length(y$node.label) == 0)
-    y$node.label <- NULL
-  if (isRooted(from)) {
-    root.edge <- brlen[nodeId(from,"all")==rootNode(from)]
-    if (!is.na(root.edge)) y$root.edge <- root.edge
-  }
-  y
+    if (inherits(from, "phylo4d"))
+        warning("losing data while coercing phylo4d to phylo")
+    brlen <- from at edge.length
+    rootpos <- which(nodeId(from, "all") == rootNode(from))
+    if (isRooted(from)) brlen <- brlen[-rootpos]
+    edgemat <- unname(from at edge[-rootpos, ])
+    y <- list(edge = edgemat, 
+            Nnode = from at Nnode, 
+            tip.label = from at tip.label, 
+            edge.length = brlen, 
+            node.label = from at node.label) 
+    class(y) <- "phylo"
+    if (from at order != 'unknown') {
+        ## TODO postorder != pruningwise -- though quite similar
+        attr(y, 'order') <- switch(from at order, postorder = 'pruningwise', 
+                                      preorder  = 'cladewise')
+    }
+    if (length(y$edge.length) == 0)
+        y$edge.length <- NULL
+    if (length(y$node.label) == 0)
+        y$node.label <- NULL
+    if (isRooted(from)) {
+        root.edge <- brlen[nodeId(from, "all") == rootNode(from)]
+        if (!is.na(root.edge)) y$root.edge <- root.edge
+    }
+    y
 })
 
 ## BMB: redundant????