[Vegan-commits] r2083 - pkg/vegan/R

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

Author: jarioksa
Date: 2012-02-12 08:20:01 +0100 (Sun, 12 Feb 2012)
New Revision: 2083

Modified:
   pkg/vegan/R/simper.R
Log:
Current version by Eduard Sz?\195?\182cz from https://raw.github.com/EDiLD/edimisc/master/R/simper.R (with formatting)

Modified: pkg/vegan/R/simper.R
===================================================================
--- pkg/vegan/R/simper.R	2012-02-11 07:53:27 UTC (rev 2082)
+++ pkg/vegan/R/simper.R	2012-02-12 07:20:01 UTC (rev 2083)
@@ -2,8 +2,15 @@
 #'
 #' Discriminating species between two groups using Bray-Curtis dissimilarities.
 #'
-#' @param comm Community data
-#' @param group Vector assigning the groups
+#' @param comm Community data matrix
+#' @param group factor describing the group structure. Must have at least 2 levels.
+#' 
+#' @section Details: simper is a function that extracts species discriminating between two groups and ranks them by their contribution. They Bray-Curtis dissimilarity between two samples is given as:
+#' d[jk] = (sum abs(x[ij]-x[ik])) / (sum (x[ij]+x[ik]))
+#' 
+#' print.simper prints the species with a cumulative contribution <= 70\%
+#' 
+#' summary.simper shows the whole output with additional characteristics
 #'
 #' @return
 #' A list of dataframes for every factor-combination.
@@ -14,7 +21,7 @@
 #' \item{cum}{cumulative per cent contribution}
 #'
 #' @author Eduard Szöcs \email{szoe8822@@uni-landau.de}
-#' @references Clarke, K.R. 1993. Non-parametric multivariate analyses of changes in community structure. \emph{Austral Ecology}, 18, 117–143.
+#' @references Clarke, K.R. 1993. Non-parametric multivariate analyses of changes incommunity structure. Austral Ecology, 18(1):117–143.
 #' @export
 #'
 #' @keywords multivariate
@@ -23,14 +30,15 @@
 #' require(vegan)
 #' data(dune)
 #' data(dune.env)
-#' with(dune.env, simper(dune, Management))
+#' (sim <- simper(dune, dune.env$Management))
+#' summary(sim)
 
 `simper` <-
     function(comm, group)
 {
     comp <- t(combn(unique(as.character(group)), 2))
     outlist <- NULL
-    for (i in 1:nrow(comp)) {
+    for (i in 1:nrow(comp)){
         group.a <- as.matrix(comm[group == comp[i, 1], ])  
         group.b <- as.matrix(comm[group == comp[i, 2], ])  
         n.a <- nrow(group.a)
@@ -44,16 +52,14 @@
                 for(s in 1:P) {
                     md[s] <- abs(group.a[k, s] - group.b[j, s])
                     me[s] <- group.a[k, s] + group.b[j, s]
-                    a <- rowSums(me)
-                    c <- md / a
-                    contr[(j-1)*n.a+k, ] <- md / a	
+                    contr[(j-1)*n.a+k, ] <- md / rowSums(me)	
                 }
             }
         }
         av.contr <- apply(contr, 2, mean) * 100
         ov.av.dis <- sum(av.contr)
         sdi <- apply(contr, 2, sd)
-        sdi.av <- sdi / av.contr
+        sdi.av <- av.contr / sdi
         av.a <- colMeans(group.a)
         av.b <- colMeans(group.b) 
         dat <- data.frame(av.contr, sdi, sdi.av, av.a, av.b)
@@ -63,5 +69,21 @@
         names(out) <- c("contr", "sd", "contr/sd", paste("av_", comp[i, 1], sep = ""), paste("av_", comp[i, 2], sep = ""), "cum")
         outlist[[paste(comp[i,1], "_", comp[i,2], sep = "")]] <- out
     }
+    class(outlist) <- "simper"
     outlist
 }
+
+`print.simper` <-
+    function(object)
+{
+    out <- lapply(object, function(x) t(x[x$cum <= 70 ,"cum", drop = FALSE]))
+    print(out)
+    invisible(object)
+}
+
+`summary.simper` <-
+    function(object)
+{
+    class(object) <- "summary.simper"
+    object
+}