[Phylobase-commits] r540 - in pkg: R man

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

Author: francois
Date: 2009-08-20 21:14:57 +0200 (Thu, 20 Aug 2009)
New Revision: 540

Modified:
   pkg/R/checkdata.R
   pkg/R/class-phylo4d.R
   pkg/man/check.phylo4d.Rd
Log:
added options rownamesAsLabels to phylo4d constructor

Modified: pkg/R/checkdata.R
===================================================================
--- pkg/R/checkdata.R	2009-08-20 19:13:49 UTC (rev 539)
+++ pkg/R/checkdata.R	2009-08-20 19:14:57 UTC (rev 540)
@@ -185,7 +185,8 @@
 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"),
-                       extra.data=c("warn", "OK", "fail")
+                       extra.data=c("warn", "OK", "fail"),
+                       rownamesAsLabels=FALSE
                        ) {
 
     type <- match.arg(type)
@@ -209,7 +210,7 @@
                           rownames = rownames(dt),
                           column = dt[,label.column])
         ndDt <- lapply(ndNames, function(nd) {
-            if(nchar(gsub("[0-9]", "", nd)) == 0)
+            if(nchar(gsub("[0-9]", "", nd)) == 0 && !rownamesAsLabels)
                 getNode(phy, as.integer(nd), missing="OK")
             else getNode(phy, nd, missing="OK")
         })

Modified: pkg/R/class-phylo4d.R
===================================================================
--- pkg/R/class-phylo4d.R	2009-08-20 19:13:49 UTC (rev 539)
+++ pkg/R/class-phylo4d.R	2009-08-20 19:14:57 UTC (rev 540)
@@ -28,7 +28,8 @@
 
 ## Core part that takes care of the data
 .phylo4Data <- function(x, tip.data=NULL, node.data=NULL, all.data=NULL,
-                        match.data=TRUE, merge.data=TRUE, ...) {
+                        match.data=TRUE, merge.data=TRUE, rownamesAsLabels=FALSE,
+                        ...) {
 
     ## Make sure that data provided are a data frame
     classData <- function(someData) {
@@ -51,20 +52,24 @@
     tip.data <- classData(tip.data)
     node.data <- classData(node.data)
 
-     is.empty <- function(x) { is.null(x) || all(dim(x)==0) }
+    is.empty <- function(x) { is.null(x) || all(dim(x)==0) }
+
     ## Replacing node labels by node numbers and formatting the data to make sure
     ## they have the correct dimensions
     if(!is.empty(all.data))
-        all.data <- formatData(x, all.data, type="all",
-                               match.data=match.data, ...)
+        all.data <- formatData(phy=x, dt=all.data, type="all",
+                               match.data=match.data,
+                               rownamesAsLabels=rownamesAsLabels, ...)
 
     if(!is.empty(tip.data))
-        tip.data <- formatData(x, tip.data, type="tip",
-                               match.data=match.data, ...)
+        tip.data <- formatData(phy=x, dt=tip.data, type="tip",
+                               match.data=match.data,
+                               rownamesAsLabels=rownamesAsLabels, ...)
 
     if(!is.empty(node.data))
-        node.data <- formatData(x, node.data, type="internal",
-                                match.data=match.data, ...)
+        node.data <- formatData(phy=x, dt=node.data, type="internal",
+                                match.data=match.data,
+                                rownamesAsLabels=rownamesAsLabels, ...)
 
     ## Merging dataset
     if(!is.empty(all.data)) {
@@ -156,7 +161,8 @@
 ### phylo4d class rewrite
 setMethod("phylo4d", "phylo4",
           function(x, tip.data=NULL, node.data=NULL, all.data=NULL,
-                   match.data=TRUE, merge.data=TRUE, ...) {
+                   match.data=TRUE, merge.data=TRUE, rownamesAsLabels=FALSE,
+                   ...) {
 
     ## Creating new phylo4d object
     res <- new("phylo4d")
@@ -168,8 +174,10 @@
     res at edge.label <- x at edge.label
 
     ## taking care of the data
-    tmpData <- .phylo4Data(x, tip.data, node.data, all.data, match.data,
-                           merge.data, ...)
+    tmpData <- .phylo4Data(x=x, tip.data=tip.data, node.data=node.data,
+                           all.data=all.data, match.data=match.data,
+                           merge.data=merge.data,
+                           rownamesAsLabels=rownamesAsLabels, ...)
 
     res at tip.data <- tmpData$tip.data
     res at node.data <- tmpData$node.data

Modified: pkg/man/check.phylo4d.Rd
===================================================================
--- pkg/man/check.phylo4d.Rd	2009-08-20 19:13:49 UTC (rev 539)
+++ pkg/man/check.phylo4d.Rd	2009-08-20 19:14:57 UTC (rev 540)
@@ -17,7 +17,8 @@
 formatData(phy, dt, type=c("tip", "internal", "all"),
                        match.data=TRUE, label.type=c("rownames", "column"),
                        label.column=1, missing.data=c("fail", "warn", "OK"),
-                       extra.data=c("warn", "OK", "fail"))
+                       extra.data=c("warn", "OK", "fail"),
+                       rownamesAsLabels=FALSE)
 \S4method{addData}{phylo4d}(x, tip.data=NULL, node.data=NULL,
                                          all.data=NULL, pos=c("after", "before"),
                                          merge.data=TRUE, match.data=TRUE,
@@ -42,6 +43,8 @@
   \item{pos}{add data columns before or after existing data?}
   \item{merge.data}{(logical) merge data if the name of the data match any existing
     tip/node data (if TRUE), or create an additional column data (if FALSE)}
+  \item{rownamesAsLabels}{(logical), in the case of number-like labels should the row
+  names of the data provided be considered as labels (TRUE) or node numbers (FALSE and default)}
   \item{\dots}{extra arguments, passed to \code{formatData}}
 }
 \value{