[Vegan-commits] r2091 - in pkg/vegan: R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Feb 16 15:10:36 CET 2012


Author: jarioksa
Date: 2012-02-16 15:10:36 +0100 (Thu, 16 Feb 2012)
New Revision: 2091

Modified:
   pkg/vegan/R/simper.R
   pkg/vegan/man/simper.Rd
Log:
Squashed commit of the following:

commit cf72efd547e0487a62529b382fcc92a3127b8c65
Merge: 8e08f0c a12a0ec
Author: jarioksa <jari.oksanen at oulu.fi>
Date:   Thu Feb 16 05:56:37 2012 -0800

    Merge pull request #2 from EDiLD/master

    simper should be now ready for release

commit a12a0ecd92d0fde018aa710b3ae3f6f978cd7204
Author: edisz <szoe8822 at uni-landau.de>
Date:   Thu Feb 16 13:14:17 2012 +0100

    typo

commit 5dd3236e2b1240f7f7a462ba7a17dd04cd216061
Author: edisz <szoe8822 at uni-landau.de>
Date:   Thu Feb 16 12:02:53 2012 +0100

    simper passes now CMD check

commit fe6a9fda1daecdf5627b9f61ca05d31f79b59126
Author: edisz <szoe8822 at uni-landau.de>
Date:   Thu Feb 16 11:22:15 2012 +0100

    fixed simper.Rd (examples, \alias)

commit 3223c72070f50118ab05a125fdffce1a9eac5634
Author: edisz <szoe8822 at uni-landau.de>
Date:   Tue Feb 14 19:08:51 2012 +0100

    corrected permutational p-value

commit b38cfc478600cbfbf66abb1f07cea546656e8c68
Author: edisz <szoe8822 at uni-landau.de>
Date:   Tue Feb 14 19:04:36 2012 +0100

    fixed typo

commit 3d67710d1e18c9feb53132b71ec7b2850b720556
Author: edisz <szoe8822 at uni-landau.de>
Date:   Tue Feb 14 18:44:08 2012 +0100

    updated documentation

commit 9429d2373e21866e9f0cde9ff102790083128927
Author: edisz <szoe8822 at uni-landau.de>
Date:   Tue Feb 14 18:19:59 2012 +0100

    updated documentation to changes

commit c3c8814bc6969dd411cf234ba5b1eee3e282fbef
Author: edisz <szoe8822 at uni-landau.de>
Date:   Tue Feb 14 17:15:38 2012 +0100

    changes make the code noticable faster

commit bc3e13ecc6bd194bf1087821fbff750bc3d3d309
Author: edisz <szoe8822 at uni-landau.de>
Date:   Tue Feb 14 15:37:31 2012 +0100

    cumsum is also stored in the simper-object
    + style formatting

commit fbdb8c3f141bc6f1bdc014278c655a047c0e04c9
Author: edisz <szoe8822 at uni-landau.de>
Date:   Tue Feb 14 14:54:08 2012 +0100

    embed a permutation test of the average contribution

commit 31ed428a11c7637b7e4d309079d9280f9edc64d1
Author: edisz <szoe8822 at uni-landau.de>
Date:   Tue Feb 14 13:08:01 2012 +0100

    added option to return a summary ordered by cumsum.
    some style formatting

commit 373913b209357ea0a48d009a338b81239568ca2e
Author: edisz <szoe8822 at uni-landau.de>
Date:   Tue Feb 14 12:52:14 2012 +0100

    fixed typo

commit 5992276a411361f41239190b0182e57c8e46ffa3
Author: edisz <szoe8822 at uni-landau.de>
Date:   Tue Feb 14 12:44:08 2012 +0100

    restructured output

Modified: pkg/vegan/R/simper.R
===================================================================
--- pkg/vegan/R/simper.R	2012-02-16 14:09:15 UTC (rev 2090)
+++ pkg/vegan/R/simper.R	2012-02-16 14:10:36 UTC (rev 2091)
@@ -1,33 +1,58 @@
 `simper` <-
-    function(comm, group)
+    function(comm, group, permutations = 0)
 {
+    comm <- as.matrix(comm)
     comp <- t(combn(unique(as.character(group)), 2))
     outlist <- NULL
-    for (i in 1:nrow(comp)){
-        group.a <- as.matrix(comm[group == comp[i, 1], ])  
-        group.b <- as.matrix(comm[group == comp[i, 2], ])  
+    for (i in 1:nrow(comp)) {
+        group.a <- comm[group == comp[i, 1], ]
+        group.b <- comm[group == comp[i, 2], ]
         n.a <- nrow(group.a)
         n.b <- nrow(group.b)
         P <- ncol(comm)
         contr <- matrix(ncol = P, nrow = n.a * n.b)
-        for(j in 1:n.b) {
-            for(k in 1:n.a) {
+        for (j in 1:n.b) {
+            for (k in 1:n.a) {
                 md <- abs(group.a[k, ] - group.b[j, ])
                 me <- group.a[k, ] + group.b[j, ]
                 contr[(j-1)*n.a+k, ] <- md / sum(me)	
             }
         }
-        av.contr <- colMeans(contr) * 100
-        ov.av.dis <- sum(av.contr)
+        average <- colMeans(contr) * 100
+        
+        if(permutations != 0){
+            cat("Permuting", paste(comp[i,1], "_", comp[i,2], sep = ""), "\n")
+            nobs <- length(group)
+            perm.contr <- matrix(nrow=P, ncol=permutations)
+            contrp <- matrix(ncol = P, nrow = n.a * n.b)
+            for(p in 1:permutations){
+                perm <- shuffle(nobs)
+                groupp <- group[perm]
+                ga <- comm[groupp == comp[i, 1], ] 
+                gb <- comm[groupp == comp[i, 2], ]
+                for(j in 1:n.b) {
+                    for(k in 1:n.a) {
+                        mdp <- abs(ga[k, ] - gb[j, ])
+                        mep <- ga[k, ] + gb[j, ]
+                        contrp[(j-1)*n.a+k, ] <- mdp / sum(mep)  
+                    }
+                }
+                perm.contr[ ,p] <- colMeans(contrp) * 100
+            }
+        p <- (apply(apply(perm.contr, 2, function(x) x >= average), 1, sum) + 1) / (permutations + 1)
+        } 
+        else {
+          p <- NULL
+        }
+        
+        overall <- sum(average)
         sdi <- apply(contr, 2, sd)
-        sdi.av <- av.contr / sdi
+        ratio <- average / sdi
         av.a <- colMeans(group.a)
         av.b <- colMeans(group.b) 
-        dat <- data.frame(av.contr, sdi, sdi.av, av.a, av.b)
-        dat <- dat[order(dat$av.contr, decreasing = TRUE), ]
-        cum <-  cumsum(dat$av.contr / ov.av.dis) * 100
-        out <-  data.frame(dat, cum)
-        names(out) <- c("contr", "sd", "contr/sd", paste("av_", comp[i, 1], sep = ""), paste("av_", comp[i, 2], sep = ""), "cum")
+        ord <- order(average, decreasing = TRUE)
+        cusum <- cumsum(average[ord] / overall * 100)
+        out <-  list(species = colnames(comm), average = average, overall = overall, sd = sdi, ratio = ratio, ava = av.a, avb = av.b, ord = ord, cusum = cusum, p = p)
         outlist[[paste(comp[i,1], "_", comp[i,2], sep = "")]] <- out
     }
     class(outlist) <- "simper"
@@ -37,14 +62,33 @@
 `print.simper` <-
     function(x, ...)
 {
-    out <- lapply(x, function(z) t(z[z$cum <= 70 ,"cum", drop = FALSE]))
+    cat("cumulative contributions of most influential species:\n\n")
+    cusum <- lapply(x, function(z) z$cusum)
+    spec <- lapply(x, function(z) z$species[z$ord])
+    for (i in 1:length(cusum)) {
+        names(cusum[[i]]) <- spec[[i]]
+    }
+    out <- lapply(cusum, function(z) z[z <= 70])
     print(out)
     invisible(x)
 }
 
 `summary.simper` <-
-    function(object, ...)
+    function(object, ordered = TRUE, ...)
 {
-    class(object) <- "summary.simper"
-    object
+    if (ordered == TRUE) {
+        out <- lapply(object, function(z) data.frame(contr = z$average, sd = z$sd, ratio = z$ratio, av.a = z$ava, av.b = z$avb)[z$ord, ])
+        cusum <- lapply(object, function(z) z$cusum)
+        for(i in 1:length(out)) {
+            out[[i]]$cumsum <- cusum[[i]]
+            if(!is.null(object[[i]]$p)) {
+                out[[i]]$p <- object[[i]]$p[object[[i]]$ord]
+            }
+        } 
+    } 
+    else {
+        out <- lapply(object, function(z) data.frame(contr = z$average, sd = z$sd, 'contr/sd' = z$ratio, av.a = z$ava, av.b = z$avb, p = z$p))
+    }
+    class(out) <- "summary.simper"
+    out
 }

Modified: pkg/vegan/man/simper.Rd
===================================================================
--- pkg/vegan/man/simper.Rd	2012-02-16 14:09:15 UTC (rev 2090)
+++ pkg/vegan/man/simper.Rd	2012-02-16 14:10:36 UTC (rev 2091)
@@ -1,6 +1,7 @@
 \encoding{UTF-8}
 \name{simper}
 \alias{simper}
+\alias{summary.simper}
 \title{Similarity Percentages}
 
 \description{
@@ -9,12 +10,18 @@
 }
 
 \usage{
-  simper(comm, group)
+  simper(comm, group, permutations = 0)
+  
+  \method{summary}{simper}(object, ordered = TRUE, ...)
 }
+
 \arguments{
-  \item{comm}{Community data matrix}
-  
+  \item{comm}{Community data matrix.}
   \item{group}{Factor describing the group structure. Must have at least 2 levels.}
+  \item{permutations}{Number of permutations for assessing the \dQuote{significance} of the average contribution. Default is set to 0 (no permutation test), since computations may take long time.}
+  \item{object}{an object returned by \code{simper}.}
+  \item{ordered}{Logical; Should the species be ordered by their average contribution?}
+  \item{...}{Parameters passed to other functions}
 }
 
 \details{ Similarity percentage, \code{simper} (Clarke 1993) is based
@@ -42,16 +49,19 @@
 \value{
   A list of dataframes for every factor-combination.
   \item{contr}{average contribution to overall
-  dissimilarity} \item{sd}{standard deviation of
-  contribution} \item{contr/sd}{mean to sd ratio}
-  \item{av_}{average abundance per group}
-  \item{cum}{cumulative per cent contribution}
+  dissimilarity.} 
+  \item{sd}{standard deviation of
+  contribution.} 
+  \item{ratio}{mean to sd ratio.}
+  \item{av_}{average abundance per group.}
+  \item{cumsum}{cumulative per cent contribution.}
+  \item{p}{permutation p-value. Probability of getting a larger or equal average contribution in random permutation of the group factor.}
 }
 
 \examples{
 data(dune)
 data(dune.env)
-(sim <- with(dune.env, simper(dune, Management)))
+(sim <- with(dune.env, simper(dune, Management, permutations = 0)))
 summary(sim)
 }
 \author{



More information about the Vegan-commits mailing list