[Phylobase-commits] r132 - in pkg: . R tests

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

Author: bbolker
Date: 2008-02-29 20:37:39 +0100 (Fri, 29 Feb 2008)
New Revision: 132

Added:
   pkg/R/multiphylo.R
Modified:
   pkg/DESCRIPTION
   pkg/R/phylo4.R
   pkg/tests/phylotorture.R
Log:
  broke multiphylo classes into separate file;
started work on tbind function



Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2008-02-29 13:48:51 UTC (rev 131)
+++ pkg/DESCRIPTION	2008-02-29 19:37:39 UTC (rev 132)
@@ -9,4 +9,4 @@
 Maintainer:  Ben Bolker <bolker at ufl.edu>
 Description: Provides a base S4 class for comparative methods, incorporating one or more trees and trait data
 License: GPL
-Collate: pdata.R checkdata.R phylo4.R subset.R prune.R plot.R identify.R treestruc.R treewalk.R zzz.R ReadWithNCL.R
+Collate: pdata.R checkdata.R phylo4.R multiphylo.R subset.R prune.R plot.R identify.R treestruc.R treewalk.R zzz.R ReadWithNCL.R

Added: pkg/R/multiphylo.R
===================================================================
--- pkg/R/multiphylo.R	                        (rev 0)
+++ pkg/R/multiphylo.R	2008-02-29 19:37:39 UTC (rev 132)
@@ -0,0 +1,56 @@
+require(methods)
+require(ape)
+
+## setOldClass("multi.tree") ## obsolete
+setOldClass("multiPhylo")
+
+setClass("multiPhylo4",
+         representation(phylolist="list",
+                        tree.names="character"),
+         prototype = list(phylolist=list(),
+           tree.names=character(0)))
+
+setClass("multiPhylo4d",
+         representation(tip.data="data.frame"),
+         contains="multiPhylo4")
+
+setAs("multiPhylo4","multiPhylo",
+      function(from,to) {
+          newobj <- new("multiPhylo4",
+                        phylolist=lapply(from,as,to="phylo4"))
+      })
+
+setAs("multiPhylo4d","multiPhylo",
+      function(from,to) {
+          newobj <- new("multiPhylo4d",
+                        phylolist=lapply(from,as,to="phylo4"),
+                        tree.names=names(from),
+                        tip.data=data.frame())
+      })
+
+setAs("multiPhylo","multiPhylo4",
+      function(from,to) {
+          y <- lapply(as,from at phylolist,to="phylo")
+          names(y) <- from at tree.names
+          if (nrow(from at tip.data)>0) warning("discarded tip data")
+          class(y) <- "multiPhylo"
+          y
+      })
+
+
+## function to bind trees together into a multi-tree object
+tbind <- function(...,check_data=FALSE) {
+    L <- as.list(...)
+    treeclasses <- c("multiPhylo4d","multiPhylo4","phylo4","phylo4d")
+    tdataclasses <- c("multiPhylo4d","phylo4d")
+    classes <- sapply(L,class)
+    if (!all(classes %in% treeclasses)) stop("all elements must be trees or multitrees")
+    if (!all(classes %in% tdataclasses)) {
+        if (any(classes %in% tdataclasses)) warning("not all elements contain data: data discarded")
+        ## decompose multi-trees into lists
+        ## bind list into multi-tree
+    } else {
+        ## check: all data identical?
+        ## decompose multi-trees into lists
+    }
+}

Modified: pkg/R/phylo4.R
===================================================================
--- pkg/R/phylo4.R	2008-02-29 13:48:51 UTC (rev 131)
+++ pkg/R/phylo4.R	2008-02-29 19:37:39 UTC (rev 132)
@@ -2,8 +2,6 @@
 require(ape)
 
 setOldClass("phylo")
-## setOldClass("multi.tree") ## obsolete
-setOldClass("multiPhylo")
 
 setClass("phylo4",
          representation(edge="matrix",
@@ -522,16 +520,7 @@
 
 
 
-setClass("multiPhylo4",
-         representation(phylolist="list",
-                        tree.names="character"),
-         prototype = list(phylolist=list(),
-           tree.names=character(0)))
 
-setClass("multiPhylo4d",
-         representation(tip.data="data.frame"),
-         contains="multiPhylo4")
-
 ################
 ## show phylo4d    ### no longer used  
 ################
@@ -778,29 +767,7 @@
           phylo4d(as(from,"phylo4"),tip.data=data.frame())
       })
 
-setAs("multiPhylo4","multiPhylo",
-      function(from,to) {
-          newobj <- new("multiPhylo4",
-                        phylolist=lapply(from,as,to="phylo4"))
-      })
 
-setAs("multiPhylo4d","multiPhylo",
-      function(from,to) {
-          newobj <- new("multiPhylo4d",
-                        phylolist=lapply(from,as,to="phylo4"),
-                        tree.names=names(from),
-                        tip.data=data.frame())
-      })
-
-setAs("multiPhylo","multiPhylo4",
-      function(from,to) {
-          y <- lapply(as,from at phylolist,to="phylo")
-          names(y) <- from at tree.names
-          if (nrow(from at tip.data)>0) warning("discarded tip data")
-          class(y) <- "multiPhylo"
-          y
-      })
-
 setAs("phylo4","phylo",
       function(from,to) {
           y <- list(edge=from at edge,

Modified: pkg/tests/phylotorture.R
===================================================================
--- pkg/tests/phylotorture.R	2008-02-29 13:48:51 UTC (rev 131)
+++ pkg/tests/phylotorture.R	2008-02-29 19:37:39 UTC (rev 132)
@@ -99,3 +99,5 @@
 foo at edge <- rcoal(10)$edge
 print(try(plot(foo)))
 
+foo at tip.label <- rep('blah',10)
+foo at node.label <- rep("",9)