[Phylobase-commits] r513 - pkg/R

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

Author: francois
Date: 2009-08-19 22:08:38 +0200 (Wed, 19 Aug 2009)
New Revision: 513

Modified:
   pkg/R/checkdata.R
Log:
created simple validator for phylo4d data

Modified: pkg/R/checkdata.R
===================================================================
--- pkg/R/checkdata.R	2009-08-19 19:54:41 UTC (rev 512)
+++ pkg/R/checkdata.R	2009-08-19 20:08:38 UTC (rev 513)
@@ -1,7 +1,13 @@
 
 ## REQUIRED for all trees
 checkPhylo4 <- function(object) {
-    checkTree(object)
+    ct <- checkTree(object)
+
+    if (class(object) == "phylo4d")
+        ## checkPhyo4Data returns TRUE or fail
+        cd <- checkPhylo4Data(object)
+
+    return(ct)
 }
 
 checkTree <- function(object,warn="retic",err=NULL) {
@@ -147,6 +153,35 @@
     return(TRUE)
 }
 
+checkPhylo4Data <- function(phy) {
+
+    ## These are just some basic tests to make sure that the user does not
+    ## alter the object in a significant way
+
+    ntips <- nTips(phy)
+    nnodes <- nNodes(phy)
+
+    ## Check dimensions
+    if (nrow(phy at tip.data) > 0 && nrow(phy at tip.data) != ntips)
+        stop("The number of tip data does not match the number ",
+             "of tips in the tree")
+    if (nrow(phy at node.data) > 0 && nrow(phy at node.data) != nnodes)
+        stop("The number of node data does not match the number ",
+             "of internal nodes in the tree")
+
+    ## Check rownames
+    if (nrow(phy at tip.data) > 0 &&
+       !all(rownames(phy at tip.data) %in% nodeId(phy, "tip")))
+        stop("The row names of tip data do not match the tip numbers")
+    if (nrow(phy at node.data) > 0 &&
+        !all(rownames(phy at node.data) %in% nodeId(phy, "internal")))
+        stop("The row names of node data do not match the node numbers")
+
+    return(TRUE)
+}
+
+
+
 formatData <- function(phy, dt, type=c("tip", "internal", "all"),
                        match.data=TRUE, label.type=c("rownames", "column"),
                        label.column=1, missing.data=c("fail", "warn", "OK"),
@@ -191,7 +226,7 @@
                                 "are correct.")
                    },
                    internal = {
-                       if(any(names(ndDt) %in% labels(phy, "tip")))
+                       if(any(na.omit(names(ndDt)) %in% labels(phy, "tip")))
                            stop("You are trying to match node data to tip ",
                                 "nodes. Make sure that your data identifiers ",
                                 "are correct.")