[Phylobase-commits] r809 - in pkg: . R inst/unitTests man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Aug 6 21:26:05 CEST 2010
Author: francois
Date: 2010-08-06 21:26:04 +0200 (Fri, 06 Aug 2010)
New Revision: 809
Added:
pkg/inst/unitTests/runit.readNCL.R
pkg/man/readNCL.Rd
Removed:
pkg/R/readNexus.R
pkg/man/readNexus.Rd
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/R/readNCL.R
Log:
moved readNexus to readNCL.R, readNCL can now import newick formatted trees, new function readNewick for reading newick formatted trees, changed default of levels.uniform to FALSE, renamed readNexus.Rd to readNCL.Rd, new unit tests for readNCL
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2010-08-06 19:03:53 UTC (rev 808)
+++ pkg/DESCRIPTION 2010-08-06 19:26:04 UTC (rev 809)
@@ -2,12 +2,12 @@
Type: Package
Title: Base package for phylogenetic structures and comparative data
Version: 0.6.1
-Date: 2010-07-15
+Date: 2010-08-06
Depends: methods, grid, ape(>= 2.1), Rcpp (>= 0.8.3)
Suggests: ade4, MASS
Author: R Hackathon et al. (alphabetically: Ben Bolker, Marguerite Butler, Peter Cowan, Damien de Vienne, Dirk Eddelbuettel, Mark Holder, Thibaut Jombart, Steve Kembel, Francois Michonneau, David Orme, Brian O'Meara, Emmanuel Paradis, Jim Regetz, Derrick Zwickl)
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 (>= 2)
-Collate: phylo4.R checkdata.R formatData.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 phylobase.options.R prune.R treePlot.R treestruc.R treewalk.R readNexus.R readNCL.R tbind.R zzz.R
+Collate: phylo4.R checkdata.R formatData.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 phylobase.options.R prune.R treePlot.R treestruc.R treewalk.R readNCL.R tbind.R zzz.R
URL: http://phylobase.R-forge.R-project.org
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2010-08-06 19:03:53 UTC (rev 808)
+++ pkg/NAMESPACE 2010-08-06 19:26:04 UTC (rev 809)
@@ -59,8 +59,9 @@
export(getNode, ancestor, children, descendants, siblings, ancestors,
MRCA, shortestPath, getEdge)
-# Nexus functions
+# Import functions
export(readNexus)
+export(readNewick)
export(readNCL)
# pdata functions
Modified: pkg/R/readNCL.R
===================================================================
--- pkg/R/readNCL.R 2010-08-06 19:03:53 UTC (rev 808)
+++ pkg/R/readNCL.R 2010-08-06 19:26:04 UTC (rev 809)
@@ -1,14 +1,19 @@
+### This file contains the source code for the functions:
+### - readNCL (generic function)
+### - readNexus (wrapper for readNCL importing Nexus files)
+### - readNewick (wrapper for readNCL importing Newick files)
+
readNCL <- function(file, simplify=FALSE, type=c("all", "tree", "data"),
char.all=FALSE, polymorphic.convert=TRUE,
- levels.uniform=TRUE, quiet=TRUE,
+ levels.uniform=FALSE, quiet=TRUE,
check.node.labels=c("keep", "drop", "asdata"),
- return.labels=TRUE, ...) {
+ return.labels=TRUE, file.format=c("nexus", "newick"), ...) {
type <- match.arg(type)
check.node.labels <- match.arg(check.node.labels)
-
-
+ file.format <- match.arg(file.format)
+ if (file.format == "newick") file.format <- "relaxedphyliptree"
if (type == "all" || type == "data") {
returnData <- TRUE
@@ -23,7 +28,7 @@
returnTrees <- FALSE
}
- fileName <- list(fileName=file)
+ fileName <- list(fileName=file, fileFormat=file.format)
parameters <- c(char.all, polymorphic.convert, levels.uniform, returnTrees, returnData)
## GetNCL returns a list containing:
@@ -141,7 +146,12 @@
tr <- phylo4(tr, check.node.labels=check.node.labels, ...)
}
else {
- tr <- phylo4d(tr, check.node.labels=check.node.labels, ...)
+ if (check.node.labels == "asdata") {
+ tr <- phylo4d(tr, check.node.labels=check.node.labels, ...)
+ }
+ else {
+ tr <- phylo4(tr, check.node.labels=check.node.labels, ...)
+ }
}
})
if (length(listTrees) == 1 || simplify)
@@ -190,3 +200,21 @@
toRet
}
+readNexus <- function (file, simplify=FALSE, type=c("all", "tree", "data"),
+ char.all=FALSE, polymorphic.convert=TRUE,
+ levels.uniform=FALSE, quiet=TRUE,
+ check.node.labels=c("keep", "drop", "asdata"),
+ return.labels=TRUE, ...) {
+
+ return(readNCL(file=file, simplify=simplify, type=type, char.all=char.all,
+ polymorphic.convert=polymorphic.convert, levels.uniform=levels.uniform,
+ quiet=quiet, check.node.labels=check.node.labels,
+ return.labels=return.labels, file.format="nexus", ...))
+}
+
+readNewick <- function(file, simplify=FALSE, quiet=TRUE,
+ check.node.labels=c("keep", "drop", "asdata"), ...) {
+
+ return(readNCL(file=file, simplify=simplify, quiet=quiet,
+ check.node.labels=check.node.labels, file.format="newick", ...))
+}
Deleted: pkg/R/readNexus.R
===================================================================
--- pkg/R/readNexus.R 2010-08-06 19:03:53 UTC (rev 808)
+++ pkg/R/readNexus.R 2010-08-06 19:26:04 UTC (rev 809)
@@ -1,11 +0,0 @@
-readNexus <- function (file, simplify=FALSE, type=c("all", "tree", "data"),
- char.all=FALSE, polymorphic.convert=TRUE,
- levels.uniform=TRUE, quiet=TRUE,
- check.node.labels=c("keep", "drop", "asdata"),
- return.labels=TRUE, ...) {
-
- return(readNCL(file=file, simplify=simplify, type=type, char.all=char.all,
- polymorphic.convert=polymorphic.convert, levels.uniform=levels.uniform,
- quiet=quiet, check.node.labels=check.node.labels,
- return.labels=return.labels, ...))
-}
Added: pkg/inst/unitTests/runit.readNCL.R
===================================================================
--- pkg/inst/unitTests/runit.readNCL.R (rev 0)
+++ pkg/inst/unitTests/runit.readNCL.R 2010-08-06 19:26:04 UTC (rev 809)
@@ -0,0 +1,467 @@
+#
+# --- Test readNCL.R ---
+#
+
+### Get all the test files
+if (Sys.getenv("RCMDCHECK") == FALSE) {
+ pth <- file.path(getwd(), "..", "inst", "nexusfiles")
+} else {
+ pth <- system.file(package="phylobase", "nexusfiles")
+}
+## co1.nex -- typical output from MrBayes. Contains 2 identical trees, the first
+## one having posterior probabilities as node labels
+co1File <- file.path(pth, "co1.nex")
+
+## MultiLineTrees.nex -- 2 identical trees stored on several lines
+multiLinesFile <- file.path(pth, "MultiLineTrees.nex")
+
+## treeWithDiscreteData.nex -- Mesquite file with discrete data
+treeDiscDt <- file.path(pth, "treeWithDiscreteData.nex")
+
+## treeWithPolyExcludedData.nex -- Mesquite file with polymorphic and excluded
+## characters
+treePolyDt <- file.path(pth, "treeWithPolyExcludedData.nex")
+
+## treeWithContinuousData.nex -- Mesquite file with continuous characters
+treeContDt <- file.path(pth, "treeWithContinuousData.nex")
+
+## treeWithDiscAndContData.nex -- Mesquite file with both discrete and
+## continuous data
+treeDiscCont <- file.path(pth, "treeWithDiscAndContData.nex")
+
+## noStateLabels.nex -- Discrete characters with missing state labels
+noStateLabels <- file.path(pth, "noStateLabels.nex")
+
+## Newick trees
+newick <- file.path(pth, "newick.tre")
+
+## Contains correct (as of 2010-03-08) phylo4 representation of one of the tree
+## stored in the nexus file
+mlFile <- file.path(pth, "multiLines.Rdata")
+
+## Contains representation of data associated with continuous data
+ExContDataFile <- file.path(pth, "ExContData.Rdata")
+
+
+stopifnot(file.exists(co1File))
+stopifnot(file.exists(treeDiscDt))
+stopifnot(file.exists(multiLinesFile))
+stopifnot(file.exists(mlFile))
+stopifnot(file.exists(treePolyDt))
+stopifnot(file.exists(treeContDt))
+stopifnot(file.exists(treeDiscCont))
+stopifnot(file.exists(ExContDataFile))
+stopifnot(file.exists(noStateLabels))
+
+op <- phylobase.options()
+
+test.readNCL <- function() {
+ ## function (file, simplify=TRUE, type=c("all", "tree", "data"),
+ ## char.all=FALSE, polymorphic.convert=TRUE, levels.uniform=TRUE,
+ ## check.node.labels=c("keep", "drop", "asdata"))
+
+ ## ########### CO1 -- MrBayes file -- tree only
+ ## Tree properties
+ ## Labels
+ labCo1 <- c("Cow", "Seal", "Carp", "Loach", "Frog", "Chicken", "Human",
+ "Mouse", "Rat", "Whale", NA, NA, NA, NA, NA, NA, NA, NA)
+ names(labCo1) <- 1:18
+ ## Edge lengths
+ eLco1 <- c(0.143336, 0.225087, 0.047441, 0.055934, 0.124549, 0.204809, 0.073060, 0.194575,
+ 0.171296, 0.222039, 0.237101, 0.546258, 0.533183, 0.154442, 0.134574, 0.113163,
+ 0.145592)
+ names(eLco1) <- c("11-1", "11-2", "11-12", "12-13", "13-14", "14-15", "15-16", "16-17", "17-3",
+ "17-4", "16-5", "15-6", "14-7", "13-18", "18-8", "18-9", "12-10")
+ ## Node types
+ nTco1 <- c("tip", "tip", "tip", "tip", "tip", "tip", "tip", "tip", "tip",
+ "tip", "internal", "internal", "internal", "internal", "internal",
+ "internal", "internal", "internal")
+ names(nTco1) <- 1:18
+ ## Label values
+ lVco1 <- c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.93, 0.88, 0.99, 1.00,
+ 0.76, 1.00, 1.00)
+ ## Read trees
+ co1 <- readNCL(file=co1File, check.node.labels="asdata")
+ ## Tree 1
+ co1Tree1 <- co1[[1]]
+ checkIdentical(labels(co1Tree1), labCo1) # check labels
+ checkIdentical(edgeLength(co1Tree1), eLco1) # check edge lengths
+ checkIdentical(nodeType(co1Tree1), nTco1) # check node types
+ checkIdentical(as(co1Tree1, "data.frame")$labelValues, lVco1) # check label values
+ ## Tree 2
+ co1Tree2 <- co1[[2]]
+ checkIdentical(labels(co1Tree2), labCo1) # check labels
+ checkIdentical(edgeLength(co1Tree2), eLco1) # check edge lengths
+ checkIdentical(nodeType(co1Tree2), nTco1) # check node types
+
+ ## Check option simplify
+ co1 <- readNCL(file=co1File, check.node.labels="asdata", simplify=TRUE)
+ checkIdentical(length(co1), as.integer(1)) # make sure there is only one tree
+ checkIdentical(labels(co1), labCo1) # check labels
+ checkIdentical(edgeLength(co1), eLco1) # check edge lengths
+ checkIdentical(nodeType(co1), nTco1) # check node type
+ checkIdentical(as(co1, "data.frame")$labelValues, lVco1) # check label values
+
+ ## Check option check.node.labels
+ phylobase.options(allow.duplicated.labels="fail")
+ checkException(readNCL(file=co1File, check.node.labels="keep")) # fail because labels aren't unique
+ phylobase.options(op)
+ phylobase.options(allow.duplicated.labels="ok")
+ co1 <- readNCL(file=co1File, check.node.labels="keep", simplify=TRUE)
+ checkIdentical(nodeLabels(co1), setNames(c(NA, "0.93", "0.88", "0.99", "1.00", "0.76", "1.00", "1.00"),
+ 11:18))
+ phylobase.options(op)
+ co1 <- readNCL(file=co1File, check.node.labels="drop", simplify=TRUE)
+ checkIdentical(labels(co1), labCo1) # check labels
+ checkIdentical(edgeLength(co1), eLco1) # check edge lengths
+ checkIdentical(nodeType(co1), nTco1) # check node type
+ checkIdentical(as(co1, "data.frame")$labelValues, NULL) # check label values don't exist
+
+ ## ########### Mutli Lines -- tree only
+ multiLines <- readNCL(file=multiLinesFile)
+ ## load correct representation and make sure that the trees read
+ ## match it
+ load(mlFile)
+ checkIdentical(multiLines[[1]], ml1)
+ checkIdentical(multiLines[[2]], ml1)
+ rm(ml1)
+
+ ## ########### Tree + data -- file from Mesquite
+ ## tree properties
+ labTr <- c("Myrmecocystussemirufus", "Myrmecocystusplacodops",
+ "Myrmecocystusmendax", "Myrmecocystuskathjuli",
+ "Myrmecocystuswheeleri", "Myrmecocystusmimicus",
+ "Myrmecocystusdepilis", "Myrmecocystusromainei",
+ "Myrmecocystusnequazcatl", "Myrmecocystusyuma",
+ "Myrmecocystuskennedyi", "Myrmecocystuscreightoni",
+ "Myrmecocystussnellingi", "Myrmecocystustenuinodis",
+ "Myrmecocystustestaceus", "Myrmecocystusmexicanus",
+ "Myrmecocystuscfnavajo", "Myrmecocystusnavajo",
+ NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA)
+ names(labTr) <- 1:35
+ eTr <- c(1.699299, 0.894820, 0.836689, 4.524387, 0.506099, 0.198842, 0.689044,
+ 2.926053, 1.724765, 1.724765, 4.650818, 4.255993, 1.083870, 1.083870,
+ 0.802512, 2.027251, 2.708942, 2.708942, NA, 0.284767, 2.257581,
+ 2.193845, 2.193845, 4.451425, 6.044804, 10.569191, 8.635503, 2.770378,
+ 2.770378, 12.300701, 8.275077, 5.724923, 2.855375, 2.869547, 2.869547)
+ names(eTr) <- c("19-20","20-21","21-22","22-23","23-24","24-25","25-26","26-27",
+ "27-1", "27-2","26-3","25-28","28-4","28-5","24-29","29-30",
+ "30-6","30-7","0-19","29-31","31-32","32-8","32-9","31-10",
+ "23-11","22-12","21-33","33-13","33-14","20-15","19-34","34-16",
+ "34-35","35-17","35-18")
+ nTtr <- c("tip", "tip", "tip", "tip", "tip", "tip", "tip", "tip", "tip",
+ "tip", "tip", "tip", "tip", "tip", "tip", "tip", "tip", "tip",
+ "root", "internal", "internal", "internal", "internal", "internal",
+ "internal", "internal", "internal", "internal", "internal",
+ "internal", "internal", "internal", "internal", "internal",
+ "internal")
+ names(nTtr) <- 1:35
+ ## data to test against
+ dtTest1 <- data.frame(time = factor(c(2,1,0,0,0,0,2,0,2,0,0,0,0,1,1,1,0,1)),
+ subgenus = factor(c(2,1,0,0,0,0,2,0,2,0,0,0,0,1,1,2,0,1)))
+ row.names(dtTest1) <- c("Myrmecocystuscfnavajo","Myrmecocystuscreightoni",
+ "Myrmecocystusdepilis","Myrmecocystuskathjuli",
+ "Myrmecocystuskennedyi","Myrmecocystusmendax",
+ "Myrmecocystusmexicanus","Myrmecocystusmimicus",
+ "Myrmecocystusnavajo","Myrmecocystusnequazcatl",
+ "Myrmecocystusplacodops","Myrmecocystusromainei",
+ "Myrmecocystussemirufus","Myrmecocystussnellingi",
+ "Myrmecocystustenuinodis","Myrmecocystustestaceus",
+ "Myrmecocystuswheeleri","Myrmecocystusyuma")
+ dtTest2 <- dtTest1
+ levels(dtTest2$time) <- c("diurnal", "crepuscular", "nocturnal")
+ levels(dtTest2$subgenus) <- c("Endiodioctes", "Eremnocystus", "Myrmecocystus")
+ p4 <- "phylo4"
+ p4d <- "phylo4d"
+ attributes(p4) <- attributes(p4d) <- list(package="phylobase")
+ ## Tree only
+ tr <- readNCL(file=treeDiscDt, type="tree")
+ checkIdentical(labels(tr), labTr) # check labels
+ checkIdentical(edgeLength(tr), eTr) # check edge lengths
+ checkIdentical(nodeType(tr), nTtr) # check node types
+ checkIdentical(class(tr), p4) # check class
+ ## Data only
+ dt1 <- readNCL(file=treeDiscDt, type="data", return.labels=FALSE,
+ levels.uniform=FALSE)
+ checkIdentical(dt1, dtTest1)
+ dt2 <- readNCL(file=treeDiscDt, type="data", return.labels=TRUE,
+ levels.uniform=FALSE)
+ checkIdentical(dt2, dtTest2)
+ ## Tree + Data
+ trDt1 <- readNCL(file=treeDiscDt, type="all", return.labels=FALSE,
+ levels.uniform=FALSE)
+ checkIdentical(labels(trDt1), labTr) # check labels
+ checkIdentical(edgeLength(trDt1), eTr) # check edge lengths
+ checkIdentical(nodeType(trDt1), nTtr) # check node types
+ checkIdentical(class(trDt1), p4d) # check class
+ checkIdentical(tdata(trDt1, type="tip")[rownames(dtTest1), ], dtTest1)
+ trDt2 <- readNCL(file=treeDiscDt, type="all", return.labels=TRUE,
+ levels.uniform=FALSE)
+ checkIdentical(labels(trDt2), labTr) # check labels
+ checkIdentical(edgeLength(trDt2), eTr) # check edge lengths
+ checkIdentical(nodeType(trDt2), nTtr) # check node types
+ checkIdentical(class(trDt2), p4d) # check class
+ checkIdentical(tdata(trDt2, type="tip")[rownames(dtTest2), ], dtTest2)
+
+ ## ########## Tree + Data -- Test for polymorphic.convert, levels.uniform and char.all
+ ## data to test against
+ ## dtTest 3 -- levels.uniform=FALSE, return.labels=FALSE, polymorphic.convert=FALSE
+ dtPoly1 <- data.frame(Test1=factor(c(0,0,1,1,0,NA,1,1,1,0,0,NA,1,1,NA,0,1,
+ NA)),
+ Test2=factor(c(0,0,0,0,0,NA,0,1,0,1,1,
+ "{0,1}",NA,0,NA,0,"{0,1}",1)),
+ Test3=factor(c(1,1,1,0,0,0,2,
+ "{0,1,2}",0,NA,0,"{0,1}",0,1,0,0,"{0,1,2}",1)),
+ row.names=c("Myrmecocystussemirufus","Myrmecocystusplacodops",
+ "Myrmecocystusmendax","Myrmecocystuskathjuli",
+ "Myrmecocystuswheeleri","Myrmecocystusmimicus",
+ "Myrmecocystusdepilis","Myrmecocystusromainei",
+ "Myrmecocystusnequazcatl","Myrmecocystusyuma",
+ "Myrmecocystuskennedyi","Myrmecocystuscreightoni",
+ "Myrmecocystussnellingi","Myrmecocystustenuinodis",
+ "Myrmecocystustestaceus","Myrmecocystusmexicanus",
+ "Myrmecocystuscfnavajo","Myrmecocystusnavajo"))
+ ## dtPoly2 -- levels.uniform=FALSE, return.labels=FALSE, polymorphic.convert=TRUE
+ dtPoly2 <- dtPoly1
+ dtPoly2[c(12,17),2] <- NA
+ dtPoly2[c(8,12,17),3] <- NA
+ dtPoly2$Test1 <- factor(dtPoly2$Test1)
+ dtPoly2$Test2 <- factor(dtPoly2$Test2)
+ dtPoly2$Test3 <- factor(dtPoly2$Test3)
+ ## dtPoly3 -- levels.uniform=FALSE, return.labels=TRUE, polymorphic.convert=TRUE
+ dtPoly3 <- dtPoly2
+ levels(dtPoly3$Test1) <- c("test1A", "test1B")
+ levels(dtPoly3$Test2) <- c("test2A", "test2B")
+ levels(dtPoly3$Test3) <- c("test3A", "test3B", "test3C")
+ ## dtPoly4 -- levels.uniform=FALSE, return.labels=TRUE, polymorphic.convert=FALSE
+ ## not yet implemented
+
+ ## dtPoly5 -- levels.uniform=TRUE, return.labels=FALSE, polymorphic.convert=FALSE
+ dtPoly5 <- dtPoly1
+ levels(dtPoly5$Test1) <- levels(dtPoly5$Test2) <- levels(dtPoly5$Test3) <-
+ union(levels(dtPoly1$Test1), c(levels(dtPoly1$Test2), levels(dtPoly1$Test3)))
+ ## dtPoly6 -- levels.uniform=TRUE, return.labels=FALSE, polymorphic.convert=TRUE
+ dtPoly6 <- dtPoly2
+ levels(dtPoly6$Test1) <- levels(dtPoly6$Test2) <- levels(dtPoly6$Test3) <-
+ union(levels(dtPoly2$Test1), c(levels(dtPoly2$Test2), levels(dtPoly2$Test3)))
+ ## dtPoly7 -- levels.uniform=TRUE, return.labels=TRUE, polymorphic.convert=FALSE
+ ## not yet implemented
+
+ ## dtPoly8 -- levels.uniform=TRUE, return.labels=TRUE, polymorphic.convert=TRUE
+ dtPoly8 <- dtPoly3
+ levels(dtPoly8$Test1) <- levels(dtPoly8$Test2) <- levels(dtPoly8$Test3) <-
+ union(levels(dtPoly3$Test1), c(levels(dtPoly3$Test2), levels(dtPoly3$Test3)))
+ ## dtPoly5F -- char.all=FALSE, levels.uniform=TRUE, return.labels=FALSE, polymorphic.convert=FALSE
+ dtPoly5F <- dtPoly1[, 1:2]
+ levels(dtPoly5F$Test1) <- levels(dtPoly5F$Test2) <-
+ union(levels(dtPoly1$Test1), levels(dtPoly1$Test2))
+ ## dtPoly6F -- char.all=FALSE, levels.uniform=TRUE, return.labels=FALSE, polymorphic.convert=TRUE
+ dtPoly6F <- dtPoly2[, 1:2]
+ levels(dtPoly6F$Test1) <- levels(dtPoly6F$Test2) <-
+ union(levels(dtPoly2$Test1), levels(dtPoly2$Test2))
+ ## dtPoly8F -- char.all=FALSE, levels.uniform=TRUE, return.labels=TRUE, polymorphic.convert=TRUE
+ dtPoly8F <- dtPoly3[, 1:2]
+ levels(dtPoly8F$Test1) <- levels(dtPoly8F$Test2) <-
+ union(levels(dtPoly3$Test1), levels(dtPoly3$Test2))
+
+ ## char.all=TRUE, levels.uniform=FALSE, return.labels=FALSE, polymorphic.convert=FALSE
+ trChr1 <- readNCL(file=treePolyDt, type="all", polymorphic.convert=FALSE,
+ levels.uniform=FALSE, char.all=TRUE, return.labels=FALSE)
+ checkIdentical(labels(trChr1), labTr) # check labels
+ checkIdentical(edgeLength(trChr1), eTr) # check edge lengths
+ checkIdentical(nodeType(trChr1), nTtr) # check node types
+ checkIdentical(class(trChr1), p4d) # check class
+ checkIdentical(tdata(trChr1, "tip"), dtPoly1)
+ ## char.all=TRUE, levels.uniform=FALSE, return.labels=FALSE, polymorphic.convert=TRUE
+ trChr2 <- readNCL(file=treePolyDt, type="all", polymorphic.convert=TRUE,
+ levels.uniform=FALSE, return.labels=FALSE, char.all=TRUE)
+ checkIdentical(labels(trChr2), labTr) # check labels
+ checkIdentical(edgeLength(trChr2), eTr) # check edge lengths
+ checkIdentical(nodeType(trChr2), nTtr) # check node types
+ checkIdentical(class(trChr2), p4d) # check class
+ checkIdentical(tdata(trChr2, "tip"), dtPoly2)
+ ## char.all=TRUE, levels.uniform=FALSE, return.labels=TRUE, polymorphic.convert=TRUE
+ trChr3 <- readNCL(file=treePolyDt, type="all", polymorphic.convert=TRUE,
+ levels.uniform=FALSE, char.all=TRUE, return.labels=TRUE)
+ checkIdentical(labels(trChr3), labTr) # check labels
+ checkIdentical(edgeLength(trChr3), eTr) # check edge lengths
+ checkIdentical(nodeType(trChr3), nTtr) # check node types
+ checkIdentical(class(trChr3), p4d) # check class
+ checkIdentical(tdata(trChr3, "tip"), dtPoly3)
+ ## char.all=TRUE, levels.uniform=FALSE, return.labels=TRUE, polymorphic.convert=FALSE
+ ## not yet implemented
+ ## trChr4 <-
+ checkException(readNCL(file=treePolyDt, type="all",
+ levels.uniform=FALSE,
+ return.labels=TRUE,
+ polymorphic.convert=FALSE))
+ ## char.all=TRUE, levels.uniform=TRUE, return.labels=FALSE, polymorphic.convert=FALSE
+ trChr5 <- readNCL(file=treePolyDt, type="all", polymorphic.convert=FALSE,
+ levels.uniform=TRUE, char.all=TRUE, return.labels=FALSE)
+ checkIdentical(labels(trChr5), labTr) # check labels
+ checkIdentical(edgeLength(trChr5), eTr) # check edge lengths
+ checkIdentical(nodeType(trChr5), nTtr) # check node types
+ checkIdentical(class(trChr5), p4d) # check class
+ checkIdentical(tdata(trChr5, "tip"), dtPoly5)
+ ## char.all=TRUE, levels.uniform=TRUE, return.labels=FALSE, polymorphic.convert=TRUE
+ trChr6 <- readNCL(file=treePolyDt, type="all", polymorphic.convert=TRUE,
+ levels.uniform=TRUE, char.all=TRUE, return.labels=FALSE)
+ checkIdentical(labels(trChr6), labTr) # check labels
+ checkIdentical(edgeLength(trChr6), eTr) # check edge lengths
+ checkIdentical(nodeType(trChr6), nTtr) # check node types
+ checkIdentical(class(trChr6), p4d) # check class
+ checkIdentical(tdata(trChr6, "tip"), dtPoly6)
+ ## char.all=TRUE, levels.uniform=TRUE, return.labels=TRUE, polymorphic.convert=FALSE
+ ## not yet implemented
+ ## trChr7 <-
+ checkException(readNCL(file=treePolyDt, type="all", char.all=TRUE,
+ levels.uniform=TRUE,
+ return.labels=TRUE,
+ polymorphic.convert=FALSE))
+ ## char.all=TRUE, levels.uniform=TRUE, return.labels=TRUE, polymorphic.convert=TRUE
+ trChr8 <- readNCL(file=treePolyDt, type="all", char.all=TRUE,
+ levels.uniform=TRUE,
+ return.labels=TRUE,
+ polymorphic.convert=TRUE)
+ checkIdentical(labels(trChr8), labTr) # check labels
+ checkIdentical(edgeLength(trChr8), eTr) # check edge lengths
+ checkIdentical(nodeType(trChr8), nTtr) # check node types
+ checkIdentical(class(trChr8), p4d) # check class
+ checkIdentical(tdata(trChr8, "tip"), dtPoly8)
+
+ ## -- with char.all=FALSE
+ ## char.all=FALSE, levels.uniform=FALSE, return.labels=FALSE, polymorphic.convert=FALSE
+ trChr1F <- readNCL(file=treePolyDt, type="all", polymorphic.convert=FALSE,
+ levels.uniform=FALSE, char.all=FALSE, return.labels=FALSE)
+ checkIdentical(labels(trChr1F), labTr) # check labels
+ checkIdentical(edgeLength(trChr1F), eTr) # check edge lengths
+ checkIdentical(nodeType(trChr1F), nTtr) # check node types
+ checkIdentical(class(trChr1F), p4d) # check class
+ checkIdentical(tdata(trChr1F, "tip"), dtPoly1[, 1:2])
+ ## char.all=FALSE, levels.uniform=FALSE, return.labels=FALSE, polymorphic.convert=TRUE
+ trChr2F <- readNCL(file=treePolyDt, type="all", polymorphic.convert=TRUE,
+ levels.uniform=FALSE, return.labels=FALSE, char.all=FALSE)
+ checkIdentical(labels(trChr2F), labTr) # check labels
+ checkIdentical(edgeLength(trChr2F), eTr) # check edge lengths
+ checkIdentical(nodeType(trChr2F), nTtr) # check node types
+ checkIdentical(class(trChr2F), p4d) # check class
+ checkIdentical(tdata(trChr2F, "tip"), dtPoly2[, 1:2])
+ ## char.all=FALSE, levels.uniform=FALSE, return.labels=TRUE, polymorphic.convert=TRUE
+ trChr3F <- readNCL(file=treePolyDt, type="all", polymorphic.convert=TRUE,
+ levels.uniform=FALSE, char.all=FALSE, return.labels=TRUE)
+ checkIdentical(labels(trChr3F), labTr) # check labels
+ checkIdentical(edgeLength(trChr3F), eTr) # check edge lengths
+ checkIdentical(nodeType(trChr3F), nTtr) # check node types
+ checkIdentical(class(trChr3F), p4d) # check class
+ checkIdentical(tdata(trChr3F, "tip"), dtPoly3[, 1:2])
+ ## char.all=FALSE, levels.uniform=FALSE, return.labels=TRUE, polymorphic.convert=FALSE
+ ## not yet implemented
+ ## trChr4F <-
+ checkException(readNCL(file=treePolyDt, type="all",
+ levels.uniform=FALSE,
+ return.labels=TRUE,
+ polymorphic.convert=FALSE))
+ ## char.all=FALSE, levels.uniform=TRUE, return.labels=FALSE, polymorphic.convert=FALSE
+ trChr5F <- readNCL(file=treePolyDt, type="all", polymorphic.convert=FALSE,
+ levels.uniform=TRUE, char.all=FALSE, return.labels=FALSE)
+ checkIdentical(labels(trChr5F), labTr) # check labels
+ checkIdentical(edgeLength(trChr5F), eTr) # check edge lengths
+ checkIdentical(nodeType(trChr5F), nTtr) # check node types
+ checkIdentical(class(trChr5F), p4d) # check class
+ checkIdentical(tdata(trChr5F, "tip"), dtPoly5F)
+ ## char.all=FALSE, levels.uniform=TRUE, return.labels=FALSE, polymorphic.convert=TRUE
+ trChr6F <- readNCL(file=treePolyDt, type="all", polymorphic.convert=TRUE,
+ levels.uniform=TRUE, char.all=FALSE, return.labels=FALSE)
+ checkIdentical(labels(trChr6F), labTr) # check labels
+ checkIdentical(edgeLength(trChr6F), eTr) # check edge lengths
+ checkIdentical(nodeType(trChr6F), nTtr) # check node types
+ checkIdentical(class(trChr6F), p4d) # check class
+ checkIdentical(tdata(trChr6F, "tip"), dtPoly6F)
+ ## char.all=FALSE, levels.uniform=TRUE, return.labels=TRUE, polymorphic.convert=FALSE
+ ## not yet implemented
+ ## trChr7F <-
+ checkException(readNCL(file=treePolyDt, type="all", char.all=FALSE,
+ levels.uniform=TRUE,
+ return.labels=TRUE,
+ polymorphic.convert=FALSE))
+ ## char.all=FALSE, levels.uniform=TRUE, return.labels=TRUE, polymorphic.convert=TRUE
+ trChr8F <- readNCL(file=treePolyDt, type="all", char.all=FALSE,
+ levels.uniform=TRUE,
+ return.labels=TRUE,
+ polymorphic.convert=TRUE)
+ checkIdentical(labels(trChr8F), labTr) # check labels
+ checkIdentical(edgeLength(trChr8F), eTr) # check edge lengths
+ checkIdentical(nodeType(trChr8F), nTtr) # check node types
+ checkIdentical(class(trChr8F), p4d) # check class
+ checkIdentical(tdata(trChr8F, "tip"), dtPoly8F)
+
+ ## ########## Tree + Data -- test with continuous Characters
+ DtCont <- readNCL(file=treeContDt, type="data")
+ trDtCont <- readNCL(file=treeContDt, type="all")
+ load(ExContDataFile)
+ checkIdentical(DtCont, ExContData[rownames(DtCont), ])
+ checkIdentical(tdata(trDtCont, "tip"), ExContData)
+ rm(ExContData)
+ checkIdentical(labels(trDtCont), labTr) # check labels
+ checkIdentical(edgeLength(trDtCont), eTr) # check edge lengths
+ checkIdentical(nodeType(trDtCont), nTtr) # check node types
+ checkIdentical(class(trDtCont), p4d) # check class
+
+ ## ########## Tree + Data -- both types (Discrete & Continuous)
+ dtDiscCont <- readNCL(file=treeDiscCont, type="data", levels.uniform=FALSE)
+ trDtDiscCont <- readNCL(file=treeDiscCont, type="all", levels.uniform=FALSE)
+ load(ExContDataFile)
+ dtDiscContTest <- cbind(ExContData, dtTest2[rownames(ExContData), ])
+ rm(ExContDataFile)
+ checkIdentical(dtDiscCont, dtDiscContTest[rownames(dtDiscCont), ])
+ checkIdentical(tdata(trDtDiscCont, "tip"), dtDiscContTest)
+ checkIdentical(labels(trDtDiscCont), labTr) # check labels
+ checkIdentical(edgeLength(trDtDiscCont), eTr) # check edge lengths
+ checkIdentical(nodeType(trDtDiscCont), nTtr) # check node types
+ checkIdentical(class(trDtDiscCont), p4d) # check class
+
+ ## ########### Check for proper handling of missing files
+ checkException(readNCL(file="foo.bar"))
+
+ ## ########### Check behavior in case of missing state labels
+ ow <- options("warn")
+ options(warn=2)
+ checkException(readNCL(file=noStateLabels, return.labels=TRUE))
+ options(ow)
+ dtNoSt <- readNCL(file=noStateLabels, type="data", return.labels=TRUE)
+ checkIdentical(dtNoSt$char1, factor(c(1,2,0,1)))
+
+ ## ########### Newick files
+ ## Tree representation
+ labNew <- c("a", "b", "c", NA, NA)
+ names(labNew) <- 1:5
+ eLnew <- c(1, 4, 2, NA, 3)
+ names(eLnew) <- c("4-1", "4-5", "5-2", "0-4", "5-3")
+ nTnew <- c("tip", "tip", "tip", "root", "internal")
+ names(nTnew) <- 1:5
+ ## check.node.labels="drop" with readNCL
+ newTr <- readNCL(file=newick, file.format="newick", check.node.labels="drop")
+ checkIdentical(labels(newTr), labNew)
+ checkIdentical(edgeLength(newTr), eLnew)
+ checkIdentical(nodeType(newTr), nTnew)
+ ## check.node.labels="drop" with readNewick
+ newTr <- readNewick(file=newick, check.node.labels="drop")
+ checkIdentical(labels(newTr), labNew)
+ checkIdentical(edgeLength(newTr), eLnew)
+ checkIdentical(nodeType(newTr), nTnew)
+ ## check.node.labels="asdata" with readNCL
+ newTr <- readNCL(file=newick, file.format="newick", check.node.labels="asdata")
+ checkIdentical(labels(newTr), labNew)
+ checkIdentical(tdata(newTr)$labelValues, factor(c(NA, NA, NA, "yy", "xx")))
+ ## check.node.labels="asdata" with readNewick
+ newTr <- readNewick(file=newick, check.node.labels="asdata")
+ checkIdentical(labels(newTr), labNew)
+ checkIdentical(tdata(newTr)$labelValues, factor(c(NA, NA, NA, "yy", "xx")))
+ ## check.node.labels="keep" with readNCL
+ labNew[4:5] <- c("yy", "xx")
+ newTr <- readNCL(file=newick, file.format="newick", check.node.labels="keep")
+ checkIdentical(labels(newTr), labNew)
+ ## check.node.labels="keep" with readNewick
+ newTr <- readNewick(file=newick, check.node.labels="keep")
+ checkIdentical(labels(newTr), labNew)
+}
Copied: pkg/man/readNCL.Rd (from rev 804, pkg/man/readNexus.Rd)
===================================================================
--- pkg/man/readNCL.Rd (rev 0)
+++ pkg/man/readNCL.Rd 2010-08-06 19:26:04 UTC (rev 809)
@@ -0,0 +1,128 @@
+\name{Import Nexus and Newick files}
+\docType{methods}
+\alias{readNexus}
+\alias{readNCL}
+\alias{readNewick}
+
+\title{Create a phylo4, phylo4d or data.frame object from a Nexus or a
+ Newick file}
+
+\description{
+ \code{readNexus} reads a Nexus file and outputs a \code{phylo4} or
+ \code{phylo4d} or \code{data.frame} object.
+
+ \code{readNewick} reads a Newick file and outputs a \code{phylo4} or
+ \code{phylo4d} object.
+}
+
+\usage{
+readNexus(file, simplify=FALSE, type=c("all", "tree", "data"),
+ char.all=FALSE, polymorphic.convert=TRUE, levels.uniform=FALSE,
+ quiet=TRUE, check.node.labels=c("keep", "drop", "asdata"),
+ return.labels=TRUE, ...)
+
+readNewick(file, simplify=FALSE, quiet=TRUE,
+ check.node.labels=c("keep", "drop", "asdata"), ...)
+
+}
+
+\arguments{
+ \item{file}{a Nexus file for \code{readNexus} or a file that contains
+ Newick formatted trees for \code{readNewick}}
+
+ \item{simplify}{If there are multiple trees in the file, only the
+ first one is returned if TRUE and a list of phylo4/phylo4d objects
+ is returned if the file contains multiple trees.}
+
+ \item{type}{Determines which type of objects to return, if present in
+ the file (see Details).}
+
+ \item{char.all}{If TRUE, returns all characters, even those excluded
+ in the NEXUS file}
+
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/phylobase -r 809
More information about the Phylobase-commits
mailing list