[Picante-commits] r88 - branches/gsoc/R

[noreply at r-forge.r-project.org]

Author: skembel
Date: 2008-06-05 08:13:24 +0200 (Thu, 05 Jun 2008)
New Revision: 88

Added:
   branches/gsoc/R/pruning.R
Modified:
   branches/gsoc/R/evolve.trait.R
   branches/gsoc/R/phylodiversity.R
   branches/gsoc/R/utility.R
Log:
Merging trunk 0.1-2 updates into gsoc branch

Modified: branches/gsoc/R/evolve.trait.R
===================================================================
--- branches/gsoc/R/evolve.trait.R	2008-06-04 09:54:30 UTC (rev 87)
+++ branches/gsoc/R/evolve.trait.R	2008-06-05 06:13:24 UTC (rev 88)
@@ -6,7 +6,7 @@
 }
 
 
-`evolve.trait` <-
+`.evolve.trait` <-
 function(phy,
 	x.root=0, #root value
 	sigma = 1, #brownian motion st. dev.

Modified: branches/gsoc/R/phylodiversity.R
===================================================================
--- branches/gsoc/R/phylodiversity.R	2008-06-04 09:54:30 UTC (rev 87)
+++ branches/gsoc/R/phylodiversity.R	2008-06-05 06:13:24 UTC (rev 88)
@@ -59,9 +59,14 @@
 	mnnd <- numeric(N)
 	for (i in 1:N) {
 		sppInSample <- names(samp[i,samp[i,]>0])
-		sample.dis <- dis[sppInSample,sppInSample]
-		diag(sample.dis) <- NA
-		mnnd[i] <- mean(apply(sample.dis,2,min,na.rm=TRUE))
+		if (length(sppInSample) > 1) {
+            sample.dis <- dis[sppInSample,sppInSample]
+            diag(sample.dis) <- NA
+		    mnnd[i] <- mean(apply(sample.dis,2,min,na.rm=TRUE))
+		}
+		else {
+		    mnnd[i] <- 0
+		}
 	}
 	mnnd
 }

Copied: branches/gsoc/R/pruning.R (from rev 87, pkg/R/pruning.R)
===================================================================
--- branches/gsoc/R/pruning.R	                        (rev 0)
+++ branches/gsoc/R/pruning.R	2008-06-05 06:13:24 UTC (rev 88)
@@ -0,0 +1,21 @@
+`prune.sample` <-
+function (samp, phylo) 
+{
+    treeTaxa <- phylo$tip.label
+    sampleTaxa <- colnames(samp)
+    trimTaxa <- setdiff(treeTaxa, sampleTaxa)
+    if (length(trimTaxa) > 0) drop.tip(phylo, trimTaxa) else phylo
+}
+
+'prune.missing' <-
+function(x, phylo) {
+	result <- list(NULL)
+    treeTaxa <- phylo$tip.label
+    traitTaxa <- names(na.omit(x[phylo$tip.label]))
+    trimTaxa <- setdiff(treeTaxa, traitTaxa)
+    if (length(trimTaxa) > 0) 
+        result$tree <- drop.tip(phylo, trimTaxa)
+    else result$tree <- phylo
+	result$data <- na.omit(x[phylo$tip.label])
+    result
+}

Modified: branches/gsoc/R/utility.R
===================================================================
--- branches/gsoc/R/utility.R	2008-06-04 09:54:30 UTC (rev 87)
+++ branches/gsoc/R/utility.R	2008-06-05 06:13:24 UTC (rev 88)
@@ -1,4 +1,4 @@
-`match.tree` <- function(phy, x, taxacol, traitcol, strict = FALSE) {
+`.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),
@@ -69,12 +69,6 @@
 	return(phy)
 	}
 
-`phylo2phylog` <-
-function(phy, ...) {
-    if(!require(ade4)) {stop("This function requires the ade4 package")}
-    newick2phylog(write.tree(phy),...)
-}
-
 `sortColumns` <-
 function(x) {