[Phylobase-commits] r468 - in pkg: . R man tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Aug 18 19:31:18 CEST 2009
Author: bbolker
Date: 2009-08-18 19:31:17 +0200 (Tue, 18 Aug 2009)
New Revision: 468
Added:
pkg/R/updatePhylo4.R
pkg/tests/RUnit-tests.R
pkg/tests/dUnit.Rout.save
pkg/tests/misctests.Rout.save
pkg/tests/nexusdata.Rout.save
pkg/tests/phylo4dtests.Rout.save
pkg/tests/phylotorture.Rout.save
pkg/tests/plottestUnit-tests.Rout.save
pkg/tests/testprune.Rout.save
Modified:
pkg/DESCRIPTION
pkg/R/treePlot.R
pkg/man/tree.plot.Rd
pkg/tests/plottest.R
Log:
added ".save" files for tests
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2009-08-18 17:13:35 UTC (rev 467)
+++ pkg/DESCRIPTION 2009-08-18 17:31:17 UTC (rev 468)
@@ -9,6 +9,6 @@
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: phylo4.R checkData-deprecated.R checkdata.R class-multiphylo4.R class-oldclasses.R class-phylo4.R class-phylo4d.R class-phylomats.R methods-multiphylo4.R methods-oldclasses.R methods-phylo4.R methods-phylo4d.R setAs-Methods.R pdata.R subset.R prune.R treePlot.R identify.R treestruc.R treewalk.R readNexus.R tbind.R zzz.R printphylo-deprecated.R updatePhylo4.R
+Collate: phylo4.R checkdata.R class-multiphylo4.R class-oldclasses.R class-phylo4.R class-phylo4d.R class-phylomats.R methods-multiphylo4.R methods-oldclasses.R methods-phylo4.R methods-phylo4d.R setAs-Methods.R pdata.R subset.R prune.R treePlot.R identify.R treestruc.R treewalk.R readNexus.R tbind.R zzz.R printphylo-deprecated.R updatePhylo4.R
Encoding: UTF-8
URL: http://phylobase.R-forge.R-project.org
Modified: pkg/R/treePlot.R
===================================================================
--- pkg/R/treePlot.R 2009-08-18 17:13:35 UTC (rev 467)
+++ pkg/R/treePlot.R 2009-08-18 17:31:17 UTC (rev 468)
@@ -120,8 +120,11 @@
plot.density(dens, xlim = c(tmin, tmax), axes = FALSE,
mar = c(0,0,0,0), main = "", xlab = "", ylab = "", ...)
}
- }
- }
+ }
+ mc <- match.call()
+ mc$tip.plot.fun <- tip.plot.fun
+ eval(mc)
+ }
} else { ## if (is.function(tip.plot.fun))
## plot.at.tip <- TRUE
if (plot.at.tip) {
@@ -177,6 +180,7 @@
## TODO should plots float at tips, or only along edge?
hc <- convertY(unit(1/nvars, 'snpc'), 'npc')
for(i in 1:nvars) {
+ vals = tdata(phy)[nodeId(phy,'tip'),i,drop=FALSE]
pushViewport(viewport(
x = i/nvars, ## xxyy$yy[phy at edge[, 2] == i],
y = 0.5, ## 1 + 1/(2 * Ntips), # xxyy$xx[phy at edge[, 2] == i],
@@ -188,7 +192,6 @@
angle = -rot
))
#grid.rect()
- vals = tdata(phy)[nodeId(phy,'tip'),i,drop=FALSE]
if (!all(is.na(vals))) tip.plot.fun(vals, tmin, tmax, ...)
upViewport()
}
Added: pkg/R/updatePhylo4.R
===================================================================
--- pkg/R/updatePhylo4.R (rev 0)
+++ pkg/R/updatePhylo4.R 2009-08-18 17:31:17 UTC (rev 468)
@@ -0,0 +1,26 @@
+updatePhylo4 <- function(phy, ...) {
+ ## Add internal names for tip labels
+ if(is.null(names(phy at tip.label))) {
+ if(length(phy at tip.label == nTips(phy))) {
+ names(phy at tip.label) <- nodeId(phy, "tip")
+ }
+ else stop("You have a problem with your tip labels")
+ }
+
+ ## Add internal names for node labels
+ if(is.null(names(phy at node.label))) {
+ if(length(phy at node.label) == nNodes(phy)) {
+ names(phy at node.label) <- nodeId(phy, "internal")
+ }
+ else stop("You have a problem with your node labels.")
+ }
+
+ ## Add internal names for edge lengths
+ if(hasEdgeLength(phy) && is.null(names(phy at edge.length))) {
+ names(phy at edge.length) <- paste(phy at edge[,1], phy at edge[,2], sep="-")
+ }
+
+ if(is.character(msg <- checkPhylo4(phy))) stop(msg)
+ else return(phy)
+
+}
Property changes on: pkg/R/updatePhylo4.R
___________________________________________________________________
Name: svn:executable
+ *
Modified: pkg/man/tree.plot.Rd
===================================================================
--- pkg/man/tree.plot.Rd 2009-08-18 17:13:35 UTC (rev 467)
+++ pkg/man/tree.plot.Rd 2009-08-18 17:31:17 UTC (rev 468)
@@ -8,7 +8,6 @@
tree.plot(xxyy, type, show.tip.label, show.node.label,
edge.color, node.color, tip.color, edge.width, rot)
}
-%- maybe also 'usage' for other objects documented here.
\arguments{
\item{xxyy}{ A list created by the \code{\link{phyloXXYY}} function }
\item{type}{ A character string indicating the shape of plotted tree }
Added: pkg/tests/RUnit-tests.R
===================================================================
--- pkg/tests/RUnit-tests.R (rev 0)
+++ pkg/tests/RUnit-tests.R 2009-08-18 17:31:17 UTC (rev 468)
@@ -0,0 +1,7 @@
+require(RUnit)
+## TODO -- find solution to run these tests on R-forge
+
+##testsuite <- defineTestSuite("phylobase", dirs="/home/francois/Work/R-dev/phylobase/branches/fm-branch/RUnit-tests",
+## testFileRegexp="^test", testFuncRegexp="^test")
+##testRslt <- runTestSuite(testsuite)
+##printTextProtocol(testRslt)
Added: pkg/tests/dUnit.Rout.save
===================================================================
--- pkg/tests/dUnit.Rout.save (rev 0)
+++ pkg/tests/dUnit.Rout.save 2009-08-18 17:31:17 UTC (rev 468)
@@ -0,0 +1 @@
+Fatal error: cannot open file 'dUnit.R': No such file or directory
Added: pkg/tests/misctests.Rout.save
===================================================================
--- pkg/tests/misctests.Rout.save (rev 0)
+++ pkg/tests/misctests.Rout.save 2009-08-18 17:31:17 UTC (rev 468)
@@ -0,0 +1,335 @@
+
+R version 2.9.1 (2009-06-26)
+Copyright (C) 2009 The R Foundation for Statistical Computing
+ISBN 3-900051-07-0
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+ Natural language support but running in an English locale
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> library(phylobase)
+Loading required package: grid
+Loading required package: ape
+> library(ape)
+>
+> data(geospiza)
+> geospiza0 <-
++ list(geospiza.tree=as(geospiza,"phylo"),geospiza.data=tdata(geospiza))
+Warning message:
+In asMethod(object) : losing data while coercing phylo4d to phylo
+> ## push data back into list form as in geiger
+>
+> t1 <- try(p1 <- phylo4d(geospiza0$geospiza.tree,geospiza0$geospiza.data))
+> ## Error in checkData(res, ...) :
+> ## Tip data names are a subset of tree tip labels.
+>
+> p2 <- as(geospiza0$geospiza.tree,"phylo4")
+> plot(p2)
+>
+> lab1 <- labels(p2)
+> lab2 <- rownames(geospiza0$geospiza.data)
+>
+> lab1[!lab1 %in% lab2] ## missing data
+named character(0)
+> lab2[!lab2 %in% lab1] ## extra data (none)
+character(0)
+> p1 <- phylo4d(p2,geospiza0$geospiza.data, missing.data="warn")
+> p1 <- phylo4d(p2,geospiza0$geospiza.data, missing.data="OK")
+>
+> plot(p1)
+> plot(p1,show.node.label=TRUE)
+> ## one way to deal with it:
+>
+> p1B <- prune(p1,tip="olivacea")
+>
+> ## or ...
+> p1C <- na.omit(p1)
+>
+> labels(p1C) <- tolower(labels(p1C))
+Note: Method with signature "phylo4d#missing#ANY" chosen for function "labels<-",
+ target signature "phylo4d#missing#character".
+ "phylo4#ANY#character" would also be valid
+>
+> ## trace("prune",browser,signature="phylo4d")
+> r1 <- rcoal(5)
+>
+> ## trace("phylo4d", browser, signature = "phylo")
+> ## untrace("phylo4d", signature = "phylo")
+> tipdat <- data.frame(a=1:5, row.names=r1$tip.label)
+> q1 <- phylo4d(r1,tip.data=tipdat, node.data=data.frame(a=6:9), match.data=FALSE)
+> q2 <- prune(q1,1)
+> summary(q2)
+
+ Phylogenetic tree : as(x, "phylo4")
+
+ Number of tips : 4
+ Number of nodes : 3
+ Branch lengths:
+ mean : 0.8162666
+ variance : 0.5393207
+ distribution :
+ Min. 1st Qu. Median 3rd Qu. Max. NA's
+0.06861 0.14220 0.83100 1.35000 1.73100 1.00000
+
+Comparative data:
+
+Tips: data.frame with 4 taxa and 1 variable(s)
+
+ a
+ Min. :2.00
+ 1st Qu.:2.75
+ Median :3.50
+ Mean :3.50
+ 3rd Qu.:4.25
+ Max. :5.00
+
+Nodes: data.frame with 3 internal nodes and 1 variables
+
+ a
+ Min. :6.000
+ 1st Qu.:7.000
+ Median :8.000
+ Mean :7.667
+ 3rd Qu.:8.500
+ Max. :9.000
+>
+> tipdat2 <- tipdat
+> row.names(tipdat2)[1] <- "s1"
+> t1 <- try(q1 <- phylo4d(r1,tip.data=tipdat2))
+Error in switch(missing.data, warn = warning(msg), fail = stop(msg)) :
+ The following nodes are not found in the dataset: t2
+>
+> plot(q2)
+> plot(q2,type="cladogram")
+> ## plot(p2,type="dotchart",labels.nodes=nodeLabels(p2))
+> ## trace("plot", browser, signature = c("phylo4d","missing"))
+> tipLabels(q1) <- paste("q",1:5,sep="")
+> nodeLabels(q1) <- paste("n",1:4,sep="")
+Note: Method with signature "phylo4#character" chosen for function "nodeLabels<-",
+ target signature "phylo4d#character".
+ "phylo4d#ANY" would also be valid
+> p3 <- phylo4d(r1,tip.data=tipdat,node.data=data.frame(b=6:9), match.data=FALSE)
+> summary(p3)
+
+ Phylogenetic tree : as(x, "phylo4")
+
+ Number of tips : 5
+ Number of nodes : 4
+ Branch lengths:
+ mean : 0.63558
+ variance : 0.4171704
+ distribution :
+ Min. 1st Qu. Median 3rd Qu. Max. NA's
+0.06861 0.15740 0.27500 1.31600 1.54400 1.00000
+
+Comparative data:
+
+Tips: data.frame with 5 taxa and 2 variable(s)
+
+ a b
+ Min. :1 Min. : NA
+ 1st Qu.:2 1st Qu.: NA
+ Median :3 Median : NA
+ Mean :3 Mean :NaN
+ 3rd Qu.:4 3rd Qu.: NA
+ Max. :5 Max. : NA
+ NA's : 5
+
+Nodes: data.frame with 4 internal nodes and 2 variables
+
+ a b
+ Min. : NA Min. :6.00
+ 1st Qu.: NA 1st Qu.:6.75
+ Median : NA Median :7.50
+ Mean :NaN Mean :7.50
+ 3rd Qu.: NA 3rd Qu.:8.25
+ Max. : NA Max. :9.00
+ NA's : 4
+>
+> plot(p1)
+>
+> plot(subset(p1,tips.include=c("fuliginosa","fortis","magnirostris",
++ "conirostris","scandens")))
+> ## better error?
+> ## Error in phy$edge[, 2] : incorrect number of dimensions
+>
+> if(dev.cur() == 1) get(getOption("device"))()
+> plot(subset(p2,tips.include=c("fuliginosa","fortis","magnirostris",
++ "conirostris","scandens")))
+>
+> plot(p2,show.node.label=TRUE)
+>
+> tree.owls <- read.tree(text="(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);")
+>
+> z <- as(tree.owls,"phylo4")
+>
+> example("phylo4d")
+
+phyl4d> tree.owls.bis <- read.tree(text = "((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3);")
+
+phyl4d> try(phylo4d(as(tree.owls.bis,"phylo4"),data.frame(wing=1:3)), silent=TRUE)
+ label node ancestor edge.length node.type wing
+4 <NA> 4 NA NA root NA
+5 <NA> 5 4 3.1 internal NA
+1 Strix_aluco 1 5 4.2 tip 1
+2 Asio_otus 2 5 4.2 tip 2
+3 Athene_noctua 3 4 7.3 tip 3
+
+phyl4d> obj <- phylo4d(as(tree.owls.bis,"phylo4"),data.frame(wing=1:3), match.data=FALSE)
+
+phyl4d> obj
+ label node ancestor edge.length node.type wing
+4 <NA> 4 NA NA root NA
+5 <NA> 5 4 3.1 internal NA
+1 Strix_aluco 1 5 4.2 tip 1
+2 Asio_otus 2 5 4.2 tip 2
+3 Athene_noctua 3 4 7.3 tip 3
+
+phyl4d> print(obj)
+ label node ancestor edge.length node.type wing
+4 <NA> 4 NA NA root NA
+5 <NA> 5 4 3.1 internal NA
+1 Strix_aluco 1 5 4.2 tip 1
+2 Asio_otus 2 5 4.2 tip 2
+3 Athene_noctua 3 4 7.3 tip 3
+
+phyl4d> ####
+phyl4d>
+phyl4d> data(geospiza_raw)
+
+phyl4d> geoTree <- geospiza_raw$tree
+
+phyl4d> geoData <- geospiza_raw$data
+
+phyl4d> ## fix differences in tip names between the tree and the data
+phyl4d> geoData <- rbind(geoData, array(, dim = c(1,ncol(geoData)),
+phyl4d+ dimnames = list("olivacea", colnames(geoData))))
+
+phyl4d> ### Example using a tree of class 'phylo'
+phyl4d> exGeo1 <- phylo4d(geoTree, tip.data = geoData)
+
+phyl4d> ### Example using a tree of class 'phylo4'
+phyl4d> geoTree <- as(geoTree, "phylo4")
+
+phyl4d> ## some random node data
+phyl4d> rNodeData <- data.frame(randomTrait = rnorm(nNodes(geoTree)),
+phyl4d+ row.names = nodeId(geoTree, "internal"))
+
+phyl4d> exGeo2 <- phylo4d(geoTree, tip.data = geoData, node.data = rNodeData)
+
+phyl4d> ### Example using 'merge.tip.node'
+phyl4d> ## some random tip data
+phyl4d> rTipData <- data.frame(randomTrait = rnorm(nTips(geoTree)),
+phyl4d+ row.names = labels(geoTree))
+
+phyl4d> (exGeo3 <- phylo4d(geoTree, tip.data = rTipData, node.data = rNodeData))
+ label node ancestor edge.length node.type randomTrait
+15 <NA> 15 NA NA root 0.25577454
+16 <NA> 16 15 0.29744 internal 0.86769755
+17 <NA> 17 16 0.04924 internal -2.08515078
+18 <NA> 18 17 0.06859 internal 0.39122856
+19 <NA> 19 18 0.13404 internal -0.66808200
+20 <NA> 20 19 0.10346 internal -0.21801689
+21 <NA> 21 20 0.03550 internal -0.11720628
+22 <NA> 22 21 0.00917 internal -1.61587843
+23 <NA> 23 22 0.07333 internal -1.02073220
+24 <NA> 24 23 0.05500 internal -0.19007815
+25 <NA> 25 19 0.24479 internal 0.89905260
+26 <NA> 26 25 0.05167 internal -1.09665559
+27 <NA> 27 26 0.01500 internal 0.82563692
+1 fuliginosa 1 24 0.05500 tip -0.72633004
+2 fortis 2 24 0.05500 tip 1.42331228
+3 magnirostris 3 23 0.11000 tip -0.96997736
+4 conirostris 4 22 0.18333 tip -1.92888517
+5 scandens 5 21 0.19250 tip 0.32895432
+6 difficilis 6 20 0.22800 tip 1.32110321
+7 pallida 7 25 0.08667 tip 0.13861951
+8 parvulus 8 27 0.02000 tip 0.83866486
+9 psittacula 9 27 0.02000 tip -0.74336014
+10 pauper 10 26 0.03500 tip -0.76657934
+11 Platyspiza 11 18 0.46550 tip 0.04396034
+12 fusca 12 17 0.53409 tip 1.92215664
+13 Pinaroloxias 13 16 0.58333 tip 0.07769987
+14 olivacea 14 15 0.88077 tip -0.66580805
+
+phyl4d> (exGeo4 <- phylo4d(geoTree, tip.data = rTipData, node.data = rNodeData,
+phyl4d+ merge.data = FALSE))
+ label node ancestor edge.length node.type randomTrait randomTrait.1
+15 <NA> 15 NA NA root NA 0.2557745
+16 <NA> 16 15 0.29744 internal NA 0.8676976
+17 <NA> 17 16 0.04924 internal NA -2.0851508
+18 <NA> 18 17 0.06859 internal NA 0.3912286
+19 <NA> 19 18 0.13404 internal NA -0.6680820
+20 <NA> 20 19 0.10346 internal NA -0.2180169
+21 <NA> 21 20 0.03550 internal NA -0.1172063
+22 <NA> 22 21 0.00917 internal NA -1.6158784
+23 <NA> 23 22 0.07333 internal NA -1.0207322
+24 <NA> 24 23 0.05500 internal NA -0.1900782
+25 <NA> 25 19 0.24479 internal NA 0.8990526
+26 <NA> 26 25 0.05167 internal NA -1.0966556
+27 <NA> 27 26 0.01500 internal NA 0.8256369
+1 fuliginosa 1 24 0.05500 tip -0.72633004 NA
+2 fortis 2 24 0.05500 tip 1.42331228 NA
+3 magnirostris 3 23 0.11000 tip -0.96997736 NA
+4 conirostris 4 22 0.18333 tip -1.92888517 NA
+5 scandens 5 21 0.19250 tip 0.32895432 NA
+6 difficilis 6 20 0.22800 tip 1.32110321 NA
+7 pallida 7 25 0.08667 tip 0.13861951 NA
+8 parvulus 8 27 0.02000 tip 0.83866486 NA
+9 psittacula 9 27 0.02000 tip -0.74336014 NA
+10 pauper 10 26 0.03500 tip -0.76657934 NA
+11 Platyspiza 11 18 0.46550 tip 0.04396034 NA
+12 fusca 12 17 0.53409 tip 1.92215664 NA
+13 Pinaroloxias 13 16 0.58333 tip 0.07769987 NA
+14 olivacea 14 15 0.88077 tip -0.66580805 NA
+
+phyl4d> ### Example with 'all.data'x
+phyl4d> nodeLabels(geoTree) <- as.character(nodeId(geoTree))
+
+phyl4d> rAllData <- data.frame(randomTrait = rnorm(nTips(geoTree) + nNodes(geoTree)),
+phyl4d+ row.names = labels(geoTree, 'all'))
+
+phyl4d> exGeo5 <- phylo4d(geoTree, all.data = rAllData)
+> obj1 <- obj2 <- obj3 <- phylo4d(z, data.frame(wing=1:4,color=factor(c("b","w","b","b")), tail=runif(4)*10), match.data=FALSE)
+>
+> obj2 at tip.data <- as.data.frame(obj2 at tip.data[,1])
+> obj3 at tip.data <- cbind(obj1 at tip.data,obj2 at tip.data)
+> obj4 <- obj1
+> obj4 at tip.data[2,3] <- NA
+> obj4 at tip.data[1,1] <- NA
+>
+> nodeLabels(obj4) <- character(0)
+>
+> obj5 <- obj1
+> tdata(obj4) <- subset(tdata(obj4),select=sapply(tdata(obj4),class)=="numeric")
+>
+> treePlot(obj4)
+>
+> E <- matrix(c(
++ 8, 9,
++ 9, 10,
++ 10, 1,
++ 10, 2,
++ 9, 3,
++ 9, 4,
++ 8, 11,
++ 11, 5,
++ 11, 6,
++ 11, 7,
++ NA, 8), ncol=2,byrow=TRUE)
+>
+> P2 <- phylo4(E)
+>
+> proc.time()
+ user system elapsed
+ 3.572 0.084 3.686
Added: pkg/tests/nexusdata.Rout.save
===================================================================
--- pkg/tests/nexusdata.Rout.save (rev 0)
+++ pkg/tests/nexusdata.Rout.save 2009-08-18 17:31:17 UTC (rev 468)
@@ -0,0 +1,40 @@
+
+R version 2.9.1 (2009-06-26)
+Copyright (C) 2009 The R Foundation for Statistical Computing
+ISBN 3-900051-07-0
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+ Natural language support but running in an English locale
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> ## try to read NEXUS files
+> ## library(phylobase)
+> ## fn <- system.file("nexusfiles/treepluscharV01.nex",package="phylobase")
+> ## td<-NexusToPhylo4D(fn)
+> ## summary(td)
+> ## would try plotting, but typically don't have enough room
+> ## to plot data
+> ## Error in .local(x, ...) :
+> ## No room left to plot data; please try reducing ratio.tree or cex.label.
+> ## plot(as(td,"phylo4"))
+>
+> ## try to read a nexus file where the newick string describing the tree is split
+> ## across several lines
+> ## multiLine <- system.file("nexusfiles/MultiLineTrees.nex",package="phylobase")
+> ## multiLineTrees <-NexusToPhylo4(multiLine)
+> ## summary(multiLineTrees)
+>
+>
+> proc.time()
+ user system elapsed
+ 0.444 0.040 0.481
Added: pkg/tests/phylo4dtests.Rout.save
===================================================================
--- pkg/tests/phylo4dtests.Rout.save (rev 0)
+++ pkg/tests/phylo4dtests.Rout.save 2009-08-18 17:31:17 UTC (rev 468)
@@ -0,0 +1,84 @@
+
+R version 2.9.1 (2009-06-26)
+Copyright (C) 2009 The R Foundation for Statistical Computing
+ISBN 3-900051-07-0
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+ Natural language support but running in an English locale
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> library(phylobase)
+Loading required package: grid
+Loading required package: ape
+> require(ape)
+> tree.phylo <- read.tree(text="(((A,B)C,D),E);") #only one node is labelled
+> tree <- as(tree.phylo, "phylo4")
+>
+> tree.phylo2 <- read.tree(text="(((A,B)C,D)F,E)G;") # all nodes labelled
+> tree2 <- as(tree.phylo2, "phylo4")
+>
+> tip.data <- data.frame(size=c(1, 2, 3, 4))
+> rownames(tip.data) <- c("A", "B", "E", "D")
+>
+> treed <- phylo4d(tree, tip.data)
+> dat2 <- data.frame(size=c(0,1,2), row.names=c("G", "F", "C"))
+>
+> try(phylo4d(tree, node.data=dat2), silent = TRUE) # error, cannot match data because no node labels on tree
+> phylo4d(tree2, node.data=dat2) -> treed2 # OK tree labelled; has node data, no tip data
+>
+> try(plot(treed2), silent = TRUE) #causes problems with plot() no output
+> tdata(treed2) #returns null unless "allnode" or "node" is specified
+data frame with 0 columns and 0 rows
+>
+> phylo4d(tree2, tip.data=tip.data, node.data=dat2) -> treed3 #node+tip data
+>
+> plot(treed3) # works
+> tdata(treed3) #works, but returns tips only
+ size
+A 1
+B 2
+D 4
+E 3
+> tdata(treed3, "allnode")
+ size
+A 1
+B 2
+D 4
+E 3
+G 0
+F 1
+C 2
+>
+> print(tree)
+ label node ancestor edge.length node.type
+5 5 NA NA root
+6 6 5 NA internal
+7 C 7 6 NA internal
+1 A 1 7 NA tip
+2 B 2 7 NA tip
+3 D 3 6 NA tip
+4 E 4 5 NA tip
+> print(treed)
+ label node ancestor edge.length node.type size
+5 5 NA NA root NA
+6 6 5 NA internal NA
+7 C 7 6 NA internal NA
+1 A 1 7 NA tip 1
+2 B 2 7 NA tip 2
+3 D 3 6 NA tip 4
+4 E 4 5 NA tip 3
+>
+>
+> proc.time()
+ user system elapsed
+ 1.800 0.044 1.836
Added: pkg/tests/phylotorture.Rout.save
===================================================================
--- pkg/tests/phylotorture.Rout.save (rev 0)
+++ pkg/tests/phylotorture.Rout.save 2009-08-18 17:31:17 UTC (rev 468)
@@ -0,0 +1,205 @@
+
+R version 2.9.1 (2009-06-26)
+Copyright (C) 2009 The R Foundation for Statistical Computing
+ISBN 3-900051-07-0
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+ Natural language support but running in an English locale
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> ## torture-testing phylo4 objects.
+> require(phylobase)
+Loading required package: phylobase
+Loading required package: grid
+Loading required package: ape
+> set.seed(1001)
+> p1 <- list()
+> n <- 10
+> ## don't want to slow down R CMD check by doing this every time:
+> ## n <- 10000
+> for (i in 1:n) {
++ ## e2 <- c(sample(1:5,replace=FALSE,size=5),sample(6:10,replace=FALSE,size=5))
++ ## e1 <- sample(6:10,replace=TRUE
++ e <- matrix(sample(1:10,replace=TRUE,size=10),ncol=2)
++ p1[[i]] <- try(phylo4(e),silent=TRUE)
++ }
+Warning messages:
+1: In tips == 1:ntips :
+ longer object length is not a multiple of shorter object length
+2: In tips == 1:ntips :
+ longer object length is not a multiple of shorter object length
+3: In tips == 1:ntips :
+ longer object length is not a multiple of shorter object length
+4: In tips == 1:ntips :
+ longer object length is not a multiple of shorter object length
+> OKvals <- sapply(p1,class)!="try-error"
+> table(sapply(p1[!OKvals],as.character))
+
+ Error in .local(x, ...) : tips and nodes incorrectly numbered\n
+ 9
+Error in vector("character", length) : invalid 'length' argument\n
+ 1
+>
+> if (any(OKvals)) {
++ p2 <- p1[OKvals]
++ length(p2)
++ has.poly <- sapply(p2,hasPoly)
++ has.sing <- sapply(p2,hasSingle)
++ has.retic <- sapply(p2,hasRetic)
++ ##
++ if (any(has.sing)) {
++ p4 <- p2[has.sing]
++ plot(p4[[1]]) ## gives descriptive error
++ t2 <- try(plot(collapse.singles(as(p2[[1]],"phylo"))))
++ ## "incorrect number of dimensions"
++ }
++ if (any(!has.sing)) {
++ ## first tree without singles -- HANGS!
++ ## don't try the plot in an R session you care about ...
++ p3 <- p2[!has.sing]
++ ## plot(p2[[13]])
++ }
++ }
+>
+> ## elements 8 and 34 are
+> ## what SHOULD the rules for trees be?
+>
+> ## (a) reduce node numbers to 1 ... N ?
+> ## (b) check: irreducible, non-cyclic, ... ?
+>
+> ## convert to matrix format for checking?
+>
+> reduce_nodenums <- function(e) {
++ matrix(as.numeric(factor(e)),ncol=2)
++ }
+>
+> # make an illegal phylo4 object, does it pass checks?
+> # a disconnected node:
+>
+> t1 <- read.tree (text="((a,b), (c,(d, e)));")
+> plot(t1)
+>
+> broke1 <- t1
+> broke1$edge[broke1$edge[,2] ==9, 1] <- 9 # disconnect the node, two subtrees, ((a, b), c) and (d,e)
+>
+> try(as(broke1, "phylo4") -> tree, silent=TRUE) # makes a phylo4 object with no warning
+Warning message:
+In checkTree(object) : tree is reticulated:tree contains singleton nodes
+> try(phylo4(broke1$edge), silent=TRUE) # constructor makes a phylo4 object with no warning
+ label node ancestor edge.length node.type
+6 <NA> 6 NA NA internal
+7 <NA> 7 6 NA internal
+8 <NA> 8 6 NA internal
+9 <NA> 9 9 NA internal
+1 T1 1 7 NA tip
+2 T2 2 7 NA tip
+3 T3 3 8 NA tip
+4 T4 4 9 NA tip
+5 T5 5 9 NA tip
+Warning messages:
+1: In checkTree(object) :
+ tree is reticulated:tree contains singleton nodes
+2: In checkTree(object) :
+ tree is reticulated:tree contains singleton nodes
+> ## error message comes from ape, not phylo? -- AND
+> ## error is about singles, not disconnected nodes
+> ## print(try(plot(tree), silent=TRUE )) ## pdc couldn't get this to work, so temporarily commenting
+>
+> # root node value != ntips + 1:
+>
+> broke2 <- t1
+> broke2$edge[broke2$edge==6] <- 10
+>
+> ## warning, but no error
+> ## plot(broke2) ## seems to hang R CMD check??
+> ## generates error, but it's about wrong number of tips, not wrong value at root.
+> print(try(as(broke2, "phylo4"), silent=TRUE))
+[1] "Error in .createLabels(value = tip.label, ntips = ntips, nnodes = nnodes, : \n Number of labels does not match number of nodes.\n"
+attr(,"class")
+[1] "try-error"
+> ## error regarding number of tip labels vs edges and nodes
+> print(try(phylo4(broke2$edge), silent=TRUE))
+[1] "Error in .local(x, ...) : tips and nodes incorrectly numbered\n"
+attr(,"class")
+[1] "try-error"
+Warning message:
+In tips == 1:ntips :
+ longer object length is not a multiple of shorter object length
+>
+> # switch root node value (6) with next internal node (7):
+>
+> broke3 <- broke2
+> broke3$edge[broke3$edge==7] <- 6
+> broke3$edge[broke3$edge==10] <- 7
+>
+> ## both of the following now fail with
+> ## "root node is not at position (nTips+1)
+> try(as(broke3,"phylo4") -> tree3) # works with no error message
+Error in .local(x, ...) : root node must be first row of edge matrix
+> try(phylo4(broke3$edge)) # works with no error message
+ label node ancestor edge.length node.type
+7 <NA> 7 NA NA internal
+6 <NA> 6 7 NA internal
+8 <NA> 8 7 NA internal
+9 <NA> 9 8 NA internal
+1 T1 1 6 NA tip
+2 T2 2 6 NA tip
+3 T3 3 8 NA tip
+4 T4 4 9 NA tip
+5 T5 5 9 NA tip
+> ## plot(tree3) # would work if we could create it?
+>
+>
+> # tips have larger numbers than root node:
+>
+> broke4 <- t1
+> broke4$edge[broke4$edge==1] <- 11
+> broke4$edge[broke4$edge==2] <- 12
+> broke4$edge[broke4$edge==3] <- 13
+> broke4$edge[broke4$edge==4] <- 14
+> broke4$edge[broke4$edge==5] <- 15
+>
+> print(try(as(broke4, "phylo4"), silent=TRUE) ) # error message saying tree has more than one root
+[1] "Error in .local(x, ...) : tips and nodes incorrectly numbered\n"
+attr(,"class")
+[1] "try-error"
+> print(try(phylo4(broke4$edge),silent=TRUE)) # error message saying tree has more than one root
+[1] "Error in .local(x, ...) : tips and nodes incorrectly numbered\n"
+attr(,"class")
+[1] "try-error"
+> # print(try(plot(broke4), TRUE)) ## CAUSES R TO HANG!
+>
+> ###
+> foo <- new('phylo4')
+> set.seed(1001)
+> foo at edge <- rcoal(10)$edge
+> print(try(plot(foo)))
+Error in treePlot(x, ...) : treePlot function requires a rooted tree.
+[1] "Error in treePlot(x, ...) : treePlot function requires a rooted tree.\n"
+attr(,"class")
+[1] "try-error"
+>
+> foo at tip.label <- rep('blah',10)
+> foo at node.label <- rep("",9)
+>
+> #####
+> ## tree with only 2 tips: will fail under previous versions
+> ## with "Error in if (which(nAncest == 0) != nTips + 1) { :
+> ## argument is of length zero"
+>
+> edge <- matrix(c(3,1,3,2),byrow=TRUE,ncol=2)
+> try(p2 <- phylo4(edge), silent=TRUE)
+>
+> proc.time()
+ user system elapsed
+ 1.680 0.064 1.733
Modified: pkg/tests/plottest.R
===================================================================
--- pkg/tests/plottest.R 2009-08-18 17:13:35 UTC (rev 467)
+++ pkg/tests/plottest.R 2009-08-18 17:31:17 UTC (rev 468)
@@ -15,7 +15,7 @@
plot(g2, show.node.label=TRUE)
-g2B <- as(g2, "phylog")
+g2B <- as(extractTree(g2), "phylog")
## Note the numbering differences!
## round trip
@@ -45,3 +45,8 @@
}
## never mind, I don't know how to construct a useful
## 2D color space anyway ...
+
+
+treePlot(g2,plot.at.tip=TRUE,tip.plot.fun=
+ function(x,...) {
+ grid.points(seq(along=x),x)})
Added: pkg/tests/plottestUnit-tests.Rout.save
===================================================================
--- pkg/tests/plottestUnit-tests.Rout.save (rev 0)
+++ pkg/tests/plottestUnit-tests.Rout.save 2009-08-18 17:31:17 UTC (rev 468)
@@ -0,0 +1 @@
+Fatal error: cannot open file 'plottestUnit-tests.R': No such file or directory
Added: pkg/tests/testprune.Rout.save
===================================================================
--- pkg/tests/testprune.Rout.save (rev 0)
+++ pkg/tests/testprune.Rout.save 2009-08-18 17:31:17 UTC (rev 468)
@@ -0,0 +1,78 @@
+
+R version 2.9.1 (2009-06-26)
+Copyright (C) 2009 The R Foundation for Statistical Computing
+ISBN 3-900051-07-0
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+ Natural language support but running in an English locale
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> library(phylobase)
+Loading required package: grid
+Loading required package: ape
+> library(ape)
+> r1 <- rcoal(5)
+>
+> ## trace("phylo4d", browser, signature = "phylo")
+> ## untrace("phylo4d", signature = "phylo")
+> tipdat <- data.frame(a=1:5,row.names=r1$tip.label)
+> p1 <- phylo4d(r1,tip.data=tipdat,node.data=data.frame(a=6:9), match.data=FALSE)
+> p2 <- prune(p1,1)
+> summary(p2)
+
+ Phylogenetic tree : as(x, "phylo4")
+
+ Number of tips : 4
+ Number of nodes : 3
+ Branch lengths:
+ mean : 0.2089533
+ variance : 0.03350737
+ distribution :
+ Min. 1st Qu. Median 3rd Qu. Max. NA's
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/phylobase -r 468
More information about the Phylobase-commits
mailing list