[Phylobase-commits] r345 - pkg/R

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

Author: skembel
Date: 2008-12-19 22:09:19 +0100 (Fri, 19 Dec 2008)
New Revision: 345

Modified:
   pkg/R/methods-phylo4.R
   pkg/R/setAs-Methods.R
Log:
Modify labels and print methods to properly match label to node numbers

Modified: pkg/R/methods-phylo4.R
===================================================================
--- pkg/R/methods-phylo4.R	2008-12-19 21:02:07 UTC (rev 344)
+++ pkg/R/methods-phylo4.R	2008-12-19 21:09:19 UTC (rev 345)
@@ -116,8 +116,29 @@
 setMethod("labels", "phylo4", function(object, which = c("tip",
     "node", "allnode"), ...) {
     which <- match.arg(which)
-    switch(which, tip = object at tip.label, node = object at node.label,
-        allnode = c(object at tip.label, object at node.label))
+    switch(which,
+            tip = object at tip.label,
+            node = {
+                if (hasNodeLabels(object)) {
+                    object at node.label
+                }
+                else
+                {
+                    return(character(0))
+                }
+            }
+            ,
+            allnode = {
+                if (hasNodeLabels(object)) {
+                    nl <- object at node.label
+                }
+                else
+                {
+                    nl <- rep(NA,nNodes(x))
+                }
+                c(object at tip.label,nl)
+            }
+            )
 })
 
 setMethod("nodeLabels", "phylo4", function(x) {

Modified: pkg/R/setAs-Methods.R
===================================================================
--- pkg/R/setAs-Methods.R	2008-12-19 21:02:07 UTC (rev 344)
+++ pkg/R/setAs-Methods.R	2008-12-19 21:09:19 UTC (rev 345)
@@ -125,16 +125,9 @@
     ## beware: they cannot be NULL
     ## there are always tip labels (or check_phylo4 complains)
     ## there may not be node labels (character(0))
-    if (hasNodeLabels(x)) {
-        nl <- x at node.label
-    }
-    else {
-        nl <- rep(NA, nNodes(x))
-    }
-    tl <- labels(x)
-    label <- c(nl, tl)
+    label <- labels(x,which="all")[node]
     node.type <- nodeType(x)[node]
-    return(data.frame(FIXMElabel=label, node, ancestor, branch.length,
+    return(data.frame(label, node, ancestor, branch.length,
         node.type,stringsAsFactors=FALSE))
 })