[Phylobase-commits] r574 - pkg/R

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

Author: francois
Date: 2009-08-24 05:34:40 +0200 (Mon, 24 Aug 2009)
New Revision: 574

Modified:
   pkg/R/checkdata.R
   pkg/R/class-phylo4d.R
Log:
fix bug in case of attaching all.data to tree and match.data=FALSE, changed name of argument in checkPhylo4Data from phy to object to make doc more consistent

Modified: pkg/R/checkdata.R
===================================================================
--- pkg/R/checkdata.R	2009-08-23 21:47:31 UTC (rev 573)
+++ pkg/R/checkdata.R	2009-08-24 03:34:40 UTC (rev 574)
@@ -177,28 +177,28 @@
     return(TRUE)
   }
 
-checkPhylo4Data <- function(phy) {
+checkPhylo4Data <- function(object) {
 
     ## 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)
+    ntips <- nTips(object)
+    nnodes <- nNodes(object)
 
     ## Check dimensions
-    if (nrow(phy at tip.data) > 0 && nrow(phy at tip.data) != ntips)
+    if (nrow(object at tip.data) > 0 && nrow(object 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)
+    if (nrow(object at node.data) > 0 && nrow(object 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")))
+    if (nrow(object at tip.data) > 0 &&
+       !all(rownames(object at tip.data) %in% nodeId(object, "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")))
+    if (nrow(object at node.data) > 0 &&
+        !all(rownames(object at node.data) %in% nodeId(object, "internal")))
         stop("The row names of node data do not match the node numbers")
 
     return(TRUE)
@@ -298,6 +298,10 @@
         ## Remove rownames in data provided
         rownames(dt) <- NULL
 
+        ## Tips before internal nodes for all.data
+        if (type == "all")
+            rownames(tmpDt) <- 1:nr
+
         ## Check differences between dataset and tree
         diffNr <- nrow(dt) - nr
         if(diffNr > 0 && extra.data != "OK") {

Modified: pkg/R/class-phylo4d.R
===================================================================
--- pkg/R/class-phylo4d.R	2009-08-23 21:47:31 UTC (rev 573)
+++ pkg/R/class-phylo4d.R	2009-08-24 03:34:40 UTC (rev 574)
@@ -92,17 +92,10 @@
             tmpData <- cbind(tmpData, tmpNodeData)
         }
 
-        if(match.data) {
-            tip.data <- tmpData[rownames(tmpData) %in% nodeId(x, "tip") ,,
-                                    drop = FALSE]
-            node.data <- tmpData[rownames(tmpData) %in% nodeId(x, "internal") ,,
-                                     drop = FALSE]
-        }
-        else {
-            tip.data <- tmpData[1:nTips(x) ,, drop=FALSE]
-            node.data <- tmpData[-(1:nTips(x)) ,, drop=FALSE]
-        }
-
+        tip.data <- tmpData[rownames(tmpData) %in% nodeId(x, "tip") ,,
+                            drop = FALSE]
+        node.data <- tmpData[rownames(tmpData) %in% nodeId(x, "internal") ,,
+                             drop = FALSE]
     }
 
     else {
@@ -207,7 +200,7 @@
         x$node.label <- NULL
         nlab.data[!nzchar(nlab.data)] <- NA
 
-        nlab.data <- data.frame(labelValues=as.numeric(nlab.data))        
+        nlab.data <- data.frame(labelValues=as.numeric(nlab.data))
 
         tree <- phylo4(x, check.node.labels="drop")
         res <- phylo4d(tree, tip.data, node.data, all.data, ...)