[Phylobase-commits] r677 - pkg/R

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

Author: regetz
Date: 2009-09-29 19:19:34 +0200 (Tue, 29 Sep 2009)
New Revision: 677

Modified:
   pkg/R/checkdata.R
   pkg/R/methods-phylo4.R
Log:
made edgeLabels replacement smarter by using .createEdge helper
function, and more space efficient by dropping NA values


Modified: pkg/R/checkdata.R
===================================================================
--- pkg/R/checkdata.R	2009-09-29 16:07:54 UTC (rev 676)
+++ pkg/R/checkdata.R	2009-09-29 17:19:34 UTC (rev 677)
@@ -82,16 +82,16 @@
     ## make sure tip/node labels have internal names that match node IDs
     lab.msg <- "Use tipLabels<- (and nodeLabels<- if needed) to update them."
     if (is.null(names(object at label))) {
-        return(c("Tip and node labels must have names matching node IDs. ",
+        stop(c("Tip and node labels must have names matching node IDs. ",
             lab.msg))
              
     } else {
         if (!all(tips %in% names(na.omit(object at label)))) {
-            return(c("All tips must have associated tip labels. ",
+            stop(c("All tips must have associated tip labels. ",
                 lab.msg))
         }
         if (!all(names(object at label) %in% nodeId(object, "all"))) {
-            return(c("One or more tip/node label has an unmatched ID name ",
+            stop(c("One or more tip/node label has an unmatched ID name ",
                 lab.msg))
         }
     }
@@ -100,15 +100,28 @@
     elen.msg <- "Use edgeLength<- to update them."
     if(hasEdgeLength(object)) {
         if (is.null(names(object at edge.length))) {
-            return(c("Edge lengths must have names matching edge IDs. ",
+            stop(c("Edge lengths must have names matching edge IDs. ",
                 elen.msg))
         }
         if (!all(names(object at edge.length) %in% edgeId(object, "all"))) {
-            return(c("One or more edge lengths has an unmatched ID name. ",
+            stop(c("One or more edge lengths has an unmatched ID name. ",
                 elen.msg))
         }
     }
 
+    ## make sure edge labels have internal names that match the edges
+    elab.msg <- "Use edgeLabels<- to update them."
+    if(hasEdgeLabels(object)) {
+        if (is.null(names(object at edge.label))) {
+            stop(c("Edge labels must have names matching edge IDs. ",
+                elab.msg))
+        }
+        if (!all(names(object at edge.label) %in% edgeId(object, "all"))) {
+            stop(c("One or more edge labels has an unmatched ID name. ",
+                elab.msg))
+        }
+    }
+
     ## make sure that tip and node labels are unique
     lb <- labels(object, "all")
     lb <- lb[nchar(lb) > 0]

Modified: pkg/R/methods-phylo4.R
===================================================================
--- pkg/R/methods-phylo4.R	2009-09-29 16:07:54 UTC (rev 676)
+++ pkg/R/methods-phylo4.R	2009-09-29 17:19:34 UTC (rev 677)
@@ -354,9 +354,10 @@
 
 setReplaceMethod("edgeLabels", signature(x="phylo4", value="character"),
   function(x, ..., value) {
-      x at edge.label <- value
-      if(is.character(checkval <- checkPhylo4(x))) stop(checkval)
-      x
+    lbl <- .createEdge(value, x at edge, type="labels")
+    x at edge.label <- lbl[!is.na(lbl)]
+    if(is.character(checkval <- checkPhylo4(x))) stop(checkval)
+    x
   })