[Picante-commits] r46 - in pkg: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Apr 2 04:18:33 CEST 2008
Author: pdc
Date: 2008-04-02 04:18:33 +0200 (Wed, 02 Apr 2008)
New Revision: 46
Added:
pkg/R/utility.R
Removed:
pkg/R/df2vec.R
pkg/R/internal2tips.R
pkg/R/node.age.R
pkg/R/phylo2phylog.R
pkg/R/sortColumns.R
pkg/R/sortRows.R
pkg/R/t2p2t.R
pkg/R/taxaShuffle.R
Modified:
pkg/man/utility.Rd
Log:
consolidate functions to match help files, add match.tree()
remove t2p2t function and help file, to be replaced with match.tree
Deleted: pkg/R/df2vec.R
===================================================================
--- pkg/R/df2vec.R 2008-03-27 01:05:35 UTC (rev 45)
+++ pkg/R/df2vec.R 2008-04-02 02:18:33 UTC (rev 46)
@@ -1,5 +0,0 @@
-df2vec <- function(x, colID=1) {
- vec <- x[,colID]
- names(vec) <- row.names(x)
- vec
-}
Deleted: pkg/R/internal2tips.R
===================================================================
--- pkg/R/internal2tips.R 2008-03-27 01:05:35 UTC (rev 45)
+++ pkg/R/internal2tips.R 2008-04-02 02:18:33 UTC (rev 46)
@@ -1,25 +0,0 @@
-`internal2tips` <-
-function(phy,int.node,return.names=FALSE) {
- # phy = phy object
- # int.node = number or name of internal node
- Ntaxa = length(phy$tip.label)
- Nnode = phy$Nnode
- if ((Ntaxa+Nnode-1)!=nrow(phy$edge)) {
- print('tree structure error')
- break
- }
-
- # if necessary convert int.node to a node number for an internal node
- if (mode(int.node)=='character') nodes = which(phy$node.label==int.node)+Ntaxa else nodes = int.node
-
- tips = c()
- repeat {
- nodes = phy$edge[which(phy$edge[,1]%in%nodes),2]
- if (length(nodes)==0) break
- tips = c(tips,nodes)
- }
- tips = tips[tips<=Ntaxa]
- if (return.names) tips = phy$tip.label[tips]
- return(tips)
-}
-
Deleted: pkg/R/node.age.R
===================================================================
--- pkg/R/node.age.R 2008-03-27 01:05:35 UTC (rev 45)
+++ pkg/R/node.age.R 2008-04-02 02:18:33 UTC (rev 46)
@@ -1,19 +0,0 @@
-`node.age` <-
-function(phy) {
- #if (phy$edge[1,1]=='-1') rootN=-1 else rootN = phy$Nnode+2
- rootN = phy$edge[1,1]
-
- nEdges = nrow(phy$edge)
-
- ages=rep(NA,nEdges)
-
- for (n in 1:nEdges) {
- if (phy$edge[n,1]==rootN) anc.age=0 else {
- anc.age=ages[which(phy$edge[,2]==phy$edge[n,1])]
- }
- ages[n] = anc.age + phy$edge.length[n]
- }
- phy$ages = ages
- return(phy)
- }
-
Deleted: pkg/R/phylo2phylog.R
===================================================================
--- pkg/R/phylo2phylog.R 2008-03-27 01:05:35 UTC (rev 45)
+++ pkg/R/phylo2phylog.R 2008-04-02 02:18:33 UTC (rev 46)
@@ -1,6 +0,0 @@
-`phylo2phylog` <-
-function(phy, ...) {
- if(!require(ade4)) {stop("This function requires the ade4 package")}
- newick2phylog(write.tree(phy),...)
-}
-
Deleted: pkg/R/sortColumns.R
===================================================================
--- pkg/R/sortColumns.R 2008-03-27 01:05:35 UTC (rev 45)
+++ pkg/R/sortColumns.R 2008-04-02 02:18:33 UTC (rev 46)
@@ -1,7 +0,0 @@
-`sortColumns` <-
-function(x) {
-
-x[,sort(colnames(x))]
-
-}
-
Deleted: pkg/R/sortRows.R
===================================================================
--- pkg/R/sortRows.R 2008-03-27 01:05:35 UTC (rev 45)
+++ pkg/R/sortRows.R 2008-04-02 02:18:33 UTC (rev 46)
@@ -1,7 +0,0 @@
-`sortRows` <-
-function(x) {
-
-x[sort(rownames(x)),]
-
-}
-
Deleted: pkg/R/t2p2t.R
===================================================================
--- pkg/R/t2p2t.R 2008-03-27 01:05:35 UTC (rev 45)
+++ pkg/R/t2p2t.R 2008-04-02 02:18:33 UTC (rev 46)
@@ -1,13 +0,0 @@
-`t2p2t` <-
-function(phy,species) {
- #print(phy$tip.label)
- #print(traits[,1])
- #species = data.frame(species)
- t.in.p = (species %in% phy$tip.label)
- mfp = as.character(species[!t.in.p])
- p.in.s = (phy$tip.label %in% species)
- mfs = phy$tip.label[!p.in.s]
- return(list(c('missing.from.phy:',mfp),
- c('missing.from.species:',mfs)))
- }
-
Deleted: pkg/R/taxaShuffle.R
===================================================================
--- pkg/R/taxaShuffle.R 2008-03-27 01:05:35 UTC (rev 45)
+++ pkg/R/taxaShuffle.R 2008-04-02 02:18:33 UTC (rev 46)
@@ -1,10 +0,0 @@
-`taxaShuffle` <-
-function(x) {
- #todo replace with vegan's permuted.index?
- if (!is.matrix(x)) x <- as.matrix(x)
- rand.names <- sample(rownames(x))
- rownames(x) <- rand.names
- colnames(x) <- rand.names
- x
-}
-
Added: pkg/R/utility.R
===================================================================
--- pkg/R/utility.R (rev 0)
+++ pkg/R/utility.R 2008-04-02 02:18:33 UTC (rev 46)
@@ -0,0 +1,102 @@
+`match.tree` <- function(phy, x, taxacol, traitcol, strict = FALSE) {
+ # some data input error checking, all taxa in tree and x
+ # no missing data values
+ stopifnot(traitcol %in% names(x), taxacol %in% names(x),
+ class(x) == "data.frame", class(phylo) == "phylo")
+ len.tips <- length(phylo$tip.label)
+ len.taxa <- length(x[,taxacol])
+ if (any(missing <- !(phy$tip.label %in% x[, taxacol]))) {
+ stop("ERROR. phylogeny tip(s): ", phy$tip.label[missing],
+ "are missing from '", substitute(x), "'")
+ }
+ if (strict && any(missing <- !(phy$tip.label %in% x[, taxacol])))
+ stop("ERROR. '", substitute(x), "' contains taxa:", phy$tip.label[missing],
+ "not found in '", substitute(phy), "'")
+ # ensure that the order of the data frame matches the tips
+ # order <- match(phylo$tip.label, x[, taxcol])
+ # allow taxa names as row names col names
+ # deal with a vector as well
+ # what to return?
+}
+
+`df2vec` <- function(x, colID=1) {
+ vec <- x[,colID]
+ names(vec) <- row.names(x)
+ vec
+}
+
+`internal2tips` <-
+function(phy,int.node,return.names=FALSE) {
+ # phy = phy object
+ # int.node = number or name of internal node
+ Ntaxa = length(phy$tip.label)
+ Nnode = phy$Nnode
+ if ((Ntaxa+Nnode-1)!=nrow(phy$edge)) {
+ print('tree structure error')
+ break
+ }
+
+ # if necessary convert int.node to a node number for an internal node
+ if (mode(int.node)=='character') nodes = which(phy$node.label==int.node)+Ntaxa else nodes = int.node
+
+ tips = c()
+ repeat {
+ nodes = phy$edge[which(phy$edge[,1]%in%nodes),2]
+ if (length(nodes)==0) break
+ tips = c(tips,nodes)
+ }
+ tips = tips[tips<=Ntaxa]
+ if (return.names) tips = phy$tip.label[tips]
+ return(tips)
+}
+
+`node.age` <-
+function(phy) {
+ #if (phy$edge[1,1]=='-1') rootN=-1 else rootN = phy$Nnode+2
+ rootN = phy$edge[1,1]
+
+ nEdges = nrow(phy$edge)
+
+ ages=rep(NA,nEdges)
+
+ for (n in 1:nEdges) {
+ if (phy$edge[n,1]==rootN) anc.age=0 else {
+ anc.age=ages[which(phy$edge[,2]==phy$edge[n,1])]
+ }
+ ages[n] = anc.age + phy$edge.length[n]
+ }
+ phy$ages = ages
+ return(phy)
+ }
+
+`phylo2phylog` <-
+function(phy, ...) {
+ if(!require(ade4)) {stop("This function requires the ade4 package")}
+ newick2phylog(write.tree(phy),...)
+}
+
+`sortColumns` <-
+function(x) {
+
+x[,sort(colnames(x))]
+
+}
+
+`sortRows` <-
+function(x) {
+
+x[sort(rownames(x)),]
+
+}
+
+
+`taxaShuffle` <-
+function(x) {
+ #todo replace with vegan's permuted.index?
+ if (!is.matrix(x)) x <- as.matrix(x)
+ rand.names <- sample(rownames(x))
+ rownames(x) <- rand.names
+ colnames(x) <- rand.names
+ x
+}
+
Modified: pkg/man/utility.Rd
===================================================================
--- pkg/man/utility.Rd 2008-03-27 01:05:35 UTC (rev 45)
+++ pkg/man/utility.Rd 2008-04-02 02:18:33 UTC (rev 46)
@@ -6,7 +6,6 @@
\alias{sortColumns}
\alias{sortRows}
\alias{taxaShuffle}
-\alias{t2p2t}
\title{ Picante utility functions }
\description{
Picante utility functions for tree and data manipulation
More information about the Picante-commits
mailing list