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

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

Author: jarioksa
Date: 2012-02-19 18:50:08 +0100 (Sun, 19 Feb 2012)
New Revision: 2097

Modified:
   pkg/vegan/NAMESPACE
   pkg/vegan/R/simper.R
   pkg/vegan/man/simper.Rd
Log:
merge github updates

Modified: pkg/vegan/NAMESPACE
===================================================================
--- pkg/vegan/NAMESPACE	2012-02-19 06:29:32 UTC (rev 2096)
+++ pkg/vegan/NAMESPACE	2012-02-19 17:50:08 UTC (rev 2097)
@@ -318,6 +318,7 @@
 S3method(print, summary.permat)
 S3method(print, summary.prc)
 S3method(print, summary.procrustes)
+S3method(print, summary.simper)
 S3method(print, summary.taxondive)
 S3method(print, taxondive)
 S3method(print, tolerance.cca)

Modified: pkg/vegan/R/simper.R
===================================================================
--- pkg/vegan/R/simper.R	2012-02-19 06:29:32 UTC (rev 2096)
+++ pkg/vegan/R/simper.R	2012-02-19 17:50:08 UTC (rev 2097)
@@ -10,7 +10,14 @@
     ## Make permutation matrix
     if (length(permutations) == 1) {
         perm <- shuffleSet(nobs, permutations, ...)
+    } else {  # permutations is a matrix
+        perm <- permutations
     }
+    ## check dims (especially if permutations was a matrix)
+    if (ncol(perm) != nobs)
+        stop(gettextf("'permutations' have %d columns, but data have %d rows",
+                          ncol(perm), nobs))
+    ## OK: take number of permutations
     nperm <- nrow(perm)
     if (nperm > 0)
         perm.contr <- matrix(nrow=P, ncol=nperm)
@@ -59,9 +66,12 @@
         av.b <- colMeans(group.b) 
         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)
+        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
     }
+    attr(outlist, "permutations") <- nperm
     class(outlist) <- "simper"
     outlist
 }
@@ -82,7 +92,7 @@
 }
 
 `summary.simper` <-
-    function(object, ordered = TRUE, ...)
+    function(object, ordered = TRUE, digits = max(3, getOption("digits") - 3), ...)
 {
     if (ordered) {
         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, ])
@@ -97,6 +107,33 @@
     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))
     }
+    attr(out, "digits") <- digits
+    attr(out, "permutations") <- attr(object, "permutations")
     class(out) <- "summary.simper"
     out
 }
+
+`print.summary.simper`<-
+    function(x, digits = attr(x, "digits"), ...)
+{
+    signif.stars <- getOption("show.signif.stars") && attr(x, "permutations") > 0
+    starprint <- function(z, ...) {
+        if (signif.stars && any(z$p < 0.1)) {
+            stars <- symnum(z$p, cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1),
+                            symbols = c("***", "**", "*", ".", " "))
+            z <- cbind(z, " " = format(stars))
+        }
+        z
+    }
+    out <- lapply(x, starprint, digits = digits, ...)
+    print(out)
+    if (signif.stars && any(sapply(x, function(z) z$p) < 0.1)) {
+        leg <- attr(symnum(1, cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1),
+                            symbols = c("***", "**", "*", ".", " ")), "legend")
+        cat("---\nSignif. codes: ", leg, "\n")
+    }
+    if ((np <- attr(x, "permutations")) > 0)
+        cat("P-values based on", np, "permutations\n")
+    invisible(x)
+}
+

Modified: pkg/vegan/man/simper.Rd
===================================================================
--- pkg/vegan/man/simper.Rd	2012-02-19 06:29:32 UTC (rev 2096)
+++ pkg/vegan/man/simper.Rd	2012-02-19 17:50:08 UTC (rev 2097)
@@ -12,7 +12,8 @@
 \usage{
   simper(comm, group, permutations = 0, trace = FALSE, ...)
   
-  \method{summary}{simper}(object, ordered = TRUE, ...)
+  \method{summary}{simper}(object, ordered = TRUE, 
+     digits = max(3, getOption("digits") - 3), ...)
 }
 
 \arguments{
@@ -20,14 +21,15 @@
   \item{group}{Factor describing the group structure. Must have at
     least 2 levels.}
   \item{permutations}{Number of permutations or a permutation matrix
-    such as produced by \code{\link[permute]{shuffleSet}} for assessing
-    the \dQuote{significance} of the average contribution. Default is
-    set to 0 (no permutation test), since computations may take long
+    where each row gives a permuted index for assessing the
+    \dQuote{significance} of the average contribution. Default is set
+    to 0 (no permutation test), since computations may take long
     time.}
   \item{trace}{Trace permutations.}
   \item{object}{an object returned by \code{simper}.}
   \item{ordered}{Logical; Should the species be ordered by their
     average contribution?}
+  \item{digits}{Number of digits in output.}
   \item{...}{Parameters passed to other functions. In \code{simper} the
     extra parameters are passed to \code{\link[permute]{shuffleSet}} if
     permutations are used.}