[Vegan-commits] r2099 - in branches/2.0: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Feb 19 20:33:16 CET 2012
Author: jarioksa
Date: 2012-02-19 20:33:15 +0100 (Sun, 19 Feb 2012)
New Revision: 2099
Modified:
branches/2.0/NAMESPACE
branches/2.0/R/simper.R
branches/2.0/inst/ChangeLog
branches/2.0/man/simper.Rd
Log:
merge r2097,8: add print.summary.simper and fix summary.simper
Modified: branches/2.0/NAMESPACE
===================================================================
--- branches/2.0/NAMESPACE 2012-02-19 19:19:59 UTC (rev 2098)
+++ branches/2.0/NAMESPACE 2012-02-19 19:33:15 UTC (rev 2099)
@@ -315,6 +315,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: branches/2.0/R/simper.R
===================================================================
--- branches/2.0/R/simper.R 2012-02-19 19:19:59 UTC (rev 2098)
+++ branches/2.0/R/simper.R 2012-02-19 19:33:15 UTC (rev 2099)
@@ -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, ])
@@ -95,8 +105,35 @@
}
}
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))
+ out <- lapply(object, function(z) data.frame(cbind(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: branches/2.0/inst/ChangeLog
===================================================================
--- branches/2.0/inst/ChangeLog 2012-02-19 19:19:59 UTC (rev 2098)
+++ branches/2.0/inst/ChangeLog 2012-02-19 19:33:15 UTC (rev 2099)
@@ -5,6 +5,9 @@
Version 2.0-3 (opened November 13, 2011)
* copy simper.R & simper.Rd at r2092.
+ * merge r2098: fix summary.simper(..., order=FALSE) when
+ permutations = 0.
+ * merge r2097: add print.summary.simper.
* merge r2089: scores.default fixed with non-existing scores.
* merge r2080: use droplevels in betadisper.
* merge r2078,2084: simper NAMESPACE.
Modified: branches/2.0/man/simper.Rd
===================================================================
--- branches/2.0/man/simper.Rd 2012-02-19 19:19:59 UTC (rev 2098)
+++ branches/2.0/man/simper.Rd 2012-02-19 19:33:15 UTC (rev 2099)
@@ -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.}
More information about the Vegan-commits
mailing list