[Phylobase-commits] r651 - in pkg: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Sep 15 01:04:41 CEST 2009
Author: regetz
Date: 2009-09-15 01:04:41 +0200 (Tue, 15 Sep 2009)
New Revision: 651
Modified:
pkg/R/prune.R
pkg/man/subset-methods.Rd
Log:
for consistency with other methods, renamed prune argument phy as x;
also removed unused arguments subtree and '...' from code and docs
Modified: pkg/R/prune.R
===================================================================
--- pkg/R/prune.R 2009-09-14 06:40:09 UTC (rev 650)
+++ pkg/R/prune.R 2009-09-14 23:04:41 UTC (rev 651)
@@ -1,6 +1,6 @@
-setGeneric("prune",function(phy, ...) {
- standardGeneric("prune")
+setGeneric("prune", function(x, ...) {
+ standardGeneric("prune")
})
@@ -9,28 +9,24 @@
as.character(sort(as.numeric(x)))
}
-setMethod("prune","phylo4", function(phy, tips.exclude,
- trim.internal = TRUE, subtree = FALSE, ...) {
+setMethod("prune","phylo4", function(x, tips.exclude,
+ trim.internal=TRUE) {
- if (subtree) {
- warning("subtree option is not currently supported for phylo4")
- }
-
makeEdgeNames <- function(edge) {
paste(edge[,1], edge[,2], sep="-")
}
## drop tips and obsolete internal nodes from edge matrix
- tip.drop <- getNode(phy, tips.exclude, missing="fail")
- tip.keep <- setdiff(nodeId(phy, "tip"), tip.drop)
- nodes <- nodeId(phy, "all")
+ tip.drop <- getNode(x, tips.exclude, missing="fail")
+ tip.keep <- setdiff(nodeId(x, "tip"), tip.drop)
+ nodes <- nodeId(x, "all")
node.keep <- rep(FALSE, length(nodes))
node.keep[tip.keep] <- TRUE
if (trim.internal) {
- if (edgeOrder(phy) == "postorder") {
- edge.post <- edges(phy)
+ if (edgeOrder(x) == "postorder") {
+ edge.post <- edges(x)
} else {
- edge.post <- edges(reorder(phy, "postorder"))
+ edge.post <- edges(reorder(x, "postorder"))
}
for (i in seq_along(edge.post[,2])) {
if (node.keep[edge.post[i,2]]) {
@@ -38,13 +34,13 @@
}
}
} else {
- node.keep[nodeId(phy, "internal")] <- TRUE
+ node.keep[nodeId(x, "internal")] <- TRUE
}
- edge.new <- edges(phy)[edges(phy)[,2] %in% nodes[node.keep], ]
+ edge.new <- edges(x)[edges(x)[,2] %in% nodes[node.keep], ]
## remove singletons
- edge.length.new <- edgeLength(phy)
- edge.label.new <- edgeLabels(phy)
+ edge.length.new <- edgeLength(x)
+ edge.label.new <- edgeLabels(x)
singletons <- which(tabulate(na.omit(edge.new[,1]))==1)
while (length(singletons)>0) {
sing.node <- singletons[1]
@@ -70,8 +66,8 @@
}
## remove dropped elements from tip.label and node.label
- tip.label.new <- tipLabels(phy)[names(tipLabels(phy)) %in% edge.new]
- node.label.new <- nodeLabels(phy)[names(nodeLabels(phy)) %in% edge.new]
+ tip.label.new <- tipLabels(x)[names(tipLabels(x)) %in% edge.new]
+ node.label.new <- nodeLabels(x)[names(nodeLabels(x)) %in% edge.new]
## subset and order edge.length and edge.label with respect to edge
edge.names <- makeEdgeNames(edge.new)
@@ -81,12 +77,12 @@
if (!trim.internal) {
## make sure now-terminal internal nodes are treated as tips
tip.now <- setdiff(edge.new[,2], edge.new[,1])
- tip.add <- tip.now[tip.now>nTips(phy)]
+ tip.add <- tip.now[tip.now>nTips(x)]
if (length(tip.add)>0) {
ind <- match(tip.add, names(node.label.new))
## node renumbering workaround to satisfy plot method
- newid <- sapply(tip.add, function(x) descendants(phy, x)[1])
+ newid <- sapply(tip.add, function(tip) descendants(x, tip)[1])
names(node.label.new)[ind] <- newid
edge.new[match(tip.add, edge.new)] <- newid
tip.now[match(tip.add, tip.now)] <- newid
@@ -111,45 +107,44 @@
names(node.label.new) <- seq_along(node.label.new) + length(tip.label.new)
## create and return new phylo4 object
- ## NOTE: a faster but looser approach would be to replace the phy
- ## slots with their new values (including Nnode) and return phy
+ ## NOTE: a faster but looser approach would be to replace the slots
+ ## of x with their new values (including Nnode) and return x
phylo4(x=edge.new, edge.length = edge.length.new, tip.label =
tip.label.new, node.label = node.label.new, edge.label =
- edge.label.new, annote=phy at annote)
+ edge.label.new, annote=x at annote)
})
## trace("prune", browser, signature = "phylo4d")
## untrace("prune", signature = "phylo4d")
-setMethod("prune", "phylo4d", function(phy, tips.exclude,
- trim.internal=TRUE, subtree=FALSE, ...) {
+setMethod("prune", "phylo4d", function(x, tips.exclude,
+ trim.internal=TRUE) {
- tree <- extractTree(phy)
- phytr <- prune(tree, tips.exclude, trim.internal, subtree)
+ tree <- extractTree(x)
+ phytr <- prune(tree, tips.exclude, trim.internal)
## create temporary phylo4 object with unique labels
- tmpLbl <- .genlab("n", nTips(phy)+nNodes(phy))
+ tmpLbl <- .genlab("n", nTips(x)+nNodes(x))
tmpPhy <- tree
labels(tmpPhy, "all") <- tmpLbl
- tmpPhytr <- prune(tmpPhy, getNode(phy, tips.exclude), trim.internal,
- subtree)
+ tmpPhytr <- prune(tmpPhy, getNode(x, tips.exclude), trim.internal)
## get node numbers to keep
oldLbl <- labels(tmpPhy, "all")
newLbl <- labels(tmpPhytr, "all")
toKeep <- as.numeric(names(oldLbl[oldLbl %in% newLbl]))
- tipToKeep <- toKeep[toKeep %in% nodeId(phy, "tip")]
- nodToKeep <- toKeep[toKeep %in% nodeId(phy, "internal")]
+ tipToKeep <- toKeep[toKeep %in% nodeId(x, "tip")]
+ nodToKeep <- toKeep[toKeep %in% nodeId(x, "internal")]
- if(!all(dim(phy at tip.data) == 0)) {
- tipDt <- phy at tip.data[match(tipToKeep, rownames(phy at tip.data)) ,, drop=FALSE]
+ if(!all(dim(x at tip.data) == 0)) {
+ tipDt <- x at tip.data[match(tipToKeep, rownames(x at tip.data)) ,, drop=FALSE]
tipDt <- tipDt[.chnumsort(rownames(tipDt)) ,, drop=FALSE]
rownames(tipDt) <- 1:nTips(phytr)
}
else
tipDt <- data.frame(NULL)
- if(!all(dim(phy at node.data) == 0)) {
- nodDt <- phy at node.data[match(nodToKeep, rownames(phy at node.data)) ,, drop=FALSE]
+ if(!all(dim(x at node.data) == 0)) {
+ nodDt <- x at node.data[match(nodToKeep, rownames(x at node.data)) ,, drop=FALSE]
nodDt <- nodDt[.chnumsort(rownames(nodDt)) ,, drop=FALSE]
rownames(nodDt) <- 1:nNodes(phytr)
}
Modified: pkg/man/subset-methods.Rd
===================================================================
--- pkg/man/subset-methods.Rd 2009-09-14 06:40:09 UTC (rev 650)
+++ pkg/man/subset-methods.Rd 2009-09-14 23:04:41 UTC (rev 651)
@@ -30,8 +30,8 @@
\S4method{subset}{phylo4d}(x, tips.include=NULL, tips.exclude=NULL,
mrca=NULL, node.subtree=NULL, \dots)
-\S4method{prune}{phylo4}(x, tips.exclude, trim.internal = TRUE, \dots)
-\S4method{prune}{phylo4d}(x, tips.exclude, trim.internal = TRUE, \dots)
+\S4method{prune}{phylo4}(x, tips.exclude, trim.internal = TRUE)
+\S4method{prune}{phylo4d}(x, tips.exclude, trim.internal = TRUE)
\S4method{[}{phylo4}(x, i)
\S4method{[}{phylo4d}(x, i, j)
More information about the Phylobase-commits
mailing list