[Phylobase-commits] r623 - in pkg: R inst/doc inst/unitTests man tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Sep 8 20:59:13 CEST 2009
Author: regetz
Date: 2009-09-08 20:59:12 +0200 (Tue, 08 Sep 2009)
New Revision: 623
Modified:
pkg/R/methods-phylo4.R
pkg/R/phylo4.R
pkg/inst/doc/phylobase.Rnw
pkg/inst/unitTests/runit.setAs-Methods.R
pkg/man/addData.Rd
pkg/man/phylo4-display.Rd
pkg/man/phylo4d.Rd
pkg/man/subset-methods.Rd
pkg/tests/misctests.Rout.save
pkg/tests/phylo4dtests.Rout.save
pkg/tests/phylotorture.Rout.save
Log:
revised nodeId method:
- now always returning IDs in ascending order
- changed type 'allnode' to 'all' (matching generic definition)
- default type is now 'all'
- added 'root' type
- robust to non-standard tip vs internal node numbering schemes
also fixed (but didn't enhance) examples, vignette code, and test
targets that broke as a consequence
Modified: pkg/R/methods-phylo4.R
===================================================================
--- pkg/R/methods-phylo4.R 2009-09-08 16:15:07 UTC (rev 622)
+++ pkg/R/methods-phylo4.R 2009-09-08 18:59:12 UTC (rev 623)
@@ -105,16 +105,27 @@
}
})
-setMethod("nodeId", "phylo4", function(x, type=c("internal","tip","allnode")) {
- type <- match.arg(type)
- tipNid <- x at edge[x at edge[,2]<=nTips(x),2]
- allNid <- unique(as.vector(x at edge))
- intNid <- allNid[! allNid %in% tipNid]
- nid <- switch(type,
- internal = intNid,
- tip = tipNid,
- allnode = allNid)
- return(nid[!is.na(nid)])
+# return node IDs (or a subset thereof) in ascending order
+setMethod("nodeId", "phylo4", function(x, type=c("all",
+ "tip","internal","root")) {
+
+ type <- match.arg(type)
+ E <- edges(x)
+
+ ## Note: this implementation will still work even if tips are not
+ ## 1:nTips and nodes are not (nTips+1):nNodes
+ nid <- switch(type,
+ ## all nodes appear at least once in the edge matrix
+ all = unique(na.omit(as.vector(E))),
+ ## tips are nodes that do not appear in the ancestor column
+ tip = setdiff(E[, 2], E[, 1]),
+ ## internals are nodes that *do* appear in the ancestor column
+ internal = na.omit(unique(E[, 1])),
+ ## roots are nodes that have NA as ancestor
+ root = if (!isRooted(x)) NA else unname(E[is.na(E[, 1]), 2]))
+
+ return(sort(nid))
+
})
Modified: pkg/R/phylo4.R
===================================================================
--- pkg/R/phylo4.R 2009-09-08 16:15:07 UTC (rev 622)
+++ pkg/R/phylo4.R 2009-09-08 18:59:12 UTC (rev 623)
@@ -16,7 +16,8 @@
})
## nodeId
-setGeneric("nodeId", function(x, type=c("internal", "tip", "all")) {
+setGeneric("nodeId", function(x, type=c("all", "tip", "internal",
+ "root")) {
standardGeneric("nodeId")
})
Modified: pkg/inst/doc/phylobase.Rnw
===================================================================
--- pkg/inst/doc/phylobase.Rnw 2009-09-08 16:15:07 UTC (rev 622)
+++ pkg/inst/doc/phylobase.Rnw 2009-09-08 18:59:12 UTC (rev 623)
@@ -111,7 +111,7 @@
A simple way to assign the node numbers as labels (useful for various checks) is
<<>>=
-nodeLabels(g1) <- paste("N", nodeId(g1), sep="")
+nodeLabels(g1) <- paste("N", nodeId(g1, "internal"), sep="")
head(g1, 5)
@
@@ -130,7 +130,7 @@
Print node numbers (in edge matrix order):
<<nodenumbergeodata>>=
-nodeId(g1, type='allnode')
+nodeId(g1, type='all')
@
Print edge labels (also empty in this case --- therefore
@@ -307,7 +307,7 @@
<<keep.source=TRUE>>=
## add node labels so we can match to data
-nodeLabels(tree) <- as.character(sort(nodeId(tree)))
+nodeLabels(tree) <- as.character(nodeId(tree, "internal"))
## ordering will make sure that we have ancestor value
## defined before descendant
tree <- reorder(tree, "preorder")
Modified: pkg/inst/unitTests/runit.setAs-Methods.R
===================================================================
--- pkg/inst/unitTests/runit.setAs-Methods.R 2009-09-08 16:15:07 UTC (rev 622)
+++ pkg/inst/unitTests/runit.setAs-Methods.R 2009-09-08 18:59:12 UTC (rev 623)
@@ -79,15 +79,14 @@
# rooted tree
checkTrue(is.data.frame(as(phy, "data.frame")))
- phy.df <- structure(list(label = c(NA, NA, NA, NA, "spA", "spB",
- "spC", "spD", "spE"), node = c(6L, 7L, 8L, 9L, 1L, 2L, 3L, 4L,
- 5L), ancestor = c(NA, 6L, 7L, 8L, 8L, 9L, 9L, 7L, 6L),
- edge.length = c(0.4, 0.2, 0.5, 0.15, 0.2, 0.1, 0.1, 0.7, 1),
- node.type = structure(c(2L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L),
- .Label = c("internal", "root", "tip"), class = "factor")),
- .Names = c("label", "node", "ancestor", "edge.length",
- "node.type"), row.names = c(6L, 7L, 8L, 9L, 1L, 2L, 3L, 4L, 5L),
- class = "data.frame")
+ phy.df <- structure(list(label = c("spA", "spB", "spC", "spD",
+ "spE", NA, NA, NA, NA), node = 1:9, ancestor = c(8L, 9L, 9L, 7L,
+ 6L, NA, 6L, 7L, 8L), edge.length = c(0.2, 0.1, 0.1, 0.7, 1, 0.4,
+ 0.2, 0.5, 0.15), node.type = structure(c(3L, 3L, 3L, 3L, 3L, 2L,
+ 1L, 1L, 1L), .Label = c("internal", "root", "tip"), class =
+ "factor")), .Names = c("label", "node", "ancestor",
+ "edge.length", "node.type"), row.names = c(NA, 9L), class =
+ "data.frame")
checkEquals(as(phy, "data.frame"), phy.df)
# unrooted tree
Modified: pkg/man/addData.Rd
===================================================================
--- pkg/man/addData.Rd 2009-09-08 16:15:07 UTC (rev 622)
+++ pkg/man/addData.Rd 2009-09-08 18:59:12 UTC (rev 623)
@@ -45,7 +45,7 @@
\examples{
data(geospiza)
nDt <- data.frame(a=rnorm(nNodes(geospiza)), b=1:nNodes(geospiza),
-row.names=nodeId(geospiza))
+ row.names=nodeId(geospiza, "internal"))
t1 <-addData(geospiza, node.data=nDt)
}
\author{Francois Michonneau}
Modified: pkg/man/phylo4-display.Rd
===================================================================
--- pkg/man/phylo4-display.Rd 2009-09-08 16:15:07 UTC (rev 622)
+++ pkg/man/phylo4-display.Rd 2009-09-08 18:59:12 UTC (rev 623)
@@ -95,7 +95,7 @@
NA, 8), ncol=2, byrow=TRUE)
P2 <- phylo4(E)
- nodeLabels(P2) <- as.character(sort(nodeId(P2)))
+ nodeLabels(P2) <- as.character(nodeId(P2, "internal"))
plot(P2, show.node.label=TRUE)
sumryP2 <- summary(P2)
sumryP2
Modified: pkg/man/phylo4d.Rd
===================================================================
--- pkg/man/phylo4d.Rd 2009-09-08 16:15:07 UTC (rev 622)
+++ pkg/man/phylo4d.Rd 2009-09-08 18:59:12 UTC (rev 623)
@@ -137,7 +137,7 @@
(matchData2 <- phylo4d(trGeo, tip.data=tDt, node.data=nDt, merge.data=TRUE))
## Example with 'all.data'
-nodeLabels(geoTree) <- as.character(nodeId(geoTree))
+nodeLabels(geoTree) <- as.character(nodeId(geoTree, "internal"))
rAllData <- data.frame(randomTrait = rnorm(nTips(geoTree) + nNodes(geoTree)),
row.names = labels(geoTree, 'all'))
@@ -185,7 +185,7 @@
## create phylo4 objects with node and tip data
p4d.all1 <- phylo4d(p4, node.data = nod.dat, tip.data = dat, match.data=FALSE)
-nodeLabels(p4) <- as.character(sort(nodeId(p4)))
+nodeLabels(p4) <- as.character(nodeId(p4, "internal"))
p4d.all2 <- phylo4d(p4, all.data = rbind(dat, nod.dat, match.data=FALSE))
Modified: pkg/man/subset-methods.Rd
===================================================================
--- pkg/man/subset-methods.Rd 2009-09-08 16:15:07 UTC (rev 622)
+++ pkg/man/subset-methods.Rd 2009-09-08 18:59:12 UTC (rev 623)
@@ -106,7 +106,7 @@
}
\examples{
data(geospiza)
-nodeLabels(geospiza) <- paste("N", nodeId(geospiza), sep="")
+nodeLabels(geospiza) <- paste("N", nodeId(geospiza, "internal"), sep="")
geotree <- extractTree(geospiza)
## "subset" examples
Modified: pkg/tests/misctests.Rout.save
===================================================================
--- pkg/tests/misctests.Rout.save 2009-09-08 16:15:07 UTC (rev 622)
+++ pkg/tests/misctests.Rout.save 2009-09-08 18:59:12 UTC (rev 623)
@@ -181,29 +181,29 @@
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
+4 <NA> 4 NA NA root NA
+5 <NA> 5 4 3.1 internal NA
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
+4 <NA> 4 NA NA root NA
+5 <NA> 5 4 3.1 internal NA
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
+4 <NA> 4 NA NA root NA
+5 <NA> 5 4 3.1 internal NA
phyl4d> ####
phyl4d>
@@ -240,19 +240,6 @@
phyl4d> (matchData1 <- phylo4d(trGeo, tip.data=tDt, node.data=nDt, merge.data=FALSE))
label node ancestor edge.length node.type a a.1
-15 <NA> 15 NA NA root NA -1.47075238
-16 <NA> 16 15 0.29744 internal NA -0.47815006
-17 <NA> 17 16 0.04924 internal NA 0.41794156
-18 <NA> 18 17 0.06859 internal NA 1.35867955
-19 <NA> 19 18 0.13404 internal NA -0.10278773
-20 <NA> 20 19 0.10346 internal NA 0.38767161
-21 <NA> 21 20 0.03550 internal NA -0.05380504
-22 <NA> 22 21 0.00917 internal NA -1.37705956
-23 <NA> 23 22 0.07333 internal NA -0.41499456
-24 <NA> 24 23 0.05500 internal NA -0.39428995
-25 <NA> 25 19 0.24479 internal NA -0.05931340
-26 <NA> 26 25 0.05167 internal NA 1.10002537
-27 <NA> 27 26 0.01500 internal NA 0.76317575
1 fuliginosa 1 24 0.05500 tip -2.21469989 NA
2 fortis 2 24 0.05500 tip 1.12493092 NA
3 magnirostris 3 23 0.11000 tip -0.04493361 NA
@@ -267,22 +254,22 @@
12 fusca 12 17 0.53409 tip 0.61982575 NA
13 Pinaroloxias 13 16 0.58333 tip -0.05612874 NA
14 olivacea 14 15 0.88077 tip -0.15579551 NA
+15 <NA> 15 NA NA root NA -1.47075238
+16 <NA> 16 15 0.29744 internal NA -0.47815006
+17 <NA> 17 16 0.04924 internal NA 0.41794156
+18 <NA> 18 17 0.06859 internal NA 1.35867955
+19 <NA> 19 18 0.13404 internal NA -0.10278773
+20 <NA> 20 19 0.10346 internal NA 0.38767161
+21 <NA> 21 20 0.03550 internal NA -0.05380504
+22 <NA> 22 21 0.00917 internal NA -1.37705956
+23 <NA> 23 22 0.07333 internal NA -0.41499456
+24 <NA> 24 23 0.05500 internal NA -0.39428995
+25 <NA> 25 19 0.24479 internal NA -0.05931340
+26 <NA> 26 25 0.05167 internal NA 1.10002537
+27 <NA> 27 26 0.01500 internal NA 0.76317575
phyl4d> (matchData2 <- phylo4d(trGeo, tip.data=tDt, node.data=nDt, merge.data=TRUE))
label node ancestor edge.length node.type a
-15 <NA> 15 NA NA root -1.47075238
-16 <NA> 16 15 0.29744 internal -0.47815006
-17 <NA> 17 16 0.04924 internal 0.41794156
-18 <NA> 18 17 0.06859 internal 1.35867955
-19 <NA> 19 18 0.13404 internal -0.10278773
-20 <NA> 20 19 0.10346 internal 0.38767161
-21 <NA> 21 20 0.03550 internal -0.05380504
-22 <NA> 22 21 0.00917 internal -1.37705956
-23 <NA> 23 22 0.07333 internal -0.41499456
-24 <NA> 24 23 0.05500 internal -0.39428995
-25 <NA> 25 19 0.24479 internal -0.05931340
-26 <NA> 26 25 0.05167 internal 1.10002537
-27 <NA> 27 26 0.01500 internal 0.76317575
1 fuliginosa 1 24 0.05500 tip -2.21469989
2 fortis 2 24 0.05500 tip 1.12493092
3 magnirostris 3 23 0.11000 tip -0.04493361
@@ -297,9 +284,22 @@
12 fusca 12 17 0.53409 tip 0.61982575
13 Pinaroloxias 13 16 0.58333 tip -0.05612874
14 olivacea 14 15 0.88077 tip -0.15579551
+15 <NA> 15 NA NA root -1.47075238
+16 <NA> 16 15 0.29744 internal -0.47815006
+17 <NA> 17 16 0.04924 internal 0.41794156
+18 <NA> 18 17 0.06859 internal 1.35867955
+19 <NA> 19 18 0.13404 internal -0.10278773
+20 <NA> 20 19 0.10346 internal 0.38767161
+21 <NA> 21 20 0.03550 internal -0.05380504
+22 <NA> 22 21 0.00917 internal -1.37705956
+23 <NA> 23 22 0.07333 internal -0.41499456
+24 <NA> 24 23 0.05500 internal -0.39428995
+25 <NA> 25 19 0.24479 internal -0.05931340
+26 <NA> 26 25 0.05167 internal 1.10002537
+27 <NA> 27 26 0.01500 internal 0.76317575
phyl4d> ## Example with 'all.data'
-phyl4d> nodeLabels(geoTree) <- as.character(nodeId(geoTree))
+phyl4d> nodeLabels(geoTree) <- as.character(nodeId(geoTree, "internal"))
phyl4d> rAllData <- data.frame(randomTrait = rnorm(nTips(geoTree) + nNodes(geoTree)),
phyl4d+ row.names = labels(geoTree, 'all'))
@@ -314,19 +314,6 @@
phyl4d> (exGeo6 <- phylo4d(trGeo, tip.data=tDt, rownamesAsLabels=TRUE))
label node ancestor edge.length node.type x
-15 <NA> 15 NA NA root <NA>
-16 <NA> 16 15 0.29744 internal <NA>
-17 <NA> 17 16 0.04924 internal <NA>
-18 <NA> 18 17 0.06859 internal <NA>
-19 <NA> 19 18 0.13404 internal <NA>
-20 <NA> 20 19 0.10346 internal <NA>
-21 <NA> 21 20 0.03550 internal <NA>
-22 <NA> 22 21 0.00917 internal <NA>
-23 <NA> 23 22 0.07333 internal <NA>
-24 <NA> 24 23 0.05500 internal <NA>
-25 <NA> 25 19 0.24479 internal <NA>
-26 <NA> 26 25 0.05167 internal <NA>
-27 <NA> 27 26 0.01500 internal <NA>
1 2 1 24 0.05500 tip i
2 12 2 24 0.05500 tip l
3 8 3 23 0.11000 tip b
@@ -341,9 +328,6 @@
12 13 12 17 0.53409 tip j
13 3 13 16 0.58333 tip k
14 6 14 15 0.88077 tip d
-
-phyl4d> (exGeo7 <- phylo4d(trGeo, tip.data=tDt, rownamesAsLabels=FALSE))
- label node ancestor edge.length node.type x
15 <NA> 15 NA NA root <NA>
16 <NA> 16 15 0.29744 internal <NA>
17 <NA> 17 16 0.04924 internal <NA>
@@ -357,6 +341,9 @@
25 <NA> 25 19 0.24479 internal <NA>
26 <NA> 26 25 0.05167 internal <NA>
27 <NA> 27 26 0.01500 internal <NA>
+
+phyl4d> (exGeo7 <- phylo4d(trGeo, tip.data=tDt, rownamesAsLabels=FALSE))
+ label node ancestor edge.length node.type x
1 2 1 24 0.05500 tip m
2 12 2 24 0.05500 tip i
3 8 3 23 0.11000 tip k
@@ -371,9 +358,6 @@
12 13 12 17 0.53409 tip l
13 3 13 16 0.58333 tip j
14 6 14 15 0.88077 tip a
-
-phyl4d> (exGeo8 <- phylo4d(trGeo, tip.data=tDt, rownamesAsLabels=FALSE, match.data=FALSE))
- label node ancestor edge.length node.type x
15 <NA> 15 NA NA root <NA>
16 <NA> 16 15 0.29744 internal <NA>
17 <NA> 17 16 0.04924 internal <NA>
@@ -387,6 +371,9 @@
25 <NA> 25 19 0.24479 internal <NA>
26 <NA> 26 25 0.05167 internal <NA>
27 <NA> 27 26 0.01500 internal <NA>
+
+phyl4d> (exGeo8 <- phylo4d(trGeo, tip.data=tDt, rownamesAsLabels=FALSE, match.data=FALSE))
+ label node ancestor edge.length node.type x
1 2 1 24 0.05500 tip a
2 12 2 24 0.05500 tip b
3 8 3 23 0.11000 tip c
@@ -401,6 +388,19 @@
12 13 12 17 0.53409 tip l
13 3 13 16 0.58333 tip m
14 6 14 15 0.88077 tip n
+15 <NA> 15 NA NA root <NA>
+16 <NA> 16 15 0.29744 internal <NA>
+17 <NA> 17 16 0.04924 internal <NA>
+18 <NA> 18 17 0.06859 internal <NA>
+19 <NA> 19 18 0.13404 internal <NA>
+20 <NA> 20 19 0.10346 internal <NA>
+21 <NA> 21 20 0.03550 internal <NA>
+22 <NA> 22 21 0.00917 internal <NA>
+23 <NA> 23 22 0.07333 internal <NA>
+24 <NA> 24 23 0.05500 internal <NA>
+25 <NA> 25 19 0.24479 internal <NA>
+26 <NA> 26 25 0.05167 internal <NA>
+27 <NA> 27 26 0.01500 internal <NA>
phyl4d> require(ape) ## for rcoal
@@ -447,7 +447,7 @@
phyl4d> ## create phylo4 objects with node and tip data
phyl4d> p4d.all1 <- phylo4d(p4, node.data = nod.dat, tip.data = dat, match.data=FALSE)
-phyl4d> nodeLabels(p4) <- as.character(sort(nodeId(p4)))
+phyl4d> nodeLabels(p4) <- as.character(nodeId(p4, "internal"))
phyl4d> p4d.all2 <- phylo4d(p4, all.data = rbind(dat, nod.dat, match.data=FALSE))
Warning message:
Modified: pkg/tests/phylo4dtests.Rout.save
===================================================================
--- pkg/tests/phylo4dtests.Rout.save 2009-09-08 16:15:07 UTC (rev 622)
+++ pkg/tests/phylo4dtests.Rout.save 2009-09-08 18:59:12 UTC (rev 623)
@@ -61,22 +61,22 @@
>
> 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
+5 5 NA NA root
+6 6 5 NA internal
+7 C 7 6 NA internal
> 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
+5 5 NA NA root NA
+6 6 5 NA internal NA
+7 C 7 6 NA internal NA
>
>
> proc.time()
Modified: pkg/tests/phylotorture.Rout.save
===================================================================
--- pkg/tests/phylotorture.Rout.save 2009-09-08 16:15:07 UTC (rev 622)
+++ pkg/tests/phylotorture.Rout.save 2009-09-08 18:59:12 UTC (rev 623)
@@ -95,15 +95,15 @@
In checkTree(object) : 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
+6 <NA> 6 NA NA internal
+7 <NA> 7 6 NA internal
+8 <NA> 8 6 NA internal
+9 <NA> 9 9 NA internal
Warning messages:
1: In checkTree(object) : tree contains singleton nodes
2: In checkTree(object) : tree contains singleton nodes
@@ -144,15 +144,15 @@
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
+6 <NA> 6 7 NA internal
+7 <NA> 7 NA NA internal
+8 <NA> 8 7 NA internal
+9 <NA> 9 8 NA internal
> ## plot(tree3) # would work if we could create it?
>
>
More information about the Phylobase-commits
mailing list