[Phylobase-commits] r757 - pkg/inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Mar 13 01:02:33 CET 2010
Author: francois
Date: 2010-03-13 01:02:33 +0100 (Sat, 13 Mar 2010)
New Revision: 757
Modified:
pkg/inst/unitTests/runit.readNexus.R
Log:
expands unit test for readNexus
Modified: pkg/inst/unitTests/runit.readNexus.R
===================================================================
--- pkg/inst/unitTests/runit.readNexus.R 2010-03-12 23:59:02 UTC (rev 756)
+++ pkg/inst/unitTests/runit.readNexus.R 2010-03-13 00:02:33 UTC (rev 757)
@@ -15,24 +15,37 @@
## MultiLineTrees.nex -- 2 identical trees stored on several lines
multiLinesFile <- file.path(pth, "MultiLineTrees.nex")
-## treepluscharV01.nex -- Mesquite file
-treepluschar <- file.path(pth, "treepluscharV01.nex")
+## treeWithDiscreteData.nex -- Mesquite file with discrete data
+treeDiscDt <- file.path(pth, "treeWithDiscreteData.nex")
-## Contain correct (as of 2010-03-08) phylo4 representation of one of the tree
+## 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")
+
+## 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(treepluschar))
+stopifnot(file.exists(treeDiscDt))
stopifnot(file.exists(multiLinesFile))
stopifnot(file.exists(mlFile))
+stopifnot(file.exists(treePolyDt))
+stopifnot(file.exists(treeContDt))
+stopifnot(file.exists(ExContDataFile))
test.readNexus <- 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
+ ## ########### CO1 -- MrBayes file -- tree only
## Tree properties
## Labels
labCo1 <- c("Cow", "Seal", "Carp", "Loach", "Frog", "Chicken", "Human",
@@ -82,7 +95,7 @@
checkIdentical(nodeType(co1), nTco1) # check node type
checkIdentical(as(co1, "data.frame")$labelValues, NULL) # check label values don't exist
- ## ########### Mutli Lines
+ ## ########### Mutli Lines -- tree only
multiLines <- readNexus(file=multiLinesFile)
## load correct representation and make sure that the trees read
## match it
@@ -134,29 +147,27 @@
"Myrmecocystustenuinodis","Myrmecocystustestaceus",
"Myrmecocystuswheeleri","Myrmecocystusyuma")
dtTest2 <- dtTest1
- dtTest2$time <- ifelse(dtTest2$time == 0, "diurnal",
- ifelse(dtTest2$time == 1, "crepuscular", "nocturnal"))
- dtTest2$time <- factor(dtTest2$time,
- levels=c("diurnal", "crepuscular", "nocturnal"))
- dtTest2$subgenus <- ifelse(dtTest2$subgenus == 0, "Endiodioctes",
- ifelse(dtTest2$subgenus == 1, "Eremnocystus", "Myrmecocystus"))
- dtTest2$subgenus <- factor(dtTest2$subgenus)
+ 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 <- readNexus(file=treepluschar, type="tree")
+ tr <- readNexus(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 <- readNexus(file=treepluschar, type="data")
+ dt1 <- readNexus(file=treeDiscDt, type="data", return.labels=FALSE,
+ levels.uniform=FALSE)
checkIdentical(dt1, dtTest1)
- dt2 <- readNexus(file=treepluschar, type="data", levels.uniform=FALSE)
+ dt2 <- readNexus(file=treeDiscDt, type="data", return.labels=TRUE,
+ levels.uniform=FALSE)
checkIdentical(dt2, dtTest2)
## Tree + Data
- trDt1 <- readNexus(file=treepluschar, type="all")
+ trDt1 <- readNexus(file=treeDiscDt, type="all", return.labels=FALSE,
+ levels.uniform=FALSE)
str(trDt1)
print(labels(trDt1))
print(labTr)
@@ -165,10 +176,216 @@
checkIdentical(nodeType(trDt1), nTtr) # check node types
checkIdentical(class(trDt1), p4d) # check class
checkIdentical(tdata(trDt1, type="tip")[rownames(dtTest1), ], dtTest1)
- trDt2 <- readNexus(file=treepluschar, type="all", levels.uniform=FALSE)
+ trDt2 <- readNexus(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 <- readNexus(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 <- readNexus(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 <- readNexus(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(readNexus(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 <- readNexus(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 <- readNexus(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(readNexus(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 <- readNexus(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 <- readNexus(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 <- readNexus(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 <- readNexus(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(readNexus(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 <- readNexus(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 <- readNexus(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(readNexus(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 <- readNexus(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 <- readNexus(file=treeContDt, type="data")
+ trDtCont <- readNexus(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
}
+
More information about the Phylobase-commits
mailing list