[Phylobase-commits] r318 - pkg/R

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

Author: bbolker
Date: 2008-12-19 06:07:44 +0100 (Fri, 19 Dec 2008)
New Revision: 318

Modified:
   pkg/R/class-phylo4.R
   pkg/R/methods-phylo4d.R
   pkg/R/phylo4.R
   pkg/R/setAs-Methods.R
Log:
  made node, edge labels empty by default, tried to deal with all the fallout
  added nodeNumbers method



Modified: pkg/R/class-phylo4.R
===================================================================
--- pkg/R/class-phylo4.R	2008-12-19 04:43:24 UTC (rev 317)
+++ pkg/R/class-phylo4.R	2008-12-19 05:07:44 UTC (rev 318)
@@ -50,20 +50,20 @@
 
     ## node.label
     nnodes <- sum(tabulate(edge[, 1]) > 0)
+    ##    if(is.null(node.label)) {
+    ##        node.label <- .genlab("N", nnodes)
+    ## } else {
     if(is.null(node.label)) {
-        node.label <- .genlab("N", nnodes)
-    } else {
-        if(length(node.label) != nnodes) stop("the node labels are not consistent with the number of nodes")
-    } 
-
+      node.label <- character(0)
+    } else if (length(node.label) != nnodes)
+      stop("the node labels are not consistent with the number of nodes")
     ## edge.label
     ## an edge is named by the descendant
     if(is.null(edge.label)) {
-        edge.label <- paste("E", edge[, 2], sep = "")
-    } else {
-        if(length(edge.label) != nrow(edge)) stop("the edge labels are not consistent with the number of edges")
-    }
-
+      edge.label <- character(0)
+    ##        edge.label <- paste("E", edge[, 2], sep = "")
+    } else if (length(edge.label) != nrow(edge))
+      stop("the edge labels are not consistent with the number of edges")
     ## root.edge - if no root edge lenth provided, set to a numeric NA
     if(is.null(root.edge)) root.edge <- as.numeric(NA)
     ##if(!is.null(root.edge)) {

Modified: pkg/R/methods-phylo4d.R
===================================================================
--- pkg/R/methods-phylo4d.R	2008-12-19 04:43:24 UTC (rev 317)
+++ pkg/R/methods-phylo4d.R	2008-12-19 05:07:44 UTC (rev 318)
@@ -33,28 +33,36 @@
         tdata <- x at node.data
         data.names <- x at node.label
         if ( identical(label.type,"row.names") ) {
-            if ( identical(data.names,unique(data.names)) || !(any(is.na(data.names))) ) {
-                row.names(tdata) <- data.names
-            }
-            else {
-                warning("Non-unique or missing labels found, labels cannot be coerced to tdata row.names. Use the label.type argument to include labels as first column of data.")
-            }
+          if ( length(data.names)>0 &&
+              !any(duplicated(data.names)) &&
+              !(any(is.na(data.names)))) {
+            row.names(tdata) <- data.names
+          } else {
+            warning("Non-unique or missing labels found,",
+                    "labels cannot be coerced to tdata row.names.",
+                    "Use the label.type argument to include labels",
+                    "as first column of data.")
+          }
         }
         if (identical(label.type,"column")) {
-            tdata <- data.frame(label=data.names,tdata)
+          if (!hasNodeLabels(x)) data.names <- rep("",nNodes(x))
+          tdata <- data.frame(label=data.names,tdata)
         }
         return(tdata)
     }
 
     if (which == "allnode") {
-        if (all(dim(x at node.data)==0)) {
-            nodedata <- data.frame(label=x at node.label)
-        }
+        if (all(dim(x at node.data)==0)) { ## empty data
+          if (!hasNodeLabels(x)) {
+            nodedata <- data.frame(label=rep("",nNodes(x)))
+          } else
+          nodedata <- data.frame(label=x at node.label)
+        } 
         else {
-            nodedata <- tdata(x, "node", label.type="column")
+          nodedata <- tdata(x, "node", label.type="column")
         }
         if (all(dim(x at tip.data)==0)) {
-            tipdata <- data.frame(label=x at tip.label)
+          tipdata <- data.frame(label=x at tip.label)
         }
         else {
             tipdata <- tdata(x, "tip", label.type="column")

Modified: pkg/R/phylo4.R
===================================================================
--- pkg/R/phylo4.R	2008-12-19 04:43:24 UTC (rev 317)
+++ pkg/R/phylo4.R	2008-12-19 05:07:44 UTC (rev 318)
@@ -61,6 +61,10 @@
                standardGeneric("nodeLabels<-")
            })
 
+setGeneric("nodeNumbers", function(x) {
+    standardGeneric("nodeNumbers")
+})
+
 setGeneric("edgeLabels", function(x) {
     standardGeneric("edgeLabels")
 })

Modified: pkg/R/setAs-Methods.R
===================================================================
--- pkg/R/setAs-Methods.R	2008-12-19 04:43:24 UTC (rev 317)
+++ pkg/R/setAs-Methods.R	2008-12-19 05:07:44 UTC (rev 318)
@@ -123,7 +123,7 @@
     else node.type <- c("root", rep("internal", n.int - 1), 
         rep("tip", n.tip))
     return(data.frame(label, node, ancestor, branch.length, 
-        node.type))
+        node.type,stringsAsFactors=FALSE))
 })
 
 setAs(from = "phylo4d", to = "data.frame", function(from) {