[Phylobase-commits] r173 - in pkg: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Apr 7 02:51:23 CEST 2008
Author: bbolker
Date: 2008-04-07 02:51:23 +0200 (Mon, 07 Apr 2008)
New Revision: 173
Modified:
pkg/R/tbind.R
pkg/R/treewalk.R
pkg/man/treewalk.Rd
Log:
changes in treewalk terminology, added preliminary "tbind" functions
Modified: pkg/R/tbind.R
===================================================================
--- pkg/R/tbind.R 2008-04-06 23:14:35 UTC (rev 172)
+++ pkg/R/tbind.R 2008-04-07 00:51:23 UTC (rev 173)
@@ -1,22 +1,46 @@
+## appropriate behavior ???
+
+## IF all missing data -- create multiPhylo4
+## IF some have data -- create multiPhylo4d (user can coerce to multiPhylo4)
+## IF (check_data) then stop if all data not identical to first data
+##
+## need constructors for multiPhylo4, multiPhylo4d!!
+## FIXME: need code to construct tree.names ...
+
## function to bind trees together into a multi-tree object
-
-tbind <- function(..., check_data = FALSE) {
+tbind <- function(...,check_data=TRUE) {
L <- as.list(...)
- treeclasses <- c("multiPhylo4d", "multiPhylo4", "phylo4",
- "phylo4d")
- tdataclasses <- c("multiPhylo4d", "phylo4d")
- classes <- sapply(L, class)
- if (!all(classes %in% treeclasses))
+ namevec <- names(L)
+ treeclasses <- c("multiPhylo4d","multiPhylo4","phylo4","phylo4d")
+ tdataclasses <- c("multiPhylo4d","phylo4d")
+ classes <- sapply(L,class)
+ if (!all(classes %in% treeclasses)) {
stop("all elements must be trees or multitrees")
- ## decompose multi-trees into lists
- ## bind list into multi-tree
- if (!all(classes %in% tdataclasses)) {
- if (any(classes %in% tdataclasses))
- warning("not all elements contain data: data discarded")
- ## check: all data identical?
+ }
+ hasData <- any(classes %in% tdataclasses)
+ allData <- all(classes %in% tdataclasses)
+ xfun <- function(x) {
+ switch(class(x),
+ phylo4=x,
+ phylo4d=extract.tree(x),
+ multiPhylo4=x at phylolist,
+ multiPhylo4d=suppressWarnings(as("multiPhylo4",x)@phylolist))}
## decompose multi-trees into lists
- }
- else {
- }
+ treelist <- unlist(lapply(L,xfun))
+ if (hasData) alldat <- lapply(L[classes %in% tdataclasses],
+ "@","tip.data") ## ???
+ ## or function(x) {x at tip.data}
+ hasNodeData <- sapply(L[classes %in% tdataclasses],
+ function(x) {!is.null(x at node.data)})
+ if (any(hasNodeData)) warning("internal node data discarded")
+ if (check_data) {
+ ident <- sapply(alldat[-1],identical,y=alldat[[1]])
+ if (!all(ident)) stop(paste("tip data sets differ"))
+ } ## ?? implement code to check which ones differ (taking
+ ## null/multiple values in original set into account)
+ if (hasData) return(new("multiPhylo4d",phylolist=treelist,
+ tip.data=alldat[[1]]))
+ return(new("multiPhylo4",phylolist=treelist))
}
+
Modified: pkg/R/treewalk.R
===================================================================
--- pkg/R/treewalk.R 2008-04-06 23:14:35 UTC (rev 172)
+++ pkg/R/treewalk.R 2008-04-07 00:51:23 UTC (rev 173)
@@ -39,7 +39,7 @@
}
-parent <- function(phy,node) {
+ancestor <- function(phy,node) {
node <- getnodes(phy,node)
r <- which(phy at edge[,2]==node)
return(getnodes(phy,phy at edge[r,1]))
@@ -53,11 +53,11 @@
}
## get descendants [recursively]
-descendants <- function (phy, node, which=c("tips","all"))
-## self=FALSE)
+descendants <- function (phy, node, which=c("tips","children","all"))
{
## FIXME: allow vector of nodes? (or just let people lapply?)
which <- match.arg(which)
+ if (which=="children") return(children(phy,node))
node <- getnodes(phy,node)
if (is.na(node)) stop("node ",node," not found in tree")
n <- nTips(phy)
@@ -81,14 +81,16 @@
}
## get ancestors (all nodes)
-ancestors <- function (phy, node)
+ancestors <- function (phy, node, which=c("all","parent"))
{
+ which <- match.arg(which)
+ if (which=="parent") return(ancestor(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 <- parent(phy,node)
+ anc <- ancestor(phy,node)
res <- c(res,anc)
node <- anc
if (anc==n+1) break
Modified: pkg/man/treewalk.Rd
===================================================================
--- pkg/man/treewalk.Rd 2008-04-06 23:14:35 UTC (rev 172)
+++ pkg/man/treewalk.Rd 2008-04-07 00:51:23 UTC (rev 173)
@@ -1,7 +1,7 @@
\name{treewalk}
-\alias{parent}
\alias{children}
\alias{descendants}
+\alias{ancestor}
\alias{ancestors}
\alias{siblings}
\alias{MRCA}
@@ -13,11 +13,11 @@
}
\usage{
getnodes(phy,node)
-parent(phy, node)
+ancestors(phy, node, which=c("all","parent"))
+ancestor(phy, node)
siblings(phy,node,include.self=FALSE)
children(phy, node)
-descendants(phy, node, which=c("tips","all"))
-ancestors(phy, node)
+descendants(phy, node, which=c("tips","children","all"))
MRCA(phy,\dots)
}
\arguments{
@@ -25,7 +25,11 @@
\code{phylo4}, e.g. a \code{phylo4d} object)
}
\item{node}{a node number (or name)}
- \item{which}{whether to return all descendant nodes, or just tips}
+ \item{which}{(\code{ancestors}) specify whether to return just direct
+ ancestor ("parent") or all ancestor nodes; (\code{descendants})
+ specify whether to return
+ just direct descendants ("children"), all extant descendants
+ ("tips"), or all descendant nodes ("all")}
\item{include.self}{whether to include self in list of siblings}
\item{\dots}{a list of node numbers or names,
or a vector of node numbers or names}
@@ -34,13 +38,15 @@
\code{getnodes} takes character strings corresponding to tip or
node labels, or node numbers; it returns a named
vector of node numbers.
- \code{parent} and \code{children} return named vectors
- giving the
- immediate ancestors or descendants of a node; \code{descendants}
- returns all of the descendants (including internal nodes
- if which="all", otherwise tips only) of a
- node; \code{ancestors} returns all of the ancestors of
- a node; \code{siblings} returns sibling nodes (children
+ \code{ancestors} and \code{descendants}
+ return named vectors of the ancestors and descendants of
+ a node; \code{ancestor} is a synonym for
+ \code{ancestors(\dots,which="parent")} (i.e. direct
+ ancestor only), while
+ \code{children} is a synonym for
+ \code{descendants(\dots,which="children")} (i.e. direct
+ descendants only).
+ \code{siblings} returns sibling nodes (children
of the same parent).
\code{mrca} returns the most recent common ancestor of two or
more nodes.
@@ -55,9 +61,10 @@
getnodes(geospiza,"N04")
plot(as(geospiza,"phylo4"),
use.edge.length=FALSE,show.node.label=TRUE)
- parent(geospiza,"N11")
+ ancestor(geospiza,"N11")
children(geospiza,"N05")
- descendants(geospiza,"N11")
+ descendants(geospiza,"N11",which="tips")
+ descendants(geospiza,"N11",which="all")
ancestors(geospiza,"N11")
MRCA(geospiza,"conirostris","difficilis","fuliginosa")
MRCA(geospiza,"olivacea","conirostris")
More information about the Phylobase-commits
mailing list