[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