[Vegan-commits] r444 - in pkg: R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jul 9 01:25:17 CEST 2008
Author: psolymos
Date: 2008-07-09 01:25:16 +0200 (Wed, 09 Jul 2008)
New Revision: 444
Removed:
pkg/R/swapcount.R
Modified:
pkg/R/permat.R
pkg/inst/ChangeLog
pkg/man/permat.Rd
Log:
permat update: swapcount.R deleted, methods improved, permatswap
modified accordingly
Modified: pkg/R/permat.R
===================================================================
--- pkg/R/permat.R 2008-07-06 15:38:21 UTC (rev 443)
+++ pkg/R/permat.R 2008-07-08 23:25:16 UTC (rev 444)
@@ -2,6 +2,8 @@
`permatfull` <-
function(m, fixedmar="both", reg=NULL, hab=NULL, mtype="count", times=100)
{
+ if (!identical(all.equal(m, round(m)), TRUE))
+ stop("function accepts only integers (counts)")
mtype <- match.arg(mtype, c("prab", "count"))
count <- mtype == "count"
fixedmar <- match.arg(fixedmar, c("none", "rows", "columns", "both"))
@@ -31,7 +33,7 @@
for (i in 1:times)
if (count) perm[[i]][id,] <- apply(m[id,], 2, sample)
else perm[[i]][id,] <- commsimulator(m[id,], method="r0")
- if (fixedmar == "cols")
+ if (fixedmar == "columns")
for (i in 1:times)
if (count) perm[[i]][id,] <- t(apply(m[id,], 1, sample))
else perm[[i]][id,] <- commsimulator(m[id,], method="c0")
@@ -54,10 +56,12 @@
`permatswap` <-
function(m, reg=NULL, hab=NULL, mtype="count", method="swap", times=100, burnin = 10000, thin = 1000)
{
+ if (!identical(all.equal(m, round(m)), TRUE))
+ stop("function accepts only integers (counts)")
mtype <- match.arg(mtype, c("prab", "count"))
count <- mtype == "count"
if (count) {
- method <- match.arg(method, c("swap", "Cswap"))
+ method <- match.arg(method, "swap")
} else {method <- match.arg(method, c("swap", "tswap"))}
m <- as.matrix(m)
@@ -82,24 +86,21 @@
temp <- m[id,]
if (count)
for (k in 1:burnin)
- temp <- switch(method,
- swap = swapcount(temp),
- Cswap = .C("swapcount", m = as.double(temp),
- as.integer(n.row), as.integer(n.col),
- as.integer(1), PACKAGE = "vegan")$m)
+ temp <- .C("swapcount", m = as.double(temp),
+ as.integer(n.row), as.integer(n.col),
+ as.integer(1), PACKAGE = "vegan")$m
else
for (k in 1:burnin)
temp <- commsimulator(temp, method=method)
for (i in 1:times) {
if (count)
- perm[[i]][id,] <- switch(method,
- swap = swapcount(temp, thin=thin),
- Cswap = .C("swapcount",
- m = as.double(temp),
- as.integer(n.row),
- as.integer(n.col),
- as.integer(thin),
- PACKAGE = "vegan")$m) else perm[[i]][id,] <- commsimulator(temp, method=method, thin=thin)
+ perm[[i]][id,] <- .C("swapcount",
+ m = as.double(temp),
+ as.integer(n.row),
+ as.integer(n.col),
+ as.integer(thin),
+ PACKAGE = "vegan")$m
+ else perm[[i]][id,] <- commsimulator(temp, method=method, thin=thin)
temp <- perm[[i]][id,]
}
}
@@ -120,8 +121,7 @@
n <- attr(x, "times")
bray <- numeric(n)
for (i in 1:n) bray[i] <- sum(abs(x$orig-x$perm[[i]]))/sum(x$orig+x$perm[[i]])
- plot(bray,type="n",ylim=c(0,1),ylab="Bray-Curtis dissimilarity",xlab="Runs", ...)
- for (i in c(0.4, 0.6)) abline(i,0, lty=2, col="grey")
+ plot(bray,type="n",ylab="Bray-Curtis dissimilarity",xlab="Runs", ...)
lines(bray,col="red")
lines(lowess(bray),col="blue",lty=2)
title(sub=paste("(mean = ", substitute(z, list(z=round(mean(bray),3))),
@@ -143,12 +143,12 @@
cat("\n\nMatrix dimensions:", nrow(x$orig), "rows,", ncol(x$orig), "columns")
cat("\nSum of original matrix:", sum(x$orig))
cat("\nFill of original matrix:", round(sum(x$orig>0)/(nrow(x$orig)*ncol(x$orig)),digits))
- cat("\nNumber of permuted matrices:", length(x$perm),"\n")
+ cat("\nNumber of permuted matrices:", attr(x, "times"),"\n")
}
## S3 summary method for permat
`summary.permat` <-
-function(object, digits=2, ...)
+function(object, ...)
{
x <- object
n <- attr(x, "times")
@@ -172,8 +172,21 @@
rowSums(aggregate(x$perm[[i]],list(int),sum)[,-1])) == nlev}
}
strsum <- if (restr) sum(ssum)/n else NA
- outv <- c(sum=sum(psum)/n, fill=sum(pfill)/n, rowsums=sum(vrow)/n, colsums=sum(vcol)/n, strsum=strsum)
+ test <- c(sum=sum(psum)/n, fill=sum(pfill)/n, rowsums=sum(vrow)/n, colsums=sum(vcol)/n, strsum=strsum)
+ x$perm <- NULL
+ out <- list(x=x, bray=bray, test=test, restr=restr)
+ class(out) <- c("summary.permat", "list")
+ return(out)
+}
+## S3 print method for summary.permat
+`print.summary.permat` <-
+function(x, digits=2, ...)
+{
+ bray <- x$bray
+ restr <- x$restr
+ test <- x$test
+ x <- x$x
cat("Summary of object of class 'permat'\n\nCall: ")
print(x$call)
cat("Matrix type:", attr(x, "mtype"), "\nPermutation type:", attr(x, "ptype"))
@@ -181,16 +194,13 @@
cat("\n\nMatrix dimensions:", nrow(x$orig), "rows,", ncol(x$orig), "columns")
cat("\nSum of original matrix:", sum(x$orig))
cat("\nFill of original matrix:", round(sum(x$orig>0)/(nrow(x$orig)*ncol(x$orig)),digits))
- cat("\nNumber of permuted matrices:", length(x$perm),"\n")
-
- cat("\nMatrix sums retained:", round(100*outv[1], digits), "%")
- cat("\nMatrix fill retained:", round(100*outv[2], digits), "%")
- cat("\nRow sums retained: ", round(100*outv[3], digits), "%")
- cat("\nColumn sums retained:", round(100*outv[4], digits), "%")
- if (restr) cat("\nSums within strata retained:", round(100*outv[5], digits), "%")
+ cat("\nNumber of permuted matrices:", attr(x, "times"),"\n")
+ cat("\nMatrix sums retained:", round(100*test[1], digits), "%")
+ cat("\nMatrix fill retained:", round(100*test[2], digits), "%")
+ cat("\nRow sums retained: ", round(100*test[3], digits), "%")
+ cat("\nColumn sums retained:", round(100*test[4], digits), "%")
+ if (restr) cat("\nSums within strata retained:", round(100*test[5], digits), "%")
cat("\n\nBray-Curtis dissimilarities among original and permuted matrices:\n")
print(summary(bray))
- out <- list(bray=bray, restr=outv)
- class(out) <- c("summary.permat", "list")
- invisible(out)
+invisible(NULL)
}
Deleted: pkg/R/swapcount.R
===================================================================
--- pkg/R/swapcount.R 2008-07-06 15:38:21 UTC (rev 443)
+++ pkg/R/swapcount.R 2008-07-08 23:25:16 UTC (rev 444)
@@ -1,40 +0,0 @@
-`swapcount` <-
-function(m, thin = 1)
-{
-## internal, is the 2x2 matrix diagonal or anti-diagonal
-isDiag <- function(x) {
- x<- as.vector(x)
- X <- as.numeric(x>0)
- sX <- sum(X)
- choose <- c(min(x[c(2,3)]), min(x[c(1,4)]))
- if (sX == 4) {
- ch <- sample(c(1,2), 1)
- d <- choose[ch]
- if (ch == 2) ch <- -1
- return(d * ch)}
- if (identical(X, c(0,1,1,0)) || identical(X, c(0,1,1,1)) || identical(X, c(1,1,1,0)))
- return(choose[1])
- if (identical(X, c(1,0,0,1)) || identical(X, c(1,0,1,1)) || identical(X, c(1,1,0,1)))
- return(-choose[2])
- if (sX < 2 | identical(X, c(0,0,1,1)) || identical(X, c(1,1,0,0)) ||
- identical(X, c(0,1,0,1)) || identical(X, c(1,0,1,0)))
- return(0)
- }
- x <- as.matrix(m)
- n.col <- ncol(x)
- n.row <- nrow(x)
- changed <- 0
- while(changed < thin) {
- ran.row <- sample(n.row, 2)
- ran.col <- sample(n.col, 2)
- ev <- isDiag(x[ran.row, ran.col])
- if (ev != 0) {
- if (identical(sum(x[ran.row, ran.col] > 0),
- sum(x[ran.row, ran.col] + matrix(c(ev,-ev,-ev,ev), 2, 2) > 0))) {
- x[ran.row, ran.col] <- x[ran.row, ran.col] + matrix(c(ev,-ev,-ev,ev), 2, 2)
- changed <- changed + 1
- }
- }
- }
- return(x)
-}
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2008-07-06 15:38:21 UTC (rev 443)
+++ pkg/inst/ChangeLog 2008-07-08 23:25:16 UTC (rev 444)
@@ -4,7 +4,12 @@
Version 1.14-7 (opened July 5, 2008)
- * ordilabel: new function for cluttered ordination plots -- text
+ * permat.R, swapcount.R: summary method was modified according to
+ standard R ways, ylab argument was deleted from plot method.
+ The R version of swapcount was deleted and replaced by the C
+ version. Help file was modified accordingly.
+
+ * ordilabel: new function for cluttered ordination plots -- text
is written on a non-transparent label. Similar to s.label()
function in ade4.
Modified: pkg/man/permat.Rd
===================================================================
--- pkg/man/permat.Rd 2008-07-06 15:38:21 UTC (rev 443)
+++ pkg/man/permat.Rd 2008-07-08 23:25:16 UTC (rev 444)
@@ -4,7 +4,7 @@
\alias{plot.permat}
\alias{print.permat}
\alias{summary.permat}
-\alias{swapcount}
+\alias{print.summary.permat}
\title{Matrix Permutation Algorithms or Presence-Absence and Count Data}
@@ -20,9 +20,9 @@
\usage{
permatfull(m, fixedmar = "both", reg = NULL, hab = NULL, mtype = "count", times = 100)
permatswap(m, reg = NULL, hab = NULL, mtype = "count", method = "swap", times = 100, burnin = 10000, thin = 1000)
-swapcount(m, thin = 1)
\method{plot}{permat}(x, ...)
-\method{summary}{permat}(object, digits = 2, ...)
+\method{summary}{permat}(object, ...)
+\method{print}{summary.permat}(x, digits = 2, ...)
}
\arguments{
\item{m}{a community data matrix with plots (samples) as rows and species (taxa) as columns.}
@@ -31,7 +31,7 @@
\item{hab}{numeric vector or factor with length same as \code{nrow(m)} for grouping rows within strata (habitat classes) for restricted permutations. Unique values or levels are used.}
\item{mtype}{matrix data type, either \code{"count"} for count data, or \code{"prab"} for presence-absence data.}
\item{times}{number of permuted matrices.}
- \item{method}{character for method used for the swap algorithm (\code{"swap"}, \code{"tswap"}, \code{"backtrack"}) as described for function \code{\link{commsimulator}}. If \code{mtype="count"} only \code{"swap"} is available using the function \code{\link{swapcount}}.}
+ \item{method}{character for method used for the swap algorithm (\code{"swap"}, \code{"tswap"}, \code{"backtrack"}) as described for function \code{\link{commsimulator}}. If \code{mtype="count"} only \code{"swap"} is available.}
\item{burnin}{number of null communities discarded before proper analysis in sequential \code{"swap", "tswap"} methods.}
\item{thin}{number of discarded permuted matrices between two evaluations in sequential \code{"swap", "tswap"} methods.}
\item{x, object}{object of class \code{"permat"}}
@@ -39,7 +39,8 @@
\item{\dots}{other arguments passed to methods.}
}
-\details{ Unrestricted and restricted permutations: if both
+\details{
+Unrestricted and restricted permutations: if both
\code{reg} and \code{hab} are \code{NULL}, functions perform
unrestricted permutations. If either of the two is given, it is used
as is for restricted permutations. If both are given, interaction is
@@ -59,14 +60,10 @@
Bray-Curtis dissimilarities calculated pairvise among original and
permuted matrices, and check results of the constraints. }
-\note{
-Swap methods can be very slow for large matrices.
-}
-
\references{ Original references are given on help pages of the
functions used internally, listed in section 'See Also'. }
-\author{Peter Solymos, \email{Solymos.Peter at aotk.szie.hu}}
+\author{Peter Solymos, \email{Solymos.Peter at aotk.szie.hu}; Jari Oksanen translated the original swap algorithm for count data into C}
\seealso{
\code{\link{commsimulator}}, \code{\link{r2dtable}}, \code{\link{sample}}
@@ -79,11 +76,6 @@
0,0,1,2,0,3,
0,0,0,1,4,3
), 4, 6, byrow=TRUE)
-## The swap algorithm for count data (1 step):
-a <- swapcount(m)
-a
-## Identity of swapped cells:
-a != m
## Using the swap algorithm to create a
## list of permuted matrices, where
## row/columns sums and matrix fill are preserved:
@@ -96,7 +88,7 @@
summary(x2)
plot(x2)
## Unrestricted permutation of presence-absence type
-## retaining neither row/columns sums nor not matrix fill:
+## not retaining row/columns sums:
x3 <- permatfull(m, "none", mtype="prab")
x3$orig ## note: original matrix is binarized!
summary(x3)
More information about the Vegan-commits
mailing list