[Phylobase-commits] r634 - in pkg: R inst/unitTests

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

Author: regetz
Date: 2009-09-11 09:30:50 +0200 (Fri, 11 Sep 2009)
New Revision: 634

Modified:
   pkg/R/setAs-Methods.R
   pkg/inst/unitTests/runit.methods-phylo4.R
Log:
fixed handling of edge lengths in .phylo4ToDataFrame (hence coercion to
data frame and show method: bug #648); created test for 'pretty' case


Modified: pkg/R/setAs-Methods.R
===================================================================
--- pkg/R/setAs-Methods.R	2009-09-11 01:58:15 UTC (rev 633)
+++ pkg/R/setAs-Methods.R	2009-09-11 07:30:50 UTC (rev 634)
@@ -200,29 +200,24 @@
     if (edgeOrder == "pretty") {
         node <- nodeId(from, "all")
         ancestr <- ancestor(from, node)
-        E <- data.frame(node, ancestr)
-    }
-    else {
+    } else {
         E <- edges(from)
         node <- E[, 2]
         ancestr <- E[, 1]
     }
 
-    if (hasEdgeLength(from)) {
-        nmE <- paste(E[,2], E[,1], sep="-")
-        edge.length <- edgeLength(from)[match(nmE, names(from at edge.length))]
-    }
-    else {
-        edge.length <- rep(NA, nrow(E))
-    }
+    ## extract and reorder (as needed) other object slots
+    nmE <- paste(ancestr, node, sep="-")
+    edge.length <- edgeLength(from)
+    edge.length <- edge.length[match(nmE, names(edge.length))]
 
-
     ndType <- nodeType(from)
-    label <- labels(from,type="all")
+    ndType <- ndType[match(node, names(ndType))]
+    label <- labels(from, type="all")
     label <- label[match(node, names(label))]
 
     tDf <- data.frame(label, node, ancestor=ancestr, edge.length,
-                    node.type=ndType[node], row.names=node)
+                    node.type=ndType, row.names=node)
     tDf$label <- as.character(tDf$label)
 
     if (class(from) == "phylo4d") {

Modified: pkg/inst/unitTests/runit.methods-phylo4.R
===================================================================
--- pkg/inst/unitTests/runit.methods-phylo4.R	2009-09-11 01:58:15 UTC (rev 633)
+++ pkg/inst/unitTests/runit.methods-phylo4.R	2009-09-11 07:30:50 UTC (rev 634)
@@ -175,12 +175,16 @@
   #TODO function(object, ...,  value) {
 }
 
-test.print.phylo4 <- function() {
-  #TODO? this just calls printphylo4 function
-}
-
+## this is also the print method
 test.show.phylo4 <- function() {
-  #TODO? this just calls printphylo4 function
+  # the real work here is done in .phylo4ToDataFrame
+  phy.show <- phylobase:::.phylo4ToDataFrame(phy, "pretty")
+  checkIdentical(phy.show$label, c(lab.tip, lab.int))
+  checkIdentical(phy.show$node, c(nid.tip, nid.int))
+  checkIdentical(phy.show$ancestor, ancestor[match(c(nid.tip, nid.int),
+    descendant)])
+  checkIdentical(phy.show$edge.length, sort(elen))
+  checkIdentical(phy.show$node.typ, factor(unname(nodeType(phy))))
 }
 
 test.names.phylo4 <- function() {