[Phylobase-commits] r151 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Mar 8 01:35:34 CET 2008
Author: pdc
Date: 2008-03-08 01:35:34 +0100 (Sat, 08 Mar 2008)
New Revision: 151
Modified:
pkg/R/class-phylo4d.R
pkg/R/phylo4.R
Log:
Move phylo4d class def and constructor
Modified: pkg/R/class-phylo4d.R
===================================================================
--- pkg/R/class-phylo4d.R 2008-03-08 00:24:15 UTC (rev 150)
+++ pkg/R/class-phylo4d.R 2008-03-08 00:35:34 UTC (rev 151)
@@ -0,0 +1,74 @@
+###################################
+## phylo4d class
+## extend: phylo with data
+setClass("phylo4d",
+ representation(tip.data="data.frame",
+ node.data="data.frame"),
+ ## edgedata="data.frame"),
+ prototype = list( tip.data = data.frame(NULL),
+ node.data = data.frame(NULL) ),
+ ##all.data = data.frame(NULL) ),
+ validity = function(object) {
+ ## FIXME: finish this by intercepting FALSE, char string, etc.
+ check1 <- check_data(object)
+ check2 <- check_phylo4(object)
+ },
+ contains="phylo4")
+
+######################
+## phylo4d constructor
+######################
+## TEST ME
+## '...' recognized args for data are tipdata and nodedata.
+## other recognized options are those known by the phylo4 constructor
+##
+
+## generic
+setGeneric("phylo4d", function(x, ...) { standardGeneric("phylo4d")} )
+
+## first arg is a phylo4
+setMethod("phylo4d", c("phylo4"), function(x, tip.data=NULL, node.data=NULL, all.data=NULL, ...){
+
+ if(is.character(checkval <- check_phylo4(x))) stop(checkval)
+
+ res <- new("phylo4d")
+ res at edge <- x at edge
+ res at edge.length <- x at edge.length
+ res at Nnode <- x at Nnode
+ res at tip.label <- x at tip.label
+ res at node.label <- x at node.label
+ res at edge.label <- x at edge.label
+ res at root.edge <- x at root.edge
+
+### handle a which argument
+ which.dat <- match.arg(list(...)$"which", c("tip","node","all"))
+
+ ## handle data
+ if(all(is.null(c(tip.data, node.data, all.data)))) {
+ stop("no data provided; please use phylo4 class")
+ }
+
+ ## convert vector to data.frames
+ if(is.vector(tip.data)) tip.data <- as.data.frame(tip.data)
+ if(is.vector(node.data)) node.data <- as.data.frame(node.data)
+ if(is.vector(all.data)) all.data <- as.data.frame(all.data)
+
+ if(!is.null(all.data)){
+ if(!is.data.frame(all.data)) stop("all.data must be a data.frame")
+ tip.data <- all.data[1:nTips(x) , , drop=FALSE]
+ node.data <- all.data[-(1:nTips(x)) , , drop=FALSE]
+ }
+
+ ## now at least one data.frame is provided
+ if(is.null(tip.data)) tip.data <- data.frame(NULL)
+ if(is.null(node.data)) node.data <- data.frame(NULL)
+ if(!is.data.frame(tip.data)) stop("tip.data must be a data.frame")
+ if(!is.data.frame(node.data)) stop("node.data must be a data.frame")
+
+ res at tip.data <- tip.data
+ res at node.data <- node.data
+
+ check_data(res, ...)
+ res <- attach_data(res,...)
+ return(res)
+})
Modified: pkg/R/phylo4.R
===================================================================
--- pkg/R/phylo4.R 2008-03-08 00:24:15 UTC (rev 150)
+++ pkg/R/phylo4.R 2008-03-08 00:35:34 UTC (rev 151)
@@ -1,23 +1,6 @@
require(methods)
require(ape)
-###################################
-## phylo4d class
-## extend: phylo with data
-setClass("phylo4d",
- representation(tip.data="data.frame",
- node.data="data.frame"),
- ## edgedata="data.frame"),
- prototype = list( tip.data = data.frame(NULL),
- node.data = data.frame(NULL) ),
- ##all.data = data.frame(NULL) ),
- validity = function(object) {
- ## FIXME: finish this by intercepting FALSE, char string, etc.
- check1 <- check_data(object)
- check2 <- check_phylo4(object)
- },
- contains="phylo4")
-
## accessor functions for all internal bits
## HORRIBLE KLUGE
@@ -520,69 +503,6 @@
}
-
-
-
-
-
-######################
-## phylo4d constructor
-######################
-## TEST ME
-## '...' recognized args for data are tipdata and nodedata.
-## other recognized options are those known by the phylo4 constructor
-##
-
-## generic
-setGeneric("phylo4d", function(x, ...) { standardGeneric("phylo4d")} )
-
-## first arg is a phylo4
-setMethod("phylo4d", c("phylo4"), function(x, tip.data=NULL, node.data=NULL, all.data=NULL, ...){
-
- if(is.character(checkval <- check_phylo4(x))) stop(checkval)
-
- res <- new("phylo4d")
- res at edge <- x at edge
- res at edge.length <- x at edge.length
- res at Nnode <- x at Nnode
- res at tip.label <- x at tip.label
- res at node.label <- x at node.label
- res at edge.label <- x at edge.label
- res at root.edge <- x at root.edge
-
-### handle a which argument
- which.dat <- match.arg(list(...)$"which", c("tip","node","all"))
-
- ## handle data
- if(all(is.null(c(tip.data, node.data, all.data)))) {
- stop("no data provided; please use phylo4 class")
- }
-
- ## convert vector to data.frames
- if(is.vector(tip.data)) tip.data <- as.data.frame(tip.data)
- if(is.vector(node.data)) node.data <- as.data.frame(node.data)
- if(is.vector(all.data)) all.data <- as.data.frame(all.data)
-
- if(!is.null(all.data)){
- if(!is.data.frame(all.data)) stop("all.data must be a data.frame")
- tip.data <- all.data[1:nTips(x) , , drop=FALSE]
- node.data <- all.data[-(1:nTips(x)) , , drop=FALSE]
- }
-
- ## now at least one data.frame is provided
- if(is.null(tip.data)) tip.data <- data.frame(NULL)
- if(is.null(node.data)) node.data <- data.frame(NULL)
- if(!is.data.frame(tip.data)) stop("tip.data must be a data.frame")
- if(!is.data.frame(node.data)) stop("node.data must be a data.frame")
-
- res at tip.data <- tip.data
- res at node.data <- node.data
-
- check_data(res, ...)
- res <- attach_data(res,...)
- return(res)
-})
-
## first arg is a matrix of edges
setMethod("phylo4d", c("matrix"), function(x, tip.data=NULL, node.data=NULL, all.data=NULL, ...){
tree <- phylo4(edge=x,...)
More information about the Phylobase-commits
mailing list