[Ecopd-commits] r65 - branches/single-tree/R

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

Author: regetz
Date: 2009-11-14 01:59:20 +0100 (Sat, 14 Nov 2009)
New Revision: 65

Added:
   branches/single-tree/R/simpson.R
Modified:
   branches/single-tree/R/community.R
Log:
rewrote original simp.phy function as 'simpson' S4 methods


Modified: branches/single-tree/R/community.R
===================================================================
--- branches/single-tree/R/community.R	2009-11-14 00:53:29 UTC (rev 64)
+++ branches/single-tree/R/community.R	2009-11-14 00:59:20 UTC (rev 65)
@@ -26,26 +26,3 @@
 richness <- function(phylo4com, na.rm=FALSE) {
   sapply(phylo4com, function(x) sum(abundance(x)>0, na.rm=na.rm))
 }
-
-# simpson's index with and without phylogenetic distances using
-# commmunity matrix 'x', species names as colnames and community names
-# as rownames. phy=FALSE returns traditional simpson's index
-simp.phy <- function(x, tr, phy=TRUE) {
-
-  x <- as.matrix(x)
-  x <- x[, order(colnames(x)), drop=FALSE]
-  x <- prop.table(x, 1)
-    
-  if (phy==TRUE){
-    phy.mat <- cophenetic(tr)
-    phy.mat <- phy.mat[order(rownames(phy.mat)), order(colnames(phy.mat))]
-    out <- apply(x, 1, function(x) sum((x %o% x)*phy.mat))
-  } else {
-    bin.mat <- matrix(1, dim(x)[2], dim(x)[2])
-    diag(bin.mat) <- 0
-    out <- apply(x, 1, function(x) sum((x %o% x)*bin.mat))
-  }   
-        
-  return(out) 
-}
-

Added: branches/single-tree/R/simpson.R
===================================================================
--- branches/single-tree/R/simpson.R	                        (rev 0)
+++ branches/single-tree/R/simpson.R	2009-11-14 00:59:20 UTC (rev 65)
@@ -0,0 +1,41 @@
+##
+## Simpson's index with and without phylogenetic distances
+##
+
+setGeneric("simpson",
+  function(x, method=c("phylogenetic", "traditional")) {
+    standardGeneric("simpson")
+})
+
+setMethod("simpson", signature(x="phylo4d"),
+  function(x, method=c("phylogenetic", "traditional")) {
+    phyc <- phylo4com(x)
+    simpson(phyc, method=method)
+})
+
+setMethod("simpson", signature(x="phylo4com"),
+  function(x, method=c("phylogenetic", "traditional")) {
+    method <- match.arg(method)
+    N.relative <- prop.table(t(abundance(x)), 1)
+    if (method=="phylogenetic") {
+        dmat <- pairdist(x, type="tip")
+    } else {
+        dmat <- matrix(1, nTips(x), nTips(x))
+        diag(dmat) <- 0
+    }   
+    out <- apply(N.relative, 1, function(n) sum((n %o% n)*dmat))
+    return(out) 
+})
+
+## earlier version: works on a single phylo4d tree with abundance data
+#simpson <- function(phy, method=c("traditional", "phylogenetic")) {
+#  method <- match.arg(method)
+#  x <- prop.table(abundance(phy))
+#  if (method=="phylogenetic") {
+#    dmat <- pairdist(phy, type="tip")
+#  } else {
+#    dmat <- matrix(1, nTips(phy), nTips(phy))
+#    diag(dmat) <- 0
+#  }   
+#  sum((x %o% x) * dmat)
+#}


Property changes on: branches/single-tree/R/simpson.R
___________________________________________________________________
Name: svn:eol-style
   + native