[Phylobase-commits] r553 - pkg/R

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

Author: francois
Date: 2009-08-21 20:03:29 +0200 (Fri, 21 Aug 2009)
New Revision: 553

Modified:
   pkg/R/checkdata.R
   pkg/R/class-phylo4d.R
Log:
tweaked validator of phylo4d object, updated checkTree: removed parts about updatePhylo4, removed duplicated tests and empty phylo4d object validates correctly

Modified: pkg/R/checkdata.R
===================================================================
--- pkg/R/checkdata.R	2009-08-21 17:20:36 UTC (rev 552)
+++ pkg/R/checkdata.R	2009-08-21 18:03:29 UTC (rev 553)
@@ -11,11 +11,21 @@
 }
 
 checkTree <- function(object,warn="retic",err=NULL) {
+
+    ## case of empty phylo4 object
+    if(nrow(object at edge) == 0 && length(object at edge.length) == 0 &&
+       object at Nnode == 0 && length(object at node.label) == 0 &&
+       length(object at tip.label) == 0 && length(object at edge.label) == 0)
+        return(TRUE)
+
     ## FIXME: check for cyclicity?
     nedges <- nrow(object at edge)
+
     if (hasEdgeLength(object)) {
       if (length(object at edge.length) != nedges)
         return("edge lengths do not match number of edges")
+      if(!is.numeric(object at edge.length))
+          stop("Edge lengths are not numeric.")
       ## presumably we shouldn't allow NAs mixed
       ## with numeric branch lengths except at the root
       if (sum(is.na(object at edge.length)) > 1)
@@ -36,8 +46,10 @@
     intnodes <- nodes[!nodes %in% tips]
     roots <- E[which(is.na(E[,1])),2]
     nRoots <- length(roots)
+
     if (!(all(tips==1:ntips) && all(nodes=(ntips+1):(ntips+length(intnodes)))))
       return("tips and nodes incorrectly numbered")
+
     ##careful - nAncest does not work for counting nRoots in unrooted trees
     nAncest <- tabulate(na.omit(E)[, 2],nbins=max(nodes)) ## bug fix from Jim Regetz
     nDesc <- tabulate(na.omit(E[,1]))
@@ -78,10 +90,10 @@
 
     ## make sure that nodes and edges have internal names
     ## and that they match the nodes
-    if(is.null(names(object at tip.label))) {
+    if (is.null(names(object at tip.label))) {
         if(length(object at tip.label) == nTips(object)) {
-            stop("It seems that you have an old version of a phylo4 object. ",
-                  "Try to use the function updatePhylo4().")
+            stop("There is no internal name associated with your tips. Use the ",
+                 "function tipLabels <- to change your tip labels.")
         }
         else
             stop("Your object doesn't have internal node names and the number of ",
@@ -92,10 +104,11 @@
             stop("Internal names for tips don't match tip ID numbers")
     }
 
-    if(is.null(names(object at node.label))) {
+    if (is.null(names(object at node.label))) {
         if(length(object at node.label) == nNodes(object)) {
-            stop("It seems that you have an old version of a phylo4 object. ",
-                 "Try to use the function updatePhylo4().")
+            stop("There is no internal names associated with internal ",
+                 "nodes. Use the function nodeLabels <- to create or ",
+                 "change your internal node labels.")
         }
         else
             stop("Your object doesn't have internal node names and the number of ",
@@ -108,24 +121,19 @@
 
     if(hasEdgeLength(object)) {
         if(is.null(names(object at edge.length))) {
-            warning("It seems that you have an old version of a phylo4 object. ",
-                    "Try to use the function updatePhylo4().")
+            warning("Your edges don't have internal names. Use the function ",
+                    "edgeLength <- to update the the branch lengths of your ",
+                    "tree.")
         }
         else {
             tEdgLbl <- paste(object at edge[,1], object at edge[,2], sep="-")
             if(!all(names(object at edge.length) %in% tEdgLbl))
                 stop("There is something wrong with your internal edge length ",
-                     "labels.")
+                     "labels. Use the function edgeLength <- to update the the ",
+                     "branch lengths of your tree.")
         }
     }
 
-    ## make sure that edgeLength has correct length and is numerical
-    if(hasEdgeLength(object)) {
-        if(length(object at edge.length) != nedges)
-            stop("The number of edge lengths is different from the number of edges.")
-        if(!is.numeric(object at edge.length)) stop("Edge lengths are not numeric.")
-    }
-
     ## make sure that tip and node labels are unique
     lb <- labels(object, "allnode")
     lb <- lb[nchar(lb) > 0]

Modified: pkg/R/class-phylo4d.R
===================================================================
--- pkg/R/class-phylo4d.R	2009-08-21 17:20:36 UTC (rev 552)
+++ pkg/R/class-phylo4d.R	2009-08-21 18:03:29 UTC (rev 553)
@@ -8,9 +8,7 @@
          prototype = list( tip.data = data.frame(NULL),
            node.data = data.frame(NULL) ),
 
-         validity = function(object) {
-             checkPhylo4(object)
-         },
+         validity = checkPhylo4,
          contains="phylo4")
 
 ######################