[Vegan-commits] r2924 - in pkg/vegan: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jan 7 14:01:37 CET 2015
Author: jarioksa
Date: 2015-01-07 14:01:37 +0100 (Wed, 07 Jan 2015)
New Revision: 2924
Modified:
pkg/vegan/DESCRIPTION
pkg/vegan/R/adonis.R
pkg/vegan/R/anosim.R
pkg/vegan/R/bioenv.default.R
pkg/vegan/R/estaccumR.R
pkg/vegan/R/mantel.R
pkg/vegan/R/mantel.partial.R
pkg/vegan/R/metaMDSiter.R
pkg/vegan/R/mrpp.R
pkg/vegan/R/oecosimu.R
pkg/vegan/R/ordiareatest.R
pkg/vegan/R/orditkplot.R
pkg/vegan/R/permutest.betadisper.R
pkg/vegan/R/permutest.cca.R
pkg/vegan/R/poolaccum.R
pkg/vegan/R/renyiaccum.R
pkg/vegan/R/simper.R
pkg/vegan/R/specaccum.R
pkg/vegan/R/tsallisaccum.R
pkg/vegan/R/vegandocs.R
pkg/vegan/inst/ChangeLog
pkg/vegan/inst/NEWS.Rd
pkg/vegan/man/isomap.Rd
pkg/vegan/man/renyi.Rd
pkg/vegan/man/specaccum.Rd
pkg/vegan/man/specpool.Rd
pkg/vegan/man/tsallis.Rd
pkg/vegan/man/vegandocs.Rd
Log:
Merge branch 'cran-2.2' into r-forge-svn-local
Modified: pkg/vegan/DESCRIPTION
===================================================================
--- pkg/vegan/DESCRIPTION 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/DESCRIPTION 2015-01-07 13:01:37 UTC (rev 2924)
@@ -7,7 +7,7 @@
M. Henry H. Stevens, Helene Wagner
Maintainer: Jari Oksanen <jari.oksanen at oulu.fi>
Depends: permute (>= 0.7-8), lattice, R (>= 2.15.0)
-Suggests: parallel, tcltk
+Suggests: tcltk
Imports: MASS, cluster, mgcv
Description: Ordination methods, diversity analysis and other
functions for community and vegetation ecologists.
Modified: pkg/vegan/R/adonis.R
===================================================================
--- pkg/vegan/R/adonis.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/adonis.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -100,23 +100,23 @@
if (is.null(parallel))
parallel <- 1
hasClus <- inherits(parallel, "cluster")
- isParal <- (hasClus || parallel > 1) && require(parallel)
+ isParal <- hasClus || parallel > 1
isMulticore <- .Platform$OS.type == "unix" && !hasClus
if (isParal && !isMulticore && !hasClus) {
- parallel <- makeCluster(parallel)
+ parallel <- parallel::makeCluster(parallel)
}
if (isParal) {
if (isMulticore) {
f.perms <-
sapply(1:nterms, function(i)
- unlist(mclapply(1:permutations, function(j)
+ unlist(parallel::mclapply(1:permutations, function(j)
f.test(tH.s[[i]], G[p[j,], p[j,]],
df.Exp[i], df.Res, tIH.snterm),
mc.cores = parallel)))
} else {
f.perms <-
sapply(1:nterms, function(i)
- parSapply(parallel, 1:permutations, function(j)
+ parallel::parSapply(parallel, 1:permutations, function(j)
f.test(tH.s[[i]], G[p[j,], p[j,]],
df.Exp[i], df.Res, tIH.snterm)))
}
@@ -129,7 +129,7 @@
}
## Close socket cluster if created here
if (isParal && !isMulticore && !hasClus)
- stopCluster(parallel)
+ parallel::stopCluster(parallel)
## Round to avoid arbitrary P-values with tied data
f.perms <- round(f.perms, 12)
P <- (rowSums(t(f.perms) >= F.Mod)+1)/(permutations+1)
Modified: pkg/vegan/R/anosim.R
===================================================================
--- pkg/vegan/R/anosim.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/anosim.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -46,18 +46,19 @@
if (is.null(parallel))
parallel <- 1
hasClus <- inherits(parallel, "cluster")
- if ((hasClus || parallel > 1) && require(parallel)) {
+ if (hasClus || parallel > 1) {
if(.Platform$OS.type == "unix" && !hasClus) {
- perm <- unlist(mclapply(1:permutations, function(i, ...)
- ptest(permat[i,]),
- mc.cores = parallel))
+ perm <- unlist(parallel::mclapply(1:permutations,
+ function(i, ...)
+ ptest(permat[i,]),
+ mc.cores = parallel))
} else {
if (!hasClus) {
- parallel <- makeCluster(parallel)
+ parallel <- parallel::makeCluster(parallel)
}
- perm <- parRapply(parallel, permat, ptest)
+ perm <- parallel::parRapply(parallel, permat, ptest)
if (!hasClus)
- stopCluster(parallel)
+ parallel::stopCluster(parallel)
}
} else {
perm <- sapply(1:permutations, function(i) ptest(permat[i,]))
Modified: pkg/vegan/R/bioenv.default.R
===================================================================
--- pkg/vegan/R/bioenv.default.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/bioenv.default.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -72,10 +72,11 @@
if (is.null(parallel))
parallel <- 1
hasClus <- inherits(parallel, "cluster")
- isParal <- (hasClus || parallel > 1) && require(parallel)
+ isParal <- hasClus || parallel > 1
isMulticore <- .Platform$OS.type == "unix" && !hasClus
if (isParal && !isMulticore && !hasClus) {
- parallel <- makeCluster(parallel)
+ parallel <- parallel::makeCluster(parallel)
+ on.exit(parallel::stopCluster(parallel))
}
## get the number of clusters
if (inherits(parallel, "cluster"))
@@ -96,13 +97,13 @@
sets <- as.matrix(t(sets))
if (isParal && nrow(sets) >= CLUSLIM*nclus) {
if (isMulticore) {
- est <- unlist(mclapply(1:nrow(sets), function(j)
+ est <- unlist(parallel::mclapply(1:nrow(sets), function(j)
corfun(comdis,
distfun(x[,sets[j,],drop = FALSE]),
partial, method = method, ...),
mc.cores = parallel))
} else {
- est <- parSapply(parallel, 1:nrow(sets), function(j)
+ est <- parallel::parSapply(parallel, 1:nrow(sets), function(j)
corfun(comdis, distfun(x[,sets[j,],drop = FALSE]),
partial, method = method, ...))
}
Modified: pkg/vegan/R/estaccumR.R
===================================================================
--- pkg/vegan/R/estaccumR.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/estaccumR.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -1,21 +1,43 @@
##" Individual based accumulation model. Similar to poolaccum but uses
##estimateR. Inherits from "poolaccum" class and uses its methods.
`estaccumR` <-
- function(x, permutations = 100)
+ function(x, permutations = 100, parallel = getOption("mc.cores"))
{
n <- nrow(x)
N <- seq_len(n)
- S <- chao <- ace <- matrix(0, nrow = n, ncol = permutations)
- for (i in 1:permutations) {
- take <- sample(n)
- tmp <- estimateR(apply(x[take,], 2, cumsum))
- S[,i] <- tmp[1,]
- chao[,i] <- tmp[2,]
- ace[, i] <- tmp[4,]
+ estFun <- function(idx) {
+ estimateR(apply(x[idx,], 2, cumsum))[c(1,2,4),]
}
+ permat <- getPermuteMatrix(permutations, n)
+ nperm <- nrow(permat)
+ ## parallel processing
+ if (is.null(parallel))
+ parallel <- 1
+ hasClus <- inherits(parallel, "cluster")
+ if (hasClus || parallel > 1) {
+ if(.Platform$OS.type == "unix" && !hasClus) {
+ tmp <- parallel::mclapply(1:nperm, function(i)
+ estFun(permat[i,]),
+ mc.cores = parallel)
+ } else {
+ if (!hasClus) {
+ parallel <- parallel::makeCluster(parallel)
+ }
+ tmp <- parallel::parLapply(parallel, 1:nperm, function(i) estFun(permat[i,]))
+ if (!hasClus)
+ parallel::stopCluster(parallel)
+ }
+ } else {
+ tmp <- lapply(1:permutations, function(i) estFun(permat[i,]))
+ }
+
+ S <- sapply(tmp, function(x) x[1,])
+ chao <- sapply(tmp, function(x) x[2,])
+ ace <- sapply(tmp, function(x) x[3,])
means <- cbind(N = N, S = rowMeans(S), Chao = rowMeans(chao),
ACE = rowMeans(ace))
out <- list(S = S, chao = chao, ace = ace, N = N, means = means)
+ attr(out, "control") <- attr(permat, "control")
class(out) <- c("estaccumR", "poolaccum")
out
}
Modified: pkg/vegan/R/mantel.R
===================================================================
--- pkg/vegan/R/mantel.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/mantel.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -37,19 +37,19 @@
if (is.null(parallel))
parallel <- 1
hasClus <- inherits(parallel, "cluster")
- if ((hasClus || parallel > 1) && require(parallel)) {
+ if (hasClus || parallel > 1) {
if(.Platform$OS.type == "unix" && !hasClus) {
perm <- do.call(rbind,
- mclapply(1:permutations,
+ parallel::mclapply(1:permutations,
function(i, ...) ptest(permat[i,],...),
mc.cores = parallel))
} else {
if (!hasClus) {
- parallel <- makeCluster(parallel)
+ parallel <- parallel::makeCluster(parallel)
}
- perm <- parRapply(parallel, permat, ptest)
+ perm <- parallel::parRapply(parallel, permat, ptest)
if (!hasClus)
- stopCluster(parallel)
+ parallel::stopCluster(parallel)
}
} else {
perm <- sapply(1:permutations, function(i, ...) ptest(permat[i,], ...))
Modified: pkg/vegan/R/mantel.partial.R
===================================================================
--- pkg/vegan/R/mantel.partial.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/mantel.partial.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -45,19 +45,19 @@
if (is.null(parallel))
parallel <- 1
hasClus <- inherits(parallel, "cluster")
- if ((hasClus || parallel > 1) && require(parallel)) {
+ if (hasClus || parallel > 1) {
if(.Platform$OS.type == "unix" && !hasClus) {
perm <- do.call(rbind,
- mclapply(1:permutations,
+ parallel::mclapply(1:permutations,
function(i, ...) ptest(permat[i,],...),
mc.cores = parallel))
} else {
if (!hasClus) {
- parallel <- makeCluster(parallel)
+ parallel <- parallel::makeCluster(parallel)
}
- perm <- parRapply(parallel, permat, ptest)
+ perm <- parallel::parRapply(parallel, permat, ptest)
if (!hasClus)
- stopCluster(parallel)
+ parallel::stopCluster(parallel)
}
} else {
perm <- sapply(1:permutations, function(i, ...) ptest(permat[i,], ...))
Modified: pkg/vegan/R/metaMDSiter.R
===================================================================
--- pkg/vegan/R/metaMDSiter.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/metaMDSiter.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -74,11 +74,11 @@
if (is.null(parallel))
parallel <- 1
hasClus <- inherits(parallel, "cluster")
- isParal <- (hasClus || parallel > 1) && require(parallel)
+ isParal <- hasClus || parallel > 1
isMulticore <- .Platform$OS.type == "unix" && !hasClus
if (isParal && !isMulticore && !hasClus) {
- parallel <- makeCluster(parallel)
- clusterEvalQ(parallel, library(vegan))
+ parallel <-parallel:: makeCluster(parallel)
+ parallel::clusterEvalQ(parallel, library(vegan))
}
## get the number of clusters
if (inherits(parallel, "cluster"))
@@ -92,7 +92,7 @@
if (isParal) {
if (isMulticore) {
stry <-
- mclapply(1:nclus, function(i)
+ parallel::mclapply(1:nclus, function(i)
switch(engine,
"monoMDS" = monoMDS(dist, init[,,i], k = k,
maxit = maxit, ...),
@@ -102,7 +102,7 @@
mc.cores = parallel)
} else {
stry <-
- parLapply(parallel, 1:nclus, function(i)
+ parallel::parLapply(parallel, 1:nclus, function(i)
switch(engine,
"monoMDS" = monoMDS(dist, init[,,i], k = k,
maxit = maxit, ...),
@@ -150,7 +150,7 @@
}
## stop socket cluster
if (isParal && !isMulticore && !hasClus)
- stopCluster(parallel)
+ parallel::stopCluster(parallel)
if (!missing(previous.best) && inherits(previous.best, "metaMDS")) {
tries <- tries + previous.best$tries
}
Modified: pkg/vegan/R/mrpp.R
===================================================================
--- pkg/vegan/R/mrpp.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/mrpp.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -52,19 +52,19 @@
if (is.null(parallel))
parallel <- 1
hasClus <- inherits(parallel, "cluster")
- if ((hasClus || parallel > 1) && require(parallel)) {
+ if (hasClus || parallel > 1) {
if(.Platform$OS.type == "unix" && !hasClus) {
- m.ds <- unlist(mclapply(1:permutations, function(i, ...)
+ m.ds <- unlist(parallel::mclapply(1:permutations, function(i, ...)
mrpp.perms(perms[,i], dmat, indls, w),
mc.cores = parallel))
} else {
if (!hasClus) {
- parallel <- makeCluster(parallel)
+ parallel <- parallel::makeCluster(parallel)
}
- m.ds <- parCapply(parallel, perms, function(x)
+ m.ds <- parallel::parCapply(parallel, perms, function(x)
mrpp.perms(x, dmat, indls, w))
if (!hasClus)
- stopCluster(parallel)
+ parallel::stopCluster(parallel)
}
} else {
m.ds <- apply(perms, 2, function(x) mrpp.perms(x, dmat, indls, w))
Modified: pkg/vegan/R/oecosimu.R
===================================================================
--- pkg/vegan/R/oecosimu.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/oecosimu.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -90,13 +90,13 @@
if (is.null(parallel))
parallel <- 1
hasClus <- inherits(parallel, "cluster")
- if ((hasClus || parallel > 1) && require(parallel)) {
+ if (hasClus || parallel > 1) {
if(.Platform$OS.type == "unix" && !hasClus) {
for (i in seq_len(nbatch)) {
## simulate if no simmat_in
if(!simmat_in)
x <- simulate(nm, nsim = batches[i], thin = thin)
- tmp <- mclapply(seq_len(batches[i]),
+ tmp <- parallel::mclapply(seq_len(batches[i]),
function(j)
applynestfun(x[,,j], fun=nestfun,
statistic = statistic, ...),
@@ -106,20 +106,20 @@
} else {
## if hasClus, do not set up and stop a temporary cluster
if (!hasClus) {
- parallel <- makeCluster(parallel)
+ parallel <- parallel::makeCluster(parallel)
## make vegan functions available: others may be unavailable
- clusterEvalQ(parallel, library(vegan))
+ parallel::clusterEvalQ(parallel, library(vegan))
}
for(i in seq_len(nbatch)) {
if (!simmat_in)
x <- simulate(nm, nsim = batches[i], thin = thin)
simind <- cbind(simind,
- parApply(parallel, x, 3, function(z)
+ parallel::parApply(parallel, x, 3, function(z)
applynestfun(z, fun = nestfun,
statistic = statistic, ...)))
}
if (!hasClus)
- stopCluster(parallel)
+ parallel::stopCluster(parallel)
}
} else {
for(i in seq_len(nbatch)) {
Modified: pkg/vegan/R/ordiareatest.R
===================================================================
--- pkg/vegan/R/ordiareatest.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/ordiareatest.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -30,19 +30,19 @@
if (is.null(parallel))
parallel <- 1
hasClus <- inherits(parallel, "cluster")
- if ((hasClus || parallel > 1) && require(parallel)) {
+ if (hasClus || parallel > 1) {
if(.Platform$OS.type == "unix" && !hasClus) {
areas <- do.call(cbind,
- mclapply(1:permutations,
+ parallel::mclapply(1:permutations,
function(i, ...) pfun(perm[i,],...),
mc.cores = parallel))
} else {
if (!hasClus) {
- parallel <- makeCluster(parallel)
+ parallel <- parallel::makeCluster(parallel)
}
- areas <- parApply(parallel, perm, MARGIN=1, pfun)
+ areas <- parallel::parApply(parallel, perm, MARGIN=1, pfun)
if (!hasClus)
- stopCluster(parallel)
+ parallel::stopCluster(parallel)
}
} else {
areas <- sapply(1:permutations, function(i, ...) pfun(perm[i,], ...))
Modified: pkg/vegan/R/orditkplot.R
===================================================================
--- pkg/vegan/R/orditkplot.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/orditkplot.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -8,7 +8,7 @@
{
if (!capabilities("tcltk"))
stop("Your R has no capability for Tcl/Tk")
- require(tcltk) || stop("requires package tcltk")
+ requireNamespace("tcltk") || stop("requires package tcltk")
############################
### Check and sanitize input
Modified: pkg/vegan/R/permutest.betadisper.R
===================================================================
--- pkg/vegan/R/permutest.betadisper.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/permutest.betadisper.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -81,20 +81,21 @@
parallel <- 1
}
hasClus <- inherits(parallel, "cluster")
- if ((hasClus || parallel > 1L) && requireNamespace("parallel")) {
+ if (hasClus || parallel > 1L) {
if (.Platform$OS.type == "unix" && !hasClus) {
Pstats <- do.call("rbind",
- mclapply(seq_len(nperm),
+ parallel::mclapply(seq_len(nperm),
function(x) permFun(permutations[x, , drop = FALSE]),
mc.cores = parallel))
} else {
## if hasClus, don't set up and top a temporary cluster
if (!hasClus) {
- parallel <- makeCluster(parallel)
+ parallel <- parallel::makeCluster(parallel)
}
- Pstats <- parRapply(parallel, permutations, function(x) permFun(x))
+ Pstats <- parallel::parRapply(parallel, permutations,
+ function(x) permFun(x))
if (!hasClus) {
- stopCluster(parallel)
+ parallel::stopCluster(parallel)
}
}
} else {
Modified: pkg/vegan/R/permutest.cca.R
===================================================================
--- pkg/vegan/R/permutest.cca.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/permutest.cca.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -117,21 +117,21 @@
if (is.null(parallel))
parallel <- 1
hasClus <- inherits(parallel, "cluster")
- if ((hasClus || parallel > 1) && require(parallel)) {
+ if (hasClus || parallel > 1) {
if(.Platform$OS.type == "unix" && !hasClus) {
tmp <- do.call(rbind,
- mclapply(1:nperm,
+ parallel::mclapply(1:nperm,
function(i) getF(permutations[i,]),
mc.cores = parallel))
} else {
## if hasClus, do not set up and stop a temporary cluster
if (!hasClus) {
- parallel <- makeCluster(parallel)
+ parallel <- parallel::makeCluster(parallel)
}
- tmp <- parRapply(parallel, permutations, function(i) getF(i))
+ tmp <- parallel::parRapply(parallel, permutations, function(i) getF(i))
tmp <- matrix(tmp, ncol=3, byrow=TRUE)
if (!hasClus)
- stopCluster(parallel)
+ parallel::stopCluster(parallel)
}
} else {
tmp <- getF(permutations)
Modified: pkg/vegan/R/poolaccum.R
===================================================================
--- pkg/vegan/R/poolaccum.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/poolaccum.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -5,15 +5,18 @@
n <- nrow(x)
m <- ncol(x)
N <- seq_len(n)
+ ## specpool() is slow, but the vectorized versions below are
+ ## pretty fast. We do not set up parallel processing, but use
+ ## permute API.
+ permat <- getPermuteMatrix(permutations, n)
+ nperm <- nrow(permat)
S <- chao <- boot <- jack1 <- jack2 <-
- matrix(0, nrow=n, ncol=permutations)
- ## specpool() is slow, but the vectorized versions below are
- ## pretty fast
- for (i in 1:permutations) {
+ matrix(0, nrow=n, ncol=nperm)
+ for (i in 1:nperm) {
## It is a bad practice to replicate specpool equations here:
## if we change specpool, this function gets out of sync. You
## should be ashamed, Jari Oksanen!
- take <- sample.int(n, n)
+ take <- permat[i,]
tmp <- apply(x[take,] > 0, 2, cumsum)
S[,i] <- rowSums(tmp > 0)
## All-zero species are taken as *known* to be missing in
@@ -36,6 +39,7 @@
out <- list(S = S[take,], chao = chao[take,], jack1 = jack1[take,],
jack2 = jack2[take,], boot = boot[take,], N = N[take],
means = means[take,])
+ attr(out, "control") <- attr(permat, "control")
class(out) <- "poolaccum"
out
}
Modified: pkg/vegan/R/renyiaccum.R
===================================================================
--- pkg/vegan/R/renyiaccum.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/renyiaccum.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -10,14 +10,15 @@
if (p==1) {
x <- t(x)
n <- nrow(x)
- p <- ncol(x)
+ p <- ncol(x)
}
+ pmat <- getPermuteMatrix(permutations, n)
m <- length(scales)
result <- array(dim=c(n,m,permutations))
dimnames(result) <- list(pooled.sites=c(1:n), scale=scales,
permutation=c(1:permutations))
for (k in 1:permutations) {
- result[,,k] <- as.matrix(renyi((apply(x[sample(n),],2,cumsum)),
+ result[,,k] <- as.matrix(renyi((apply(x[pmat[k,],],2,cumsum)),
scales=scales, ...))
}
if (raw)
@@ -47,6 +48,7 @@
scale=scales,
c("mean", "stdev", "min", "max", "Qnt 0.025", "Qnt 0.975", if (collector) "Collector"))
}
+ attr(result, "control") <- attr(pmat, "control")
class(result) <- c("renyiaccum", class(result))
result
}
Modified: pkg/vegan/R/simper.R
===================================================================
--- pkg/vegan/R/simper.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/simper.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -1,12 +1,12 @@
`simper` <-
- function(comm, group, permutations = 0, trace = FALSE,
+ function(comm, group, permutations = 0, trace = FALSE,
parallel = getOption("mc.cores"), ...)
{
- if (any(rowSums(comm, na.rm = TRUE) == 0))
+ if (any(rowSums(comm, na.rm = TRUE) == 0))
warning("you have empty rows: results may be meaningless")
pfun <- function(x, comm, comp, i, contrp) {
groupp <- group[perm[x,]]
- ga <- comm[groupp == comp[i, 1], , drop = FALSE]
+ ga <- comm[groupp == comp[i, 1], , drop = FALSE]
gb <- comm[groupp == comp[i, 2], , drop = FALSE]
n.a <- nrow(ga)
n.b <- nrow(gb)
@@ -14,7 +14,7 @@
for(k in seq_len(n.a)) {
mdp <- abs(ga[k, , drop = FALSE] - gb[j, , drop = FALSE])
mep <- ga[k, , drop = FALSE] + gb[j, , drop = FALSE]
- contrp[(j-1)*n.a+k, ] <- mdp / sum(mep)
+ contrp[(j-1)*n.a+k, ] <- mdp / sum(mep)
}
}
colMeans(contrp)
@@ -39,10 +39,10 @@
if (is.null(parallel))
parallel <- 1
hasClus <- inherits(parallel, "cluster")
- isParal <- (hasClus || parallel > 1) && require(parallel)
+ isParal <- hasClus || parallel > 1
isMulticore <- .Platform$OS.type == "unix" && !hasClus
if (isParal && !isMulticore && !hasClus) {
- parallel <- makeCluster(parallel)
+ parallel <- parallel::makeCluster(parallel)
}
for (i in seq_len(nrow(comp))) {
group.a <- comm[group == comp[i, 1], , drop = FALSE]
@@ -54,11 +54,11 @@
for (k in seq_len(n.a)) {
md <- abs(group.a[k, , drop = FALSE] - group.b[j, , drop = FALSE])
me <- group.a[k, , drop = FALSE] + group.b[j, , drop = FALSE]
- contr[(j-1)*n.a+k, ] <- md / sum(me)
+ contr[(j-1)*n.a+k, ] <- md / sum(me)
}
}
average <- colMeans(contr)
-
+
## Apply permutations
if(nperm > 0){
if (trace)
@@ -67,28 +67,28 @@
if (isParal) {
if (isMulticore){
- perm.contr <- mclapply(seq_len(nperm), function(d)
+ perm.contr <- parallel::mclapply(seq_len(nperm), function(d)
pfun(d, comm, comp, i, contrp), mc.cores = parallel)
perm.contr <- do.call(cbind, perm.contr)
} else {
- perm.contr <- parSapply(parallel, seq_len(nperm), function(d)
+ perm.contr <- parallel::parSapply(parallel, seq_len(nperm), function(d)
pfun(d, comm, comp, i, contrp))
- }
+ }
} else {
- perm.contr <- sapply(1:nperm, function(d)
+ perm.contr <- sapply(1:nperm, function(d)
pfun(d, comm, comp, i, contrp))
}
p <- (rowSums(apply(perm.contr, 2, function(x) x >= average)) + 1) / (nperm + 1)
- }
+ }
else {
p <- NULL
}
-
+
overall <- sum(average)
sdi <- apply(contr, 2, sd)
ratio <- average / sdi
ava <- colMeans(group.a)
- avb <- colMeans(group.b)
+ avb <- colMeans(group.b)
ord <- order(average, decreasing = TRUE)
cusum <- cumsum(average[ord] / overall)
out <- list(species = colnames(comm), average = average,
@@ -98,7 +98,7 @@
}
## Close socket cluster if created here
if (isParal && !isMulticore && !hasClus)
- stopCluster(parallel)
+ parallel::stopCluster(parallel)
attr(outlist, "permutations") <- nperm
attr(outlist, "control") <- attr(perm, "control")
class(outlist) <- "simper"
@@ -111,7 +111,7 @@
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)) {
+ for (i in seq_along(cusum)) {
names(cusum[[i]]) <- spec[[i]]
}
## this probably fails with empty or identical groups that have 0/0 = NaN
@@ -124,20 +124,20 @@
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,
+ 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)) {
+ for(i in seq_along(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(cbind(contr = z$average, sd = z$sd, 'contr/sd' = z$ratio,
+ out <- lapply(object, function(z)
+ data.frame(cbind(contr = z$average, sd = z$sd, 'contr/sd' = z$ratio,
ava = z$ava, avb = z$avb, p = z$p)))
}
attr(out, "digits") <- digits
Modified: pkg/vegan/R/specaccum.R
===================================================================
--- pkg/vegan/R/specaccum.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/specaccum.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -31,14 +31,10 @@
xout <- weights <- cumsum(w)
specaccum <- accumulator(x, sites)
}, random = {
- perm <- array(dim = c(n, permutations))
+ permat <- getPermuteMatrix(permutations, n)
+ perm <- apply(permat, 1, accumulator, x = x)
if (!is.null(w))
- weights <- array(dim = c(n, permutations))
- for (i in 1:permutations) {
- perm[, i] <- accumulator(x, ord <- sample(n))
- if(!is.null(w))
- weights[,i] <- cumsum(w[ord])
- }
+ weights <- apply(permat, 1, function(i) cumsum(w[i]))
sites <- 1:n
if (is.null(w)) {
specaccum <- apply(perm, 1, mean)
@@ -113,6 +109,8 @@
}
if (method == "rarefaction")
out$individuals <- ind
+ if (method == "random")
+ attr(out, "control") <- attr(permat, "control")
class(out) <- "specaccum"
out
}
Modified: pkg/vegan/R/tsallisaccum.R
===================================================================
--- pkg/vegan/R/tsallisaccum.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/tsallisaccum.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -1,6 +1,6 @@
-tsallisaccum <-
-function (x, scales = seq(0, 2, 0.2), permutations = 100, raw = FALSE,
- subset, ...)
+`tsallisaccum` <-
+ function (x, scales = seq(0, 2, 0.2), permutations = 100, raw = FALSE,
+ subset, ...)
{
if (!missing(subset))
x <- subset(x, subset)
@@ -12,12 +12,13 @@
n <- nrow(x)
p <- ncol(x)
}
+ pmat <- getPermuteMatrix(permutations, n)
m <- length(scales)
result <- array(dim = c(n, m, permutations))
dimnames(result) <- list(pooled.sites = c(1:n), scale = scales,
permutation = c(1:permutations))
for (k in 1:permutations) {
- result[, , k] <- as.matrix(tsallis((apply(x[sample(n),
+ result[, , k] <- as.matrix(tsallis((apply(x[pmat[k,],
], 2, cumsum)), scales = scales, ...))
}
if (raw) {
@@ -43,6 +44,7 @@
dimnames(result) <- list(pooled.sites = c(1:n), scale = scales,
c("mean", "stdev", "min", "max", "Qnt 0.025", "Qnt 0.975"))
}
+ attr(result, "control") <- attr(pmat, "control")
class(result) <- c("tsallisaccum", "renyiaccum", class(result))
result
}
Modified: pkg/vegan/R/vegandocs.R
===================================================================
--- pkg/vegan/R/vegandocs.R 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/R/vegandocs.R 2015-01-07 13:01:37 UTC (rev 2924)
@@ -1,5 +1,5 @@
`vegandocs` <-
- function (doc = c("NEWS", "ONEWS", "ChangeLog", "FAQ-vegan.pdf",
+ function (doc = c("NEWS", "ONEWS", "FAQ-vegan.pdf",
"intro-vegan.pdf", "diversity-vegan.pdf",
"decision-vegan.pdf", "partitioning.pdf", "permutations.pdf"))
{
Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog 2014-12-30 15:55:45 UTC (rev 2923)
+++ pkg/vegan/inst/ChangeLog 2015-01-07 13:01:37 UTC (rev 2924)
@@ -1,5 +1,16 @@
VEGAN DEVEL VERSIONS at https://github.com/vegandevs/vegan
+ ChangeLog provided a detailed development history of vegan, but it
+ is not updated after September 11, 2014. Vegan moved to git source
+ code management and linear ChangeLog is poorly suited for
+ branching git development. Use git log to track the history in
+ your current branch. The main upstream repository of vegan is
+ currently https://github.com/vegandevs/vegan.
+
+ ChangeLog gave technical details and was mainly provided for vegan
+ developers. Most important user-visible changes are listed in the
+ NEWS of the current release and its patched version.
+
Version 2.1-43 (opened September 11, 2014)
* cca, rda, capscale: remove u.eig, v.eig and wa.eig items or
Modified: pkg/vegan/inst/NEWS.Rd
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/vegan -r 2924
More information about the Vegan-commits
mailing list