[Vegan-commits] r2950 - in pkg/vegan: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon May 25 08:52:06 CEST 2015
Author: jarioksa
Date: 2015-05-25 08:52:06 +0200 (Mon, 25 May 2015)
New Revision: 2950
Modified:
pkg/vegan/DESCRIPTION
pkg/vegan/R/CCorA.R
pkg/vegan/R/MDSrotate.R
pkg/vegan/R/adipart.default.R
pkg/vegan/R/anova.ccabyterm.R
pkg/vegan/R/betadiver.R
pkg/vegan/R/cca.default.R
pkg/vegan/R/estimateR.default.R
pkg/vegan/R/factorfit.R
pkg/vegan/R/make.commsim.R
pkg/vegan/R/multipart.default.R
pkg/vegan/R/nesteddisc.R
pkg/vegan/R/nestedtemp.R
pkg/vegan/R/permustats.R
pkg/vegan/R/plot.cca.R
pkg/vegan/R/plot.meandist.R
pkg/vegan/R/plot.radfit.frame.R
pkg/vegan/R/print.varpart.R
pkg/vegan/R/print.varpart234.R
pkg/vegan/R/rankindex.R
pkg/vegan/R/rarecurve.R
pkg/vegan/R/rda.default.R
pkg/vegan/R/read.cep.R
pkg/vegan/R/scores.cca.R
pkg/vegan/R/scores.ordihull.R
pkg/vegan/R/scores.rda.R
pkg/vegan/R/summary.anosim.R
pkg/vegan/R/summary.bioenv.R
pkg/vegan/R/summary.cca.R
pkg/vegan/R/summary.radfit.frame.R
pkg/vegan/R/varpart.R
pkg/vegan/R/vegemite.R
pkg/vegan/README.md
pkg/vegan/inst/NEWS.Rd
pkg/vegan/man/permustats.Rd
Log:
Merge branch 'cran-2.3' into r-forge-svn-local
Modified: pkg/vegan/DESCRIPTION
===================================================================
--- pkg/vegan/DESCRIPTION 2015-05-21 10:07:59 UTC (rev 2949)
+++ pkg/vegan/DESCRIPTION 2015-05-25 06:52:06 UTC (rev 2950)
@@ -1,7 +1,7 @@
Package: vegan
Title: Community Ecology Package
-Version: 2.2-2
-Date: 2015-01-12
+Version: 2.3-0
+Date: 2015-05-21
Author: Jari Oksanen, F. Guillaume Blanchet, Roeland Kindt, Pierre Legendre,
Peter R. Minchin, R. B. O'Hara, Gavin L. Simpson, Peter Solymos,
M. Henry H. Stevens, Helene Wagner
Modified: pkg/vegan/R/CCorA.R
===================================================================
--- pkg/vegan/R/CCorA.R 2015-05-21 10:07:59 UTC (rev 2949)
+++ pkg/vegan/R/CCorA.R 2015-05-25 06:52:06 UTC (rev 2950)
@@ -98,7 +98,7 @@
qq <- temp$m
rownames(X) <- rownoms
## Correction PL, 26dec10
- if(max(pp,qq) >= (n-1))
+ if(max(pp,qq) >= (n-1))
stop("Not enough degrees of freedom: max(pp,qq) >= (n-1)")
## Covariance matrices, etc. from the PCA scores
S11 <- cov(Y)
@@ -120,7 +120,7 @@
if((p == q) & (var(K.svd$d) < epsilon))
cat("Warning: [nearly] circular covariance matrix. The solution may be meaningless.",'\n')
## K.svd$u %*% diag(K.svd$d) %*% t(K.svd$v) # To check that K = U D V'
- axenames <- paste("CanAxis",1:length(K.svd$d),sep="")
+ axenames <- paste("CanAxis",seq_along(K.svd$d),sep="")
U <- K.svd$u
V <- K.svd$v
A <- S11.chol.inv %*% U
@@ -134,7 +134,7 @@
corr.X.Cx <- cor(X.c, Cx) # To plot X in biplot in space X
## Add row and column names
rownames(Cy) <- rownames(Cx) <- rownoms
- colnames(Cy) <- colnames(Cx) <- axenames
+ colnames(Cy) <- colnames(Cx) <- axenames
rownames(corr.Y.Cy) <- rownames(corr.Y.Cx) <- Ynoms
rownames(corr.X.Cy) <- rownames(corr.X.Cx) <- Xnoms
colnames(corr.Y.Cy) <- colnames(corr.Y.Cx) <- axenames
@@ -163,20 +163,20 @@
ncol(permat), n))
if (nperm > 0) {
- p.perm <- sapply(1:nperm, function(indx, ...)
+ p.perm <- sapply(seq_len(nperm), function(indx, ...)
probPillai(Y[permat[indx,],] , X, n, S11.inv, S22.inv, s,
df1, df2, epsilon, Fval, nperm, ...))
p.perm <- (sum(p.perm) +1)/(nperm + 1)
} else {
p.perm <- NA
}
-
+
out <- list(Pillai=PillaiTrace, Eigenvalues=Eigenvalues, CanCorr=K.svd$d,
- Mat.ranks=c(RsquareX.Y$m, RsquareY.X$m),
+ Mat.ranks=c(RsquareX.Y$m, RsquareY.X$m),
RDA.Rsquares=c(RsquareY.X$Rsquare, RsquareX.Y$Rsquare),
RDA.adj.Rsq=c(Rsquare.adj.Y.X, Rsquare.adj.X.Y),
- nperm=nperm, p.Pillai=p.Pillai, p.perm=p.perm, Cy=Cy, Cx=Cx,
- corr.Y.Cy=corr.Y.Cy, corr.X.Cx=corr.X.Cx, corr.Y.Cx=corr.Y.Cx,
+ nperm=nperm, p.Pillai=p.Pillai, p.perm=p.perm, Cy=Cy, Cx=Cx,
+ corr.Y.Cy=corr.Y.Cy, corr.X.Cx=corr.X.Cx, corr.Y.Cx=corr.Y.Cx,
corr.X.Cy=corr.X.Cy, control = attr(permat, "control"),
call = match.call())
class(out) <- "CCorA"
Modified: pkg/vegan/R/MDSrotate.R
===================================================================
--- pkg/vegan/R/MDSrotate.R 2015-05-21 10:07:59 UTC (rev 2949)
+++ pkg/vegan/R/MDSrotate.R 2015-05-25 06:52:06 UTC (rev 2950)
@@ -3,7 +3,7 @@
`MDSrotate` <-
function(object, vec, na.rm = FALSE, ...)
{
- workswith <- c("metaMDS", "monoMDS")
+ workswith <- c("metaMDS", "monoMDS", "GO")
if (!inherits(object, workswith))
stop(gettextf("function works only with the results of: %s",
paste(workswith, collapse = ", ")))
Modified: pkg/vegan/R/adipart.default.R
===================================================================
--- pkg/vegan/R/adipart.default.R 2015-05-21 10:07:59 UTC (rev 2949)
+++ pkg/vegan/R/adipart.default.R 2015-05-25 06:52:06 UTC (rev 2950)
@@ -32,7 +32,7 @@
rval[[i]] <- interaction(rhs[,nCol], rval[[(i-1)]], drop=TRUE)
nCol <- nCol - 1
}
- rval <- as.data.frame(rval[rev(1:length(rval))])
+ rval <- as.data.frame(rval[rev(seq_along(rval))])
l2 <- sapply(rval, function(z) length(unique(z)))
if (any(l1 != l2))
stop("levels are not perfectly nested")
@@ -41,7 +41,7 @@
fullgamma <-if (nlevels(rhs[,nlevs]) == 1)
TRUE else FALSE
ftmp <- vector("list", nlevs)
- for (i in 1:nlevs) {
+ for (i in seq_len(nlevs)) {
ftmp[[i]] <- as.formula(paste("~", tlab[i], "- 1"))
}
@@ -71,16 +71,16 @@
## matrix sum *can* change in oecosimu (but default is constant sumMatr)
sumMatr <- sum(x)
if (fullgamma) {
- tmp <- lapply(1:(nlevs-1), function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
+ tmp <- lapply(seq_len(nlevs-1), function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
tmp[[nlevs]] <- matrix(colSums(x), nrow = 1, ncol = ncol(x))
} else {
- tmp <- lapply(1:nlevs, function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
+ tmp <- lapply(seq_len(nlevs), function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
}
## weights will change in oecosimu thus need to be recalculated
if (weights == "prop")
- wt <- lapply(1:nlevs, function(i) apply(tmp[[i]], 1, function(z) sum(z) / sumMatr))
- else wt <- lapply(1:nlevs, function(i) rep(1 / NROW(tmp[[i]]), NROW(tmp[[i]])))
- a <- sapply(1:nlevs, function(i) sum(divfun(tmp[[i]]) * wt[[i]]))
+ wt <- lapply(seq_len(nlevs), function(i) apply(tmp[[i]], 1, function(z) sum(z) / sumMatr))
+ else wt <- lapply(seq_len(nlevs), function(i) rep(1 / NROW(tmp[[i]]), NROW(tmp[[i]])))
+ a <- sapply(seq_len(nlevs), function(i) sum(divfun(tmp[[i]]) * wt[[i]]))
if (relative)
a <- a / a[length(a)]
b <- sapply(2:nlevs, function(i) a[i] - a[(i-1)])
@@ -95,8 +95,8 @@
sim <- list(statistic = sim,
oecosimu = list(z = tmp, pval = tmp, method = NA, statistic = sim))
}
- nam <- c(paste("alpha", 1:(nlevs-1), sep="."), "gamma",
- paste("beta", 1:(nlevs-1), sep="."))
+ nam <- c(paste("alpha", seq_len(nlevs-1), sep="."), "gamma",
+ paste("beta", seq_len(nlevs-1), sep="."))
names(sim$statistic) <- attr(sim$oecosimu$statistic, "names") <- nam
call <- match.call()
call[[1]] <- as.name("adipart")
Modified: pkg/vegan/R/anova.ccabyterm.R
===================================================================
--- pkg/vegan/R/anova.ccabyterm.R 2015-05-21 10:07:59 UTC (rev 2949)
+++ pkg/vegan/R/anova.ccabyterm.R 2015-05-25 06:52:06 UTC (rev 2950)
@@ -137,7 +137,7 @@
fla <- reformulate(names(LC))
Pvals <- rep(NA, length(eig))
environment(object$terms) <- environment()
- for (i in 1:length(eig)) {
+ for (i in seq_along(eig)) {
part <- paste("~ . +Condition(",
paste(names(LC)[-i], collapse = "+"), ")")
upfla <- update(fla, part)
Modified: pkg/vegan/R/betadiver.R
===================================================================
--- pkg/vegan/R/betadiver.R 2015-05-21 10:07:59 UTC (rev 2949)
+++ pkg/vegan/R/betadiver.R 2015-05-25 06:52:06 UTC (rev 2950)
@@ -27,7 +27,7 @@
"z"="(log(2)-log(2*a+b+c)+log(a+b+c))/log(2)"
)
if (help) {
- for (i in 1:length(beta))
+ for (i in seq_along(beta))
writeLines(strwrap(paste(i, " \"", names(beta[i]),
"\" = ", beta[[i]], "\n", sep="")))
return(invisible(NULL))
Modified: pkg/vegan/R/cca.default.R
===================================================================
--- pkg/vegan/R/cca.default.R 2015-05-21 10:07:59 UTC (rev 2949)
+++ pkg/vegan/R/cca.default.R 2015-05-25 06:52:06 UTC (rev 2950)
@@ -1,5 +1,5 @@
`cca.default` <-
- function (X, Y, Z, ...)
+ function (X, Y, Z, ...)
{
ZERO <- 1e-04
CCA <- NULL
@@ -18,7 +18,7 @@
isTRUE(all.equal(X, t(X))))
stop("function cannot be used with (dis)similarities")
X <- as.matrix(X)
- if (any(rowSums(X) <= 0))
+ if (any(rowSums(X) <= 0))
stop("All row sums must be >0 in the community data matrix")
if (any(tmp <- colSums(X) <= 0)) {
exclude.spec <- seq(along=tmp)[tmp]
@@ -40,7 +40,7 @@
Z <- qr.fitted(Q, Xbar)
tmp <- sum(svd(Z, nu = 0, nv = 0)$d^2)
if (Q$rank) {
- pCCA <- list(rank = Q$rank, tot.chi = tmp, QR = Q,
+ pCCA <- list(rank = Q$rank, tot.chi = tmp, QR = Q,
Fit = Z, envcentre = attr(Z.r, "centre"))
Xbar <- qr.resid(Q, Xbar)
}
@@ -52,7 +52,7 @@
Y <- as.matrix(Y)
Y.r <- weight.centre(Y, rowsum)
Q <- qr(cbind(Z.r, Y.r), tol = ZERO)
- if (is.null(pCCA))
+ if (is.null(pCCA))
rank <- Q$rank
else rank <- Q$rank - pCCA$rank
## save rank of constraints
@@ -61,7 +61,7 @@
sol <- svd(Y)
## rank of svd can be < qrank
rank <- min(rank, sum(sol$d > ZERO))
- ax.names <- paste("CCA", 1:length(sol$d), sep = "")
+ ax.names <- paste("CCA", seq_along(sol$d), sep = "")
colnames(sol$u) <- ax.names
colnames(sol$v) <- ax.names
names(sol$d) <- ax.names
@@ -69,20 +69,20 @@
rownames(sol$v) <- colnames(X)
if (rank) {
CCA <- list(eig = sol$d[1:rank]^2)
- CCA$u <- sweep(as.matrix(sol$u[, 1:rank, drop = FALSE]),
+ CCA$u <- sweep(as.matrix(sol$u[, 1:rank, drop = FALSE]),
1, 1/sqrt(rowsum), "*")
- CCA$v <- sweep(as.matrix(sol$v[, 1:rank, drop = FALSE]),
+ CCA$v <- sweep(as.matrix(sol$v[, 1:rank, drop = FALSE]),
1, 1/sqrt(colsum), "*")
- wa.eig <- sweep(Xbar %*% sol$v[, 1:rank, drop = FALSE],
+ wa.eig <- sweep(Xbar %*% sol$v[, 1:rank, drop = FALSE],
1, 1/sqrt(rowsum), "*")
CCA$wa <- sweep(wa.eig, 2, 1/sol$d[1:rank], "*")
oo <- Q$pivot
- if (!is.null(pCCA$rank))
+ if (!is.null(pCCA$rank))
oo <- oo[-(1:pCCA$rank)] - ncol(Z.r)
oo <- oo[1:qrank]
- if (length(oo) < ncol(Y.r))
+ if (length(oo) < ncol(Y.r))
CCA$alias <- colnames(Y.r)[-oo]
- CCA$biplot <- cor(Y.r[, oo, drop = FALSE], sol$u[,
+ CCA$biplot <- cor(Y.r[, oo, drop = FALSE], sol$u[,
1:rank, drop = FALSE])
CCA$rank <- rank
CCA$qrank <- qrank
@@ -104,11 +104,11 @@
if (exists("exclude.spec")) {
attr(CCA$v, "na.action") <- exclude.spec
}
-
+
}
Q <- qr(Xbar)
sol <- svd(Xbar)
- ax.names <- paste("CA", 1:length(sol$d), sep = "")
+ ax.names <- paste("CA", seq_along(sol$d), sep = "")
colnames(sol$u) <- ax.names
colnames(sol$v) <- ax.names
names(sol$d) <- ax.names
@@ -116,15 +116,15 @@
rownames(sol$v) <- colnames(X)
rank <- min(Q$rank, sum(sol$d > ZERO))
if (rank) {
- CA <- list(eig = sol$d[1:rank]^2)
- CA$u <- sweep(as.matrix(sol$u[, 1:rank, drop = FALSE]),
+ CA <- list(eig = sol$d[seq_len(rank)]^2)
+ CA$u <- sweep(as.matrix(sol$u[, seq_len(rank), drop = FALSE]),
1, 1/sqrt(rowsum), "*")
- CA$v <- sweep(as.matrix(sol$v[, 1:rank, drop = FALSE]),
+ CA$v <- sweep(as.matrix(sol$v[, seq_len(rank), drop = FALSE]),
1, 1/sqrt(colsum), "*")
CA$rank <- rank
CA$tot.chi <- sum(CA$eig)
CA$Xbar <- Xbar
-
+
} else { # zero rank: no residual component
CA <- list(eig = 0, rank = rank, tot.chi = 0,
Xbar = Xbar)
@@ -139,8 +139,8 @@
## computed pCCA$rank was needed before, but zero it here
if (!is.null(pCCA) && pCCA$tot.chi == 0)
pCCA$rank <- 0
- sol <- list(call = call, grand.total = gran.tot, rowsum = rowsum,
- colsum = colsum, tot.chi = tot.chi, pCCA = pCCA, CCA = CCA,
+ sol <- list(call = call, grand.total = gran.tot, rowsum = rowsum,
+ colsum = colsum, tot.chi = tot.chi, pCCA = pCCA, CCA = CCA,
CA = CA)
sol$method <- "cca"
sol$inertia <- "mean squared contingency coefficient"
Modified: pkg/vegan/R/estimateR.default.R
===================================================================
--- pkg/vegan/R/estimateR.default.R 2015-05-21 10:07:59 UTC (rev 2949)
+++ pkg/vegan/R/estimateR.default.R 2015-05-25 06:52:06 UTC (rev 2950)
@@ -76,7 +76,7 @@
sd.Chao1 <- sqrt(sd.Chao1)
C.ace <- 1 - a[1]/N.rare
- i <- 1:length(a)
+ i <- seq_along(a)
thing <- i * (i - 1) * a
Gam <- sum(thing) * S.rare/(C.ace * N.rare * (N.rare - 1)) -
1
Modified: pkg/vegan/R/factorfit.R
===================================================================
--- pkg/vegan/R/factorfit.R 2015-05-21 10:07:59 UTC (rev 2949)
+++ pkg/vegan/R/factorfit.R 2015-05-25 06:52:06 UTC (rev 2950)
@@ -1,5 +1,5 @@
`factorfit` <-
- function (X, P, permutations = 0, strata = NULL, w, ...)
+ function (X, P, permutations = 0, strata = NULL, w, ...)
{
P <- as.data.frame(P)
## Check that all variables are factors, and coerce if necessary
@@ -7,7 +7,7 @@
P <- data.frame(lapply(P, function(x)
if (is.factor(x)) x else factor(x)))
P <- droplevels(P) ## make sure only the used levels are present
- if (any(!sapply(P, is.factor)))
+ if (any(!sapply(P, is.factor)))
stop("All non-numeric variables must be factors")
NR <- nrow(X)
NC <- ncol(X)
@@ -19,7 +19,7 @@
r <- NULL
pval <- NULL
totvar <- .C("goffactor", as.double(X), as.integer(rep(0, NR)),
- as.double(w), as.integer(NR), as.integer(NC), as.integer(1),
+ as.double(w), as.integer(NR), as.integer(NC), as.integer(1),
double(1), double(1), double(1), var = double(1), PACKAGE = "vegan")$var
sol <- centroids.cca(X, P, w)
var.id <- rep(names(P), sapply(P, nlevels))
@@ -27,12 +27,12 @@
permat <- getPermuteMatrix(permutations, NR, strata = strata)
permutations <- nrow(permat)
- for (i in 1:length(P)) {
+ for (i in seq_along(P)) {
A <- as.integer(P[[i]])
NL <- nlevels(P[[i]])
invar <- .C("goffactor", as.double(X), as.integer(A - 1), as.double(w),
- as.integer(NR), as.integer(NC),
- as.integer(NL), double(NL), double(NL), double(NL),
+ as.integer(NR), as.integer(NC),
+ as.integer(NL), double(NL), double(NL), double(NL),
var = double(1), PACKAGE = "vegan")$var
r.this <- 1 - invar/totvar
r <- c(r, r.this)
@@ -43,24 +43,24 @@
take <- A[indx]
invar <- .C("goffactor", as.double(X),
as.integer(take - 1), as.double(w),
- as.integer(NR), as.integer(NC),
- as.integer(NL), double(NL), double(NL), double(NL),
+ as.integer(NR), as.integer(NC),
+ as.integer(NL), double(NL), double(NL), double(NL),
var = double(1), PACKAGE = "vegan")$var
1 - invar/totvar
}
- tmp <- sapply(1:permutations,
+ tmp <- sapply(seq_len(permutations),
function(indx,...) ptest(permat[indx,], ...))
pval.this <- (sum(tmp >= r.this) + 1)/(permutations + 1)
pval <- c(pval, pval.this)
}
}
- if (is.null(colnames(X)))
+ if (is.null(colnames(X)))
colnames(sol) <- paste("Dim", 1:ncol(sol), sep = "")
else colnames(sol) <- colnames(X)
names(r) <- names(P)
- if (!is.null(pval))
+ if (!is.null(pval))
names(pval) <- names(P)
- out <- list(centroids = sol, r = r, permutations = permutations,
+ out <- list(centroids = sol, r = r, permutations = permutations,
pvals = pval, var.id = var.id)
out$control <- attr(permat, "control")
class(out) <- "factorfit"
Modified: pkg/vegan/R/make.commsim.R
===================================================================
--- pkg/vegan/R/make.commsim.R 2015-05-21 10:07:59 UTC (rev 2949)
+++ pkg/vegan/R/make.commsim.R 2015-05-25 06:52:06 UTC (rev 2950)
@@ -4,9 +4,9 @@
## so it can be used instead of match.arg(method) in other functions
## NOTE: very very long -- but it can be a central repository of algos
## NOTE 2: storage mode coercions are avoided here
-## (with no apparent effect on speed), it should be
+## (with no apparent effect on speed), it should be
## handled by nullmodel and commsim characteristics
-make.commsim <-
+make.commsim <-
function(method)
{
algos <- list(
@@ -78,19 +78,19 @@
out <- array(unlist(r2dtable(n, rs, cs)), c(nr, nc, n))
storage.mode(out) <- "integer"
for (k in seq_len(n))
- out[,,k] <- .C("quasiswap",
+ out[,,k] <- .C("quasiswap",
m = out[,,k], nr, nc, PACKAGE = "vegan")$m
out
}),
- "swap" = commsim(method="swap", binary=TRUE, isSeq=TRUE,
+ "swap" = commsim(method="swap", binary=TRUE, isSeq=TRUE,
mode="integer",
fun=function(x, n, nr, nc, rs, cs, rf, cf, s, fill, thin) {
out <- array(0L, c(nr, nc, n))
- out[,,1] <- .C("swap",
+ out[,,1] <- .C("swap",
m = x, nr, nc, thin, PACKAGE = "vegan")$m
for (k in seq_len(n-1))
- out[,,k+1] <- .C("swap",
- m = out[,,k], nr, nc, thin,
+ out[,,k+1] <- .C("swap",
+ m = out[,,k], nr, nc, thin,
PACKAGE = "vegan")$m
out
}),
@@ -98,10 +98,10 @@
mode="integer",
fun=function(x, n, nr, nc, rs, cs, rf, cf, s, fill, thin) {
out <- array(0L, c(nr, nc, n))
- out[,,1] <- .C("trialswap",
+ out[,,1] <- .C("trialswap",
m = x, nr, nc, thin, PACKAGE = "vegan")$m
for (k in seq_len(n-1))
- out[,,k+1] <- .C("trialswap",
+ out[,,k+1] <- .C("trialswap",
m = out[,,k], nr, nc, thin, PACKAGE = "vegan")$m
out
}),
@@ -118,7 +118,7 @@
ij <- sample(free, prob = prob)
i <- (ij - 1)%%nr + 1
j <- (ij - 1)%/%nr + 1
- for (k in 1:length(ij)) {
+ for (k in seq_along(ij)) {
if (icount[i[k]] < rs[i[k]] && jcount[j[k]] < cs[j[k]]) {
out[ij[k]] <- 1L
icount[i[k]] <- icount[i[k]] + 1L
@@ -126,25 +126,25 @@
}
}
ndrop <- 1
- for (i in 1:10000) {
+ for (i in seq_len(10000)) {
oldout <- out
oldn <- sum(out)
drop <- sample(all[out == 1L], ndrop)
out[drop] <- 0L
candi <- outer(rowSums(out) < rs, colSums(out) < cs, "&") & out == 0L
while (sum(candi) > 0) {
- if (sum(candi) > 1)
+ if (sum(candi) > 1)
ij <- sample(all[candi], 1)
else ij <- all[candi]
out[ij] <- 1L
candi <- outer(rowSums(out) < rs, colSums(out) < cs, "&") & out == 0
}
- if (sum(out) >= fill)
+ if (sum(out) >= fill)
break
- if (oldn >= sum(out))
+ if (oldn >= sum(out))
ndrop <- min(ndrop + 1, 4)
else ndrop <- 1
- if (oldn > sum(out))
+ if (oldn > sum(out))
out <- oldout
}
out
@@ -165,10 +165,10 @@
mode="integer",
fun=function(x, n, nr, nc, cs, rs, rf, cf, s, fill, thin) {
out <- array(0L, c(nr, nc, n))
- out[,,1] <- .C("swapcount",
+ out[,,1] <- .C("swapcount",
m = x, nr, nc, thin, PACKAGE = "vegan")$m
for (k in seq_len(n-1))
- out[,,k+1] <- .C("swapcount",
+ out[,,k+1] <- .C("swapcount",
m = out[,,k], nr, nc, thin, PACKAGE = "vegan")$m
out
}),
@@ -178,7 +178,7 @@
out <- array(unlist(r2dtable(n, rs, cs)), c(nr, nc, n))
storage.mode(out) <- "integer"
for (k in seq_len(n))
- out[,,k] <- .C("rswapcount",
+ out[,,k] <- .C("rswapcount",
m = out[,,k], nr, nc, fill, PACKAGE = "vegan")$m
out
}),
@@ -189,7 +189,7 @@
out <- array(unlist(r2dtable(fill, rf, cf)), c(nr, nc, n))
storage.mode(out) <- "double"
for (k in seq_len(n)) {
- out[,,k] <- .C("quasiswap",
+ out[,,k] <- .C("quasiswap",
m = as.integer(out[,,k]), nr, nc, PACKAGE = "vegan")$m
out[,,k][out[,,k] > 0] <- sample(nz) # we assume that length(nz)>1
}
@@ -205,7 +205,7 @@
out <- array(unlist(r2dtable(fill, rf, cf)), c(nr, nc, n))
storage.mode(out) <- "integer"
for (k in seq_len(n)) {
- out[,,k] <- .C("quasiswap",
+ out[,,k] <- .C("quasiswap",
m = out[,,k], nr, nc, PACKAGE = "vegan")$m
out[,,k][out[,,k] > 0] <- indshuffle(nz - 1L) + 1L # we assume that length(nz)>1
}
@@ -218,7 +218,7 @@
storage.mode(out) <- "double"
I <- seq_len(nr)
for (k in seq_len(n)) {
- out[,,k] <- .C("quasiswap",
+ out[,,k] <- .C("quasiswap",
m = as.integer(out[,,k]), nr, nc, PACKAGE = "vegan")$m
for (i in I) {
nz <- x[i,][x[i,] > 0]
@@ -237,7 +237,7 @@
storage.mode(out) <- "double"
J <- seq_len(nc)
for (k in seq_len(n)) {
- out[,,k] <- .C("quasiswap",
+ out[,,k] <- .C("quasiswap",
m = as.integer(out[,,k]), nr, nc, PACKAGE = "vegan")$m
for (j in J) {
nz <- x[,j][x[,j] > 0]
@@ -259,7 +259,7 @@
out <- array(unlist(r2dtable(fill, rf, cf)), c(nr, nc, n))
storage.mode(out) <- "integer"
for (k in seq_len(n)) {
- out[,,k] <- .C("quasiswap",
+ out[,,k] <- .C("quasiswap",
m = out[,,k], nr, nc, PACKAGE = "vegan")$m
for (i in I) {
nz <- as.integer(x[i,][x[i,] > 0])
@@ -281,7 +281,7 @@
out <- array(unlist(r2dtable(fill, rf, cf)), c(nr, nc, n))
storage.mode(out) <- "integer"
for (k in seq_len(n)) {
- out[,,k] <- .C("quasiswap",
+ out[,,k] <- .C("quasiswap",
m = out[,,k], nr, nc, PACKAGE = "vegan")$m
for (j in J) {
nz <- as.integer(x[,j][x[,j] > 0])
@@ -297,10 +297,10 @@
mode="double",
fun=function(x, n, nr, nc, cs, rs, rf, cf, s, fill, thin) {
out <- array(0, c(nr, nc, n))
- out[,,1] <- .C("abuswap",
+ out[,,1] <- .C("abuswap",
m = x, nr, nc, thin, 1L, PACKAGE = "vegan")$m
for (k in seq_len(n-1))
- out[,,k+1] <- .C("abuswap",
+ out[,,k+1] <- .C("abuswap",
m = out[,,k], nr, nc, thin, 1L, PACKAGE = "vegan")$m
out
}),
@@ -308,10 +308,10 @@
mode="double",
fun=function(x, n, nr, nc, cs, rs, rf, cf, s, fill, thin) {
out <- array(0, c(nr, nc, n))
- out[,,1] <- .C("abuswap",
+ out[,,1] <- .C("abuswap",
m = x, nr, nc, thin, 0L, PACKAGE = "vegan")$m
for (k in seq_len(n-1))
- out[,,k+1] <- .C("abuswap",
+ out[,,k+1] <- .C("abuswap",
m = out[,,k], nr, nc, thin, 0L, PACKAGE = "vegan")$m
out
}),
Modified: pkg/vegan/R/multipart.default.R
===================================================================
--- pkg/vegan/R/multipart.default.R 2015-05-21 10:07:59 UTC (rev 2949)
+++ pkg/vegan/R/multipart.default.R 2015-05-25 06:52:06 UTC (rev 2950)
@@ -7,7 +7,7 @@
## evaluate formula
lhs <- as.matrix(y)
if (missing(x))
- x <- cbind(level_1=seq_len(nrow(lhs)),
+ x <- cbind(level_1=seq_len(nrow(lhs)),
leve_2=rep(1, nrow(lhs)))
rhs <- data.frame(x)
rhs[] <- lapply(rhs, as.factor)
@@ -20,7 +20,7 @@
if (any(lhs < 0))
stop("data matrix contains negative entries")
if (is.null(colnames(rhs)))
- colnames(rhs) <- paste("level", 1:nlevs, sep="_")
+ colnames(rhs) <- paste("level", seq_len(nlevs), sep="_")
tlab <- colnames(rhs)
## check proper design of the model frame
@@ -34,7 +34,7 @@
rval[[i]] <- interaction(rhs[,nCol], rval[[(i-1)]], drop=TRUE)
nCol <- nCol - 1
}
- rval <- as.data.frame(rval[rev(1:length(rval))])
+ rval <- as.data.frame(rval[rev(seq_along(rval))])
l2 <- sapply(rval, function(z) length(unique(z)))
if (any(l1 != l2))
stop("levels are not perfectly nested")
@@ -45,7 +45,7 @@
# if (!fullgamma && !global)
# warning("gamma diversity value might be meaningless")
ftmp <- vector("list", nlevs)
- for (i in 1:nlevs) {
+ for (i in seq_len(nlevs)) {
ftmp[[i]] <- as.formula(paste("~", tlab[i], "- 1"))
}
@@ -77,37 +77,39 @@
if (global) {
wdivfun <- function(x) {
if (fullgamma) {
- tmp <- lapply(1:(nlevs-1), function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
+ tmp <- lapply(seq_len(nlevs - 1),
+ function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
tmp[[nlevs]] <- matrix(colSums(x), nrow = 1, ncol = ncol(x))
} else {
- tmp <- lapply(1:nlevs, function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
+ tmp <- lapply(seq_len(nlevs),
+ function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
}
- raw <- sapply(1:nlevs, function(i) divfun(tmp[[i]]))
+ raw <- sapply(seq_len(nlevs), function(i) divfun(tmp[[i]]))
a <- sapply(raw, mean)
G <- a[nlevs]
- b <- sapply(1:(nlevs-1), function(i) G / a[i])
+ b <- sapply(seq_len(nlevs - 1), function(i) G / a[i])
if (relative)
- b <- b / sapply(raw[1:(nlevs-1)], length)
+ b <- b / sapply(raw[seq_len(nlevs - 1)], length)
c(a, b)
}
} else {
wdivfun <- function(x) {
if (fullgamma) {
- tmp <- lapply(1:(nlevs-1), function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
+ tmp <- lapply(seq_len(nlevs-1), function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
tmp[[nlevs]] <- matrix(colSums(x), nrow = 1, ncol = ncol(x))
} else {
- tmp <- lapply(1:nlevs, function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
+ tmp <- lapply(seq_len(nlevs), function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
}
- a <- sapply(1:nlevs, function(i) divfun(tmp[[i]]))
- am <- lapply(1:(nlevs-1), function(i) {
- sapply(1:length(unique(id[[i]])), function(ii) {
+ a <- sapply(seq_len(nlevs), function(i) divfun(tmp[[i]]))
+ am <- lapply(seq_len(nlevs - 1), function(i) {
+ sapply(seq_along(unique(id[[i]])), function(ii) {
mean(a[[i]][id[[i]]==ii])
})
})
- b <- lapply(1:(nlevs-1), function(i) a[[(i+1)]] / am[[i]])
+ b <- lapply(seq_len(nlevs - 1), function(i) a[[(i+1)]] / am[[i]])
bmax <- lapply(id, function(i) table(i))
if (relative)
- b <- lapply(1:(nlevs-1), function(i) b[[i]] / bmax[[i]])
+ b <- lapply(seq_len(nlevs - 1), function(i) b[[i]] / bmax[[i]])
c(sapply(a, mean), sapply(b, mean))
}
}
@@ -120,8 +122,8 @@
sim <- list(statistic = sim,
oecosimu = list(z = tmp, pval = tmp, method = NA, statistic = sim))
}
- nam <- c(paste("alpha", 1:(nlevs-1), sep="."), "gamma",
- paste("beta", 1:(nlevs-1), sep="."))
+ nam <- c(paste("alpha", seq_len(nlevs - 1), sep="."), "gamma",
+ paste("beta", seq_len(nlevs - 1), sep="."))
names(sim$statistic) <- attr(sim$oecosimu$statistic, "names") <- nam
call <- match.call()
call[[1]] <- as.name("multipart")
Modified: pkg/vegan/R/nesteddisc.R
===================================================================
--- pkg/vegan/R/nesteddisc.R 2015-05-21 10:07:59 UTC (rev 2949)
+++ pkg/vegan/R/nesteddisc.R 2015-05-25 06:52:06 UTC (rev 2950)
@@ -26,11 +26,11 @@
## Range of row sums: only swaps between these have an effect
rs <- range(rowSums(comm))
## Function to evaluate discrepancy
- FUN <- function(x) sum(comm[col(comm)[,x] <= rowSums(comm)] == 0)
+ FUN <- function(x) sum(comm[col(comm)[,x] <= rowSums(comm)] == 0)
Ad <- FUN(x)
## Go through all le-items and permute ties. Functions allPerms
## and shuffleSet are in permute package.
- for (i in 1:length(le)) {
+ for (i in seq_along(le)) {
if (le[i] > 1) {
take <- x
idx <- (1:le[i]) + cle[i]
Modified: pkg/vegan/R/nestedtemp.R
===================================================================
--- pkg/vegan/R/nestedtemp.R 2015-05-21 10:07:59 UTC (rev 2949)
+++ pkg/vegan/R/nestedtemp.R 2015-05-25 06:52:06 UTC (rev 2950)
@@ -31,7 +31,7 @@
i <- rowpack(comm, j)
}
## Improve eight times
- for (k in 1:8) {
+ for (k in seq_len(8)) {
j <- colpack(comm, i)
i <- rowpack(comm, j)
}
@@ -67,8 +67,8 @@
p <- sol$root
## row coordinates of the fill line for all matrix entries
out <- matrix(0, nrow=length(r), ncol=length(c))
- for (i in 1:length(r))
- for (j in 1:length(c)) {
+ for (i in seq_along(r))
+ for (j in seq_along(c)) {
a <- c[j] - r[i]
out[i,j] <- uniroot(function(x, ...) fillfun(x, p) - a -x,
c(0,1), p = p)$root
Modified: pkg/vegan/R/permustats.R
===================================================================
--- pkg/vegan/R/permustats.R 2015-05-21 10:07:59 UTC (rev 2949)
+++ pkg/vegan/R/permustats.R 2015-05-25 06:52:06 UTC (rev 2950)
@@ -55,7 +55,7 @@
`print.summary.permustats` <- function(x, ...) {
m <- cbind("statistic" = x$statistic,
- "z" = x$z,
+ "SES" = x$z,
"mean" = x$means,
x$quantile)
cat("\n")
Modified: pkg/vegan/R/plot.cca.R
===================================================================
--- pkg/vegan/R/plot.cca.R 2015-05-21 10:07:59 UTC (rev 2949)
+++ pkg/vegan/R/plot.cca.R 2015-05-25 06:52:06 UTC (rev 2950)
@@ -9,7 +9,7 @@
if (!is.list(g))
g <- list(default = g)
## Take care that there are names
- for (i in seq_len(length(g))) {
+ for (i in seq_along(g)) {
if (length(dim(g[[i]])) > 1)
rownames(g[[i]]) <- rownames(g[[i]], do.NULL = FALSE,
prefix = substr(names(g)[i], 1, 3))
Modified: pkg/vegan/R/plot.meandist.R
===================================================================
--- pkg/vegan/R/plot.meandist.R 2015-05-21 10:07:59 UTC (rev 2949)
+++ pkg/vegan/R/plot.meandist.R 2015-05-25 06:52:06 UTC (rev 2950)
@@ -13,24 +13,28 @@
if (missing(ylim))
ylim <- range(c(w, tr, root), na.rm = TRUE)
plot(cl, ylim = ylim, leaflab = "none", axes = axes, ...)
- for (i in 1:length(w)) segments(i, tr[i], i, w[i])
+ seqw <- seq_along(w)
+ for (i in seqw) {
+ segments(i, tr[i], i, w[i])
+ }
pos <- ifelse(w < tr, 1, 3)
pos[is.na(pos)] <- 1
w[is.na(w)] <- tr[is.na(w)]
- text(1:length(w), w, labels = labels(cl), pos = pos, srt = 0)
+ text(seqw, w, labels = labels(cl), pos = pos, srt = 0)
} else {
w <- diag(x)
+ seqw <- seq_along(w)
tr <- rep(summary(x)$B, length(w))
if (missing(ylim))
ylim <- range(c(w, tr), na.rm = TRUE)
- plot(1:length(w), tr, ylim = ylim, axes = FALSE, xlab = "", ylab = "",
+ plot(seqw, tr, ylim = ylim, axes = FALSE, xlab = "", ylab = "",
type = "l", ...)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/vegan -r 2950
More information about the Vegan-commits
mailing list