[Phylobase-commits] r137 - in pkg: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Mar 6 03:49:54 CET 2008
Author: bbolker
Date: 2008-03-06 03:49:54 +0100 (Thu, 06 Mar 2008)
New Revision: 137
Modified:
pkg/R/treewalk.R
pkg/man/treewalk.Rd
Log:
revamped tree-walking terminology and behavior
Modified: pkg/R/treewalk.R
===================================================================
--- pkg/R/treewalk.R 2008-03-04 16:44:38 UTC (rev 136)
+++ pkg/R/treewalk.R 2008-03-06 02:49:54 UTC (rev 137)
@@ -7,70 +7,90 @@
## x = n-nTips(phy)
## so: n = x+nTips(phy)
-getNodeByLabel <- function(phy,lab) {
- nt <- nTips(phy)
- tipmatch <- match(lab,labels(phy))
- ifelse(!is.na(tipmatch),
- tipmatch,
- if (!hasNodeLabels(phy)) NA else {
- nt+match(lab,NodeLabels(phy))
- })
+getnodes <- function(phy,x) {
+ if (is.numeric(x) && all(floor(x)==x)) {
+ x <- as.integer(x)
+ }
+ if (is.character(x)) {
+ ## old getNodeByLabel()
+ nt <- nTips(phy)
+ tipmatch <- match(x,labels(phy,"all"))
+ vals <- ifelse(!is.na(tipmatch),
+ tipmatch,
+ if (!hasNodeLabels(phy)) { NA } else {
+ nt+match(x,NodeLabels(phy))
+ })
+ names(vals) <- x
+ return(vals)
+ } else if (is.integer(x)) {
+ ## old getLabelByNode
+ nt <- nTips(phy)
+ vals <- ifelse(x<=nt, ## tips
+ labels(phy,"all")[x],
+ ifelse(x<=nt+nNodes(phy),
+ if (!hasNodeLabels(phy)) { NA }
+ else {
+ NodeLabels(phy)[pmax(0,x-nt)]
+ },NA))
+ ## pmax above to avoid error from negative indices
+ names(x) <- vals
+ return(x)
+ } else stop("x must be integer or character")
}
-
-getLabelByNode <- function(phy,num) {
- nt <- nTips(phy)
- ifelse(num<=nt,
- labels(phy)[num],
- ifelse(num<=nt+nNodes(phy)-1,
- if (!hasNodeLabels(phy)) NA else {
- ## pmax to avoid error from negative indices
- NodeLabels(phy)[pmax(0,num-nt)]
- }))
-}
-getAncest <- function(phy,node) {
- if (is.character(node)) node <- getNodeByLabel(phy,node)
+
+parent <- function(phy,node) {
+ node <- getnodes(phy,node)
r <- which(phy at edge[,2]==node)
- return(phy at edge[r,1])
+ return(getnodes(phy,phy at edge[r,1]))
}
-getDescend <- function(phy,node) {
- if (is.character(node)) node <- getNodeByLabel(phy,node)
+children <- function(phy,node) {
+ node <- getnodes(phy,node)
r <- which(phy at edge[,1]==node)
- return(phy at edge[r,2])
+ return(getnodes(phy,phy at edge[r,2]))
}
-## get descendants (in this version, tips only)
-## recursive
-allDescend <- function (phy, node)
+## get descendants [recursively]
+descendants <- function (phy, node, which=c("tips","all"))
{
- if (is.character(node)) node <- getNodeByLabel(phy,node)
+ ## FIXME: allow vector of nodes?
+ which <- match.arg(which)
+ if (which=="all") stop('which="all" not yet working')
+ node <- getnodes(phy,node)
+ if (is.na(node)) stop("node ",node," not found in tree")
n <- nTips(phy)
- if (node <= n) return(labels(phy)[node])
- l <- character()
- d <- getDescend(phy, node)
+ if (node <= n) return(labels(phy,"all")[node])
+ l <- numeric()
+ d <- children(phy, node)
for (j in d) {
- if (j <= n)
- l <- c(l, labels(phy)[as.numeric(j)])
- else l <- c(l, allDescend(phy, j))
+ if (j <= n)
+ l <- c(l,j)
+ else if (which=="all") l <- c(l,node,descendants(phy,j,which="all"))
+ else l <- c(l, descendants(phy,j))
+## l <- c(l, labels(phy,"tips")[as.numeric(j)])
+## else if (which=="all") l <- c(l, names(node),
+## names(descendants(phy, j, which="all")))
+## else l <- c(l, names(descendants(phy, j)))
}
- return(l)
+ return(getnodes(phy,l))
}
## get ancestors (all nodes)
-allAncest <- function (phy, node)
+ancestors <- function (phy, node)
{
- if (is.character(node)) node <- getNodeByLabel(phy,node)
+ node <- getnodes(phy,node)
+ if (is.na(node)) stop("node ",node," not found in tree")
res <- numeric(0)
n <- nTips(phy)
repeat {
- anc <- getAncest(phy,node)
+ anc <- parent(phy,node)
res <- c(res,anc)
node <- anc
if (anc==n+1) break
}
- return(res)
+ return(getnodes(phy,res))
}
MRCA <- function(phy, ...) {
@@ -80,6 +100,6 @@
if (length(nodes)==1 && length(nodes[[1]])>1) {
nodes <- as.list(nodes[[1]])
}
- ancests <- lapply(nodes,allAncest,phy=phy)
- max(Reduce(intersect,ancests))
+ ancests <- lapply(nodes,ancestors,phy=phy)
+ getnodes(phy,max(Reduce(intersect,ancests)))
}
Modified: pkg/man/treewalk.Rd
===================================================================
--- pkg/man/treewalk.Rd 2008-03-04 16:44:38 UTC (rev 136)
+++ pkg/man/treewalk.Rd 2008-03-06 02:49:54 UTC (rev 137)
@@ -1,8 +1,8 @@
\name{treewalk}
-\alias{getAncest}
-\alias{getDescend}
-\alias{allDescend}
-\alias{allAncest}
+\alias{parent}
+\alias{children}
+\alias{descendants}
+\alias{ancestors}
\alias{MRCA}
\alias{getNodeByLabel}
\alias{getLabelByNode}
@@ -13,16 +13,20 @@
}
\usage{
getNodeByLabel(phy,lab)
-getAncest(phy, node)
-getDescend(phy, node)
-allDescend(phy, node)
-allAncest(phy, node)
+parent(phy, node)
+children(phy, node)
+descendants(phy, node, which=c("tips","all"))
+ancestors(phy, node)
MRCA(phy,\dots)
}
\arguments{
- \item{phy}{a \code{phylo4} object}
+ \item{phy}{a \code{phylo4} object (or one inheriting from
+ \code{phylo4}, e.g. a \code{phylo4d} object)
+ }
\item{lab}{a character label}
\item{node}{a node number (or name)}
+ \item{which}{whether to return all descendant nodes, or just tips
+ (which="all" is not yet implemented)}
\item{\dots}{a list of node numbers or names,
or a vector of node numbers or names}
}
@@ -30,10 +34,10 @@
\code{getNodeByLabel} takes character strings corresponding to tip or
node labels and returns the corresponding node number;
\code{getLabelByNode} does the opposite.
- \code{getAncest} and \code{getDescend} return the numbers of the
- immediate ancestors or descendants of a node; \code{allDescend}
+ \code{parent} and \code{children} return the numbers of the
+ immediate ancestors or descendants of a node; \code{descendants}
returns the \emph{names} of all of the descendants (tips only) of a
- node; \code{allAncest} returns the numbers of all of the ancestors of
+ node; \code{ancestors} returns the numbers of all of the ancestors of
a node. \code{mrca} returns the most recent common ancestor of two or
more nodes.
}
@@ -42,21 +46,16 @@
\seealso{\code{mrca}, in the ape package, gives
a list of all subtrees}
\examples{
- library(geiger)
data(geospiza)
- g1 <- as(geospiza$geospiza.tree,"phylo4")
-getLabelByNode(g1,18)
-getNodeByLabel(g1,"N04")
-## rename nodes for clarity
- n1 <- phylobase::nTips(g1)+1
- n2 <- phylobase::nTips(g1)+nNodes(g1)
- NodeLabels(g1) <- paste("N",n1:n2,sep="")
- plot(g1,show.node.label=TRUE)
- getAncest(g1,"N20")
- getDescend(g1,"N20")
- allDescend(g1,"N20")
- allAncest(g1,"N20")
- MRCA(g1,"conirostris","difficilis","fuliginosa")
- MRCA(g1,"olivacea","conirostris")
+ getnodes(geospiza,18)
+ getnodes(geospiza,"N04")
+ plot(as(geospiza,"phylo4"),
+ use.edge.length=FALSE,show.node.label=TRUE)
+ parent(geospiza,"N11")
+ children(geospiza,"N05")
+ descendants(geospiza,"N11")
+ ancestors(geospiza,"N11")
+ MRCA(geospiza,"conirostris","difficilis","fuliginosa")
+ MRCA(geospiza,"olivacea","conirostris")
}
\keyword{misc}
More information about the Phylobase-commits
mailing list