[Vegan-commits] r1494 - in pkg/vegan: R inst
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Feb 16 18:28:57 CET 2011
Author: jarioksa
Date: 2011-02-16 18:28:57 +0100 (Wed, 16 Feb 2011)
New Revision: 1494
Modified:
pkg/vegan/R/allPerms.R
pkg/vegan/R/as.ts.permat.R
pkg/vegan/R/beals.R
pkg/vegan/R/betadisper.R
pkg/vegan/R/bstick.default.R
pkg/vegan/R/cIndexKM.R
pkg/vegan/R/contribdiv.R
pkg/vegan/R/dispindmorisita.R
pkg/vegan/R/diversity.R
pkg/vegan/R/estimateR.default.R
pkg/vegan/R/nestednodf.R
pkg/vegan/R/ordisurf.R
pkg/vegan/R/pasteCall.R
pkg/vegan/R/permatfull.R
pkg/vegan/R/permatswap.R
pkg/vegan/R/permuplot.R
pkg/vegan/R/permute.R
pkg/vegan/R/pregraphKM.R
pkg/vegan/R/print.allPerms.R
pkg/vegan/R/procrustes.R
pkg/vegan/R/scores.betadisper.R
pkg/vegan/R/summary.permat.R
pkg/vegan/R/vegdist.R
pkg/vegan/inst/ChangeLog
Log:
no return & other stylistic tweaks
Modified: pkg/vegan/R/allPerms.R
===================================================================
--- pkg/vegan/R/allPerms.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/allPerms.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -217,5 +217,5 @@
class(res) <- "allPerms"
attr(res, "control") <- control
attr(res, "observed") <- observed
- return(res)
+ res
}
Modified: pkg/vegan/R/as.ts.permat.R
===================================================================
--- pkg/vegan/R/as.ts.permat.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/as.ts.permat.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -7,5 +7,6 @@
seqmethods <- c("swap", "tswap", "abuswap")
stop("as.ts available only for sequential methods ",
paste(seqmethods, collapse=", "))
- } else return(out)
+ }
+ out
}
Modified: pkg/vegan/R/beals.R
===================================================================
--- pkg/vegan/R/beals.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/beals.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -16,52 +16,49 @@
## all species. #
## 'include' flag to include target species in the computation#
##############################################################
-beals<-function(x, species=NA, reference=x, type=0, include=TRUE)
+`beals` <-
+ function(x, species=NA, reference=x, type=0, include=TRUE)
{
refX <- reference
- # this checks whether it was chosen from available options
+ ## this checks whether it was chosen from available options
mode <- as.numeric(match.arg(as.character(type), c("0","1","2","3")))
spIndex <- species
incSp <- include
-# if(is.null(refX)) # I think this is unnecessary because of the default above
-# refX<-x # and it should look like missing(refX) and not is.null(refX)
- refX <- as.matrix(refX)
- x <- as.matrix(x)
- if(mode==0 || mode ==2) refX <- ifelse(refX > 0, 1, 0)
- if(mode==0 || mode ==1) x <- ifelse(x > 0, 1, 0)
- #Computes conditioned probabilities
- if(is.na(spIndex)){
- M <- crossprod(ifelse(refX > 0, 1, 0),refX)
- C <-diag(M)
- M <- sweep(M, 2, replace(C,C==0,1), "/")
- if(!incSp)
- for (i in 1:ncol(refX))
- M[i,i]<-0
+ refX <- as.matrix(refX)
+ x <- as.matrix(x)
+ if(mode==0 || mode ==2) refX <- ifelse(refX > 0, 1, 0)
+ if(mode==0 || mode ==1) x <- ifelse(x > 0, 1, 0)
+ ##Computes conditioned probabilities
+ if(is.na(spIndex)){
+ M <- crossprod(ifelse(refX > 0, 1, 0),refX)
+ C <-diag(M)
+ M <- sweep(M, 2, replace(C,C==0,1), "/")
+ if(!incSp)
+ for (i in 1:ncol(refX))
+ M[i,i] <- 0
} else {
- C<-colSums(refX)
- M<-crossprod(refX,ifelse(refX > 0, 1, 0)[,spIndex])
- M<-M/replace(C,C==0,1)
- if(!incSp)
- M[spIndex]<-0
+ C <- colSums(refX)
+ M <- crossprod(refX,ifelse(refX > 0, 1, 0)[,spIndex])
+ M <- M/replace(C,C==0,1)
+ if(!incSp)
+ M[spIndex] <- 0
}
- #Average of conditioned probabilities
- S <- rowSums(x)
- if(is.na(spIndex)) {
- b <-x
- for (i in 1:nrow(x)) {
- b[i, ] <- rowSums(sweep(M, 2, x[i, ], "*"))
- }
- SM<-rep(S,ncol(x))
- if(!incSp)
- SM<-SM-x
- b <- b/replace(SM,SM==0,1)
- } else {
- b<-rowSums(sweep(x,2,M,"*"))
- if(!incSp)
- S<-S-x[,spIndex]
- b <- b/replace(S,S==0,1)
- }
-# attr(b, "smoothtype") <- mode
-# class(b) <- c("beals", class(b)) # this can later be used to write the methods, i.e. beals test, etc.
- return(b)
+ ##Average of conditioned probabilities
+ S <- rowSums(x)
+ if(is.na(spIndex)) {
+ b <-x
+ for (i in 1:nrow(x)) {
+ b[i, ] <- rowSums(sweep(M, 2, x[i, ], "*"))
+ }
+ SM <- rep(S,ncol(x))
+ if(!incSp)
+ SM <- SM-x
+ b <- b/replace(SM,SM==0,1)
+ } else {
+ b <-rowSums(sweep(x,2,M,"*"))
+ if(!incSp)
+ S <- S-x[,spIndex]
+ b <- b/replace(S,S==0,1)
+ }
+ b
}
Modified: pkg/vegan/R/betadisper.R
===================================================================
--- pkg/vegan/R/betadisper.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/betadisper.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -1,10 +1,12 @@
-`betadisper` <- function(d, group, type = c("median","centroid")) {
+`betadisper` <-
+ function(d, group, type = c("median","centroid"))
+{
## inline function for spatial medians
spatialMed <- function(vectors, group, pos) {
axes <- seq_len(NCOL(vectors))
spMedPos <- ordimedian(vectors, group, choices = axes[pos])
spMedNeg <- ordimedian(vectors, group, choices = axes[!pos])
- return(cbind(spMedPos, spMedNeg))
+ cbind(spMedPos, spMedNeg)
}
## inline function for distance computation
Resids <- function(x, c) {
@@ -12,7 +14,7 @@
d <- x - c
else
d <- sweep(x, 2, c)
- return(rowSums(d^2))
+ rowSums(d^2)
}
## Tolerance for zero Eigenvalues
TOL <- 1e-7
Modified: pkg/vegan/R/bstick.default.R
===================================================================
--- pkg/vegan/R/bstick.default.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/bstick.default.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -3,5 +3,5 @@
{
res <- rev(cumsum(tot.var/n:1)/n)
names(res) <- paste("Stick", seq(len=n), sep="")
- return(res)
+ res
}
Modified: pkg/vegan/R/cIndexKM.R
===================================================================
--- pkg/vegan/R/cIndexKM.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/cIndexKM.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -26,7 +26,7 @@
varwithins[k, l] <- sum(x[cluster == k, l])
}
}
- return(varwithins)
+ varwithins
}
##########################################
maxmindist <- function(clsize, distscen)
@@ -68,8 +68,7 @@
}
i <- i - 1
}
- minmaxd <- list(mindw = mindw, maxdw = maxdw)
- return(minmaxd)
+ list(mindw = mindw, maxdw = maxdw)
}
#############################################
gss <- function(x, clsize, withins)
@@ -81,8 +80,7 @@
allmeandist <- sum(dmean^2)
wgss <- sum(withins)
bgss <- allmeandist - wgss
- zgss <- list(wgss = wgss, bgss = bgss)
- return(zgss)
+ list(wgss = wgss, bgss = bgss)
}
#############################################
vargss <- function(x, clsize, varwithins)
@@ -102,8 +100,7 @@
}
varbgss <- varallmeandist - varwgss
vartss <- varbgss + varwgss
- zvargss <- list(vartss = vartss, varbgss = varbgss)
- return(zvargss)
+ list(vartss = vartss, varbgss = varbgss)
}
#################################################
@@ -116,7 +113,7 @@
d = d, PACKAGE = "cclust")
d <- retval$d
names(d) <- 0:nc
- return(d)
+ d
}
################################################
### Function modified by SD and PL from the original "cIndexKM" in "cclust"
@@ -129,8 +126,7 @@
{
n <- sum(clsize)
k <- length(clsize)
- vrc <- (zgss$bgss/(k - 1))/(zgss$wgss/(n - k))
- return(vrc = vrc)
+ zgss$bgss/(k - 1)/(zgss$wgss/(n - k))
}
################################################
ssi <- function(centers, clsize)
@@ -153,7 +149,7 @@
exp(-min(absmdif))
sist <- sum(span)/hiest
sistw <- (span * exp(-absmdif)) %*% sqrt(csizemax * csizemin)/hiestw
- return(list(ssi = sist, ssiw = sistw))
+ list(ssi = sist, ssiw = sistw)
}
################################################
Modified: pkg/vegan/R/contribdiv.R
===================================================================
--- pkg/vegan/R/contribdiv.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/contribdiv.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -2,8 +2,9 @@
## Lu, H.P., H.H. Wagner and X.Y. Chen (2007).
## A contribution diversity approach to evaluate species diversity.
## Basic and Applied Ecology 8: 1 -12.
-contribdiv <-
-function(comm, index = c("richness", "simpson"), relative = FALSE, scaled = TRUE, drop.zero = FALSE)
+`contribdiv` <-
+ function(comm, index = c("richness", "simpson"), relative = FALSE,
+ scaled = TRUE, drop.zero = FALSE)
{
index <- match.arg(index)
@@ -47,5 +48,5 @@
attr(rval, "relative") <- relative
attr(rval, "scaled") <- scaled
class(rval) <- c("contribdiv", "data.frame")
- return(rval)
+ rval
}
Modified: pkg/vegan/R/dispindmorisita.R
===================================================================
--- pkg/vegan/R/dispindmorisita.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/dispindmorisita.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -26,6 +26,6 @@
usp <- which(apply(x > 0, 2, sum) == 1)
if (unique.rm && length(usp) != 0)
out <- out[-usp,]
- return(out)
+ out
}
Modified: pkg/vegan/R/diversity.R
===================================================================
--- pkg/vegan/R/diversity.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/diversity.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -1,21 +1,19 @@
-"diversity" <-
+`diversity` <-
function (x, index = "shannon", MARGIN = 1, base = exp(1))
{
- x <- as.matrix(x)
- INDICES <- c("shannon", "simpson", "invsimpson")
- index <- match.arg(index, INDICES)
- total <- apply(x, MARGIN, sum)
- x <- sweep(x, MARGIN, total, "/")
- if (index == "shannon")
- x <- -x * log(x, base)
- else
- x <- x^2
- H <- apply(x, MARGIN, sum, na.rm = TRUE)
- if (index == "simpson")
- H <- 1 - H
- else if (index == "invsimpson")
- H <- 1/H
- return(H)
+ x <- as.matrix(x)
+ INDICES <- c("shannon", "simpson", "invsimpson")
+ index <- match.arg(index, INDICES)
+ total <- apply(x, MARGIN, sum)
+ x <- sweep(x, MARGIN, total, "/")
+ if (index == "shannon")
+ x <- -x * log(x, base)
+ else
+ x <- x^2
+ H <- apply(x, MARGIN, sum, na.rm = TRUE)
+ if (index == "simpson")
+ H <- 1 - H
+ else if (index == "invsimpson")
+ H <- 1/H
+ H
}
-
-
Modified: pkg/vegan/R/estimateR.default.R
===================================================================
--- pkg/vegan/R/estimateR.default.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/estimateR.default.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -1,4 +1,4 @@
-"estimateR.default" <-
+`estimateR.default` <-
function (x, ...)
{
gradF <- function(a, i) {
@@ -24,7 +24,7 @@
Grad[1] <- .expr25/.expr26 * .expr20 + .expr8 * (1 +
(.expr18 + a[1] * (.expr12/.expr16 - .expr13 * ((.expr7 -
.expr25 * .expr4) * .expr15 + .expr14)/.expr35)))
- return(Grad)
+ Grad
}
if (!identical(all.equal(x, round(x)), TRUE))
stop("function accepts only integers (counts)")
Modified: pkg/vegan/R/nestednodf.R
===================================================================
--- pkg/vegan/R/nestednodf.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/nestednodf.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -68,5 +68,5 @@
out <- list(comm = comm, fill = fill,
statistic = c(N.columns = N.columns, N.rows = N.rows, NODF = NODF))
class(out) <- "nestednodf"
- return(out)
+ out
}
Modified: pkg/vegan/R/ordisurf.R
===================================================================
--- pkg/vegan/R/ordisurf.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/ordisurf.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -1,4 +1,4 @@
-"ordisurf" <-
+`ordisurf` <-
function (x, y, choices = c(1, 2), knots = 10, family = "gaussian",
col = "red", thinplate = TRUE, add = FALSE, display = "sites",
w = weights(x), main, nlevels = 10, levels, labcex = 0.6,
@@ -72,5 +72,5 @@
drawlabels = !is.null(labcex) && labcex > 0)
mod$grid <- list(x = xn1, y = xn2, z = matrix(fit, nrow = GRID))
class(mod) <- c("ordisurf", class(mod))
- return(mod)
+ mod
}
Modified: pkg/vegan/R/pasteCall.R
===================================================================
--- pkg/vegan/R/pasteCall.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/pasteCall.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -1,6 +1,5 @@
`pasteCall` <- function (call, prefix = "Call:")
{
call.str <- paste(deparse(call), collapse = " ")
- call.str <- paste(prefix, call.str, "\n", sep = " ")
- return(call.str)
+ paste(prefix, call.str, "\n", sep = " ")
}
Modified: pkg/vegan/R/permatfull.R
===================================================================
--- pkg/vegan/R/permatfull.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/permatfull.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -12,12 +12,12 @@
y <- table(sample(1:N, n, replace = TRUE))
out[names(out) %in% names(y)] <- y
names(out) <- NULL
- return(out)
+ out
}
bothshuffle <- function(x, y=1)
{
x[x!=0] <- indshuffle(x[x!=0] - y) + y
- return(sample(x))
+ sample(x)
}
if (!identical(all.equal(m, round(m)), TRUE))
stop("function accepts only integers (counts)")
@@ -80,5 +80,5 @@
attr(out, "burnin") <- NA
attr(out, "thin") <- NA
class(out) <- c("permatfull", "permat")
- return(out)
+ out
}
Modified: pkg/vegan/R/permatswap.R
===================================================================
--- pkg/vegan/R/permatswap.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/permatswap.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -13,12 +13,12 @@
y <- table(sample(1:N, n, replace = TRUE))
out[names(out) %in% names(y)] <- y
names(out) <- NULL
- return(out)
+ out
}
bothshuffle <- function(x, y=1)
{
x[x!=0] <- indshuffle(x[x!=0] - y) + y
- return(sample(x))
+ sample(x)
}
if (!identical(all.equal(m, round(m)), TRUE))
stop("function accepts only integers (counts)")
@@ -167,5 +167,5 @@
attr(out, "burnin") <- burnin
attr(out, "thin") <- thin
class(out) <- c("permatswap", "permat")
- return(out)
+ out
}
Modified: pkg/vegan/R/permuplot.R
===================================================================
--- pkg/vegan/R/permuplot.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/permuplot.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -12,27 +12,23 @@
angle <- seq(0, 2*pi, length = n+1)[-(n+1)]
x <- rev(cos(angle))
y <- rev(sin(angle))
- xy <- xy.coords(x, y)
- return(xy)
+ xy.coords(x, y)
}
xy.free <- function(n) {
x <- runif(n)
y <- runif(n)
- xy <- xy.coords(x, y)
- return(xy)
+ xy.coords(x, y)
}
xy.grid <- function(ncol, nrow) {
x <- rep(seq_len(ncol), each = nrow)
y <- rev(rep(seq_len(nrow), times = ncol))
- xy <- xy.coords(x, y)
- return(xy)
+ xy.coords(x, y)
}
axis.limits <- function(vals, inset) {
lim <- range(vals[is.finite(vals)])
lim.range <- lim[2] - lim[1]
- res <- c(lim[1] - (lim.range * inset),
- lim[2] + (lim.range * inset))
- return(res)
+ c(lim[1] - (lim.range * inset),
+ lim[2] + (lim.range * inset))
}
## currently doesn't support restricted permutations of strata themselves
if(control$permute.strata && control$type != "free")
Modified: pkg/vegan/R/permute.R
===================================================================
--- pkg/vegan/R/permute.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/permute.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -1,4 +1,6 @@
-permute <- function(i, n, control) {
+`permute` <-
+ function(i, n, control)
+{
if(control$complete && !is.null(control$all.perms))
perm <- control$all.perms[i,]
else {
@@ -6,5 +8,5 @@
warning("'$all.perms' is NULL, yet '$complete = TRUE'.\nReturning a random permutation.")
perm <- permuted.index2(n, control)
}
- return(perm)
+ perm
}
Modified: pkg/vegan/R/pregraphKM.R
===================================================================
--- pkg/vegan/R/pregraphKM.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/pregraphKM.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -1,6 +1,7 @@
-"pregraphKM" <- function(matrice)
+`pregraphKM` <-
+ function(matrice)
{
- "row.col.number" <-function(mat,number){
+ `row.col.number` <- function(mat,number){
nr<-nrow(mat)
nc<-ncol(mat)
mod<-number %% nr
@@ -20,7 +21,7 @@
}
}
}
- return(list(nr=nr.f,nc=nc.f))
+ list(nr=nr.f,nc=nc.f)
}
## Beginning of the function
Modified: pkg/vegan/R/print.allPerms.R
===================================================================
--- pkg/vegan/R/print.allPerms.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/print.allPerms.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -1,9 +1,11 @@
-`print.allPerms` <- function(x, ...) {
+`print.allPerms` <-
+ function(x, ...)
+{
dims <- dim(x)
control <- attr(x, "control")
observed <- attr(x, "observed")
attributes(x) <- NULL
dim(x) <- dims
print(x)
- return(invisible(x))
+ invisible(x)
}
Modified: pkg/vegan/R/procrustes.R
===================================================================
--- pkg/vegan/R/procrustes.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/procrustes.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -1,4 +1,4 @@
-"procrustes" <-
+`procrustes` <-
function (X, Y, scale = TRUE, symmetric = FALSE, scores = "sites", ...)
{
X <- scores(X, display = scores, ...)
@@ -38,5 +38,5 @@
symmetric = symmetric, call = match.call())
reslt$svd <- sol
class(reslt) <- "procrustes"
- return(reslt)
+ reslt
}
Modified: pkg/vegan/R/scores.betadisper.R
===================================================================
--- pkg/vegan/R/scores.betadisper.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/scores.betadisper.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -1,5 +1,6 @@
-`scores.betadisper` <- function(x, display = c("sites", "centroids"),
- choices = c(1,2), ...)
+`scores.betadisper` <-
+ function(x, display = c("sites", "centroids"),
+ choices = c(1,2), ...)
{
display <- match.arg(display, several.ok = TRUE)
sol <- list()
@@ -13,5 +14,5 @@
}
if (length(sol) == 1)
sol <- sol[[1]]
- return(sol)
+ sol
}
Modified: pkg/vegan/R/summary.permat.R
===================================================================
--- pkg/vegan/R/summary.permat.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/summary.permat.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -1,6 +1,6 @@
## S3 summary method for permat
`summary.permat` <-
-function(object, ...)
+ function(object, ...)
{
x <- object
n <- attr(x, "times")
@@ -43,5 +43,5 @@
out <- list(x=x, bray=bray, chisq=chisq, sum=psum, fill=pfill, rowsums=vrow, colsums=vcol,
browsums=brow, bcolsums=bcol, strsum=ssum)
class(out) <- c("summary.permat", "list")
- return(out)
+ out
}
Modified: pkg/vegan/R/vegdist.R
===================================================================
--- pkg/vegan/R/vegdist.R 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/R/vegdist.R 2011-02-16 17:28:57 UTC (rev 1494)
@@ -1,4 +1,4 @@
-"vegdist" <-
+`vegdist` <-
function (x, method = "bray", binary = FALSE, diag = FALSE, upper = FALSE,
na.rm = FALSE, ...)
{
@@ -44,5 +44,5 @@
"binary ", METHODS[method], sep = "")
attr(d, "call") <- match.call()
class(d) <- "dist"
- return(d)
+ d
}
Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog 2011-02-16 10:50:50 UTC (rev 1493)
+++ pkg/vegan/inst/ChangeLog 2011-02-16 17:28:57 UTC (rev 1494)
@@ -7,6 +7,10 @@
* opened with the release of 1.17-7 based on version 1.18-22 on
February 16, 2011.
+
+ * does not use unnecessary return() plus other stylistic
+ twitches. This touches 24 functions, but users should see no
+ difference.
Version 1.18-22 (closed February 16, 2011)
More information about the Vegan-commits
mailing list