[Vegan-commits] r437 - in pkg: . R inst man src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jun 24 07:26:10 CEST 2008
Author: jarioksa
Date: 2008-06-24 07:26:10 +0200 (Tue, 24 Jun 2008)
New Revision: 437
Modified:
pkg/DESCRIPTION
pkg/R/commsimulator.R
pkg/inst/ChangeLog
pkg/man/oecosimu.Rd
pkg/src/nestedness.c
Log:
commsimulator: swap and tswap in C and clearly faster
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2008-06-23 05:22:37 UTC (rev 436)
+++ pkg/DESCRIPTION 2008-06-24 05:26:10 UTC (rev 437)
@@ -1,7 +1,7 @@
Package: vegan
Title: Community Ecology Package
-Version: 1.14-5
-Date: June 16, 2008
+Version: 1.14-6
+Date: June 23, 2008
Author: Jari Oksanen, Roeland Kindt, Pierre Legendre, Bob O'Hara, Gavin L. Simpson,
Peter Solymos, M. Henry H. Stevens, Helene Wagner
Maintainer: Jari Oksanen <jari.oksanen at oulu.fi>
Modified: pkg/R/commsimulator.R
===================================================================
--- pkg/R/commsimulator.R 2008-06-23 05:22:37 UTC (rev 436)
+++ pkg/R/commsimulator.R 2008-06-24 05:26:10 UTC (rev 437)
@@ -31,32 +31,22 @@
for (j in 1:nc)
out[sample(nr, cs[j]), j] <- 1
} else if (method == "swap") {
- swappable <- matrix(c(1,0,0,1), nrow=2)
- for (i in 1:thin) {
- repeat{
- i <- sample(nr, 2)
- j <- sample(nc, 2)
- if (sum(x[i,j] == swappable) %in% c(0,4))
- break
- }
- x[i,j] <- x[i,rev(j)]
- }
- out <- x
+ x <- as.matrix(x)
+ out <- .C("swap", m = as.integer(x), as.integer(nrow(x)),
+ as.integer(ncol(x)), as.integer(thin),
+ PACKAGE = "vegan")$m
+ dim(out) <- dim(x)
} else if (method == "tswap") {
- swappable <- matrix(c(1,0,0,1), nrow=2)
- for (i in 1:thin){
- i <- sample(nr, 2)
- j <- sample(nc, 2)
- if (sum(x[i,j] == swappable) %in% c(0,4))
- x[i,j] <- x[i, rev(j)]
- }
- out <- x
+ x <- as.matrix(x)
+ out <- .C("trialswap", m = as.integer(x), as.integer(nrow(x)),
+ as.integer(ncol(x)), as.integer(thin),
+ PACKAGE = "vegan")$m
+ dim(out) <- dim(x)
} else if (method == "quasiswap") {
out <- r2dtable(1, rowSums(x), colSums(x))[[1]]
out <- .C("quasiswap", m = as.integer(out), as.integer(nrow(x)),
as.integer(ncol(x)), PACKAGE = "vegan")$m
dim(out) <- dim(x)
- out
}
else if (method == "backtrack") {
fill <- sum(x)
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2008-06-23 05:22:37 UTC (rev 436)
+++ pkg/inst/ChangeLog 2008-06-24 05:26:10 UTC (rev 437)
@@ -11,6 +11,11 @@
which also should be written in C. "Backtracking" is so much more
complicated code that it could probably never reach "quasiswap"
even if written in C, and it may be dropped in the future.
+
+ * commsimulator: "swap" and "tswap" written in C, and clearly
+ faster now. In MacBook, 100 swaps with "sipoo" went from 8 sec to
+ 0.5 sec, and thinning hardly influenced timing (it used to
+ thin-fold times).
Version 1.14-5 (closed June 19, 2008)
Modified: pkg/man/oecosimu.Rd
===================================================================
--- pkg/man/oecosimu.Rd 2008-06-23 05:22:37 UTC (rev 436)
+++ pkg/man/oecosimu.Rd 2008-06-24 05:26:10 UTC (rev 437)
@@ -248,9 +248,8 @@
(\pkg{labdsv} package) randomizes a community table.}
\examples{
data(sipoo)
-nestedchecker(sipoo)
## Matrix temperature
-out <- oecosimu(sipoo, nestedtemp, "r00")
+out <- nestedtemp(sipoo)
out
plot(out)
plot(out, kind="incid")
@@ -258,7 +257,7 @@
## of structure: a model for making your own functions.
## This is a minimal structure; fancier functions give fancier results
caeval <- function(x) list(statistic = decorana(x, ira=1)$evals[1])
-out <- oecosimu(sipoo, caeval, "swap", burnin=100, thin=5)
+out <- oecosimu(sipoo, caeval, "swap", burnin=100, thin=10)
out
## Inspect the swap sequence
plot(out$oecosimu$simulated, type="l")
Modified: pkg/src/nestedness.c
===================================================================
--- pkg/src/nestedness.c 2008-06-23 05:22:37 UTC (rev 436)
+++ pkg/src/nestedness.c 2008-06-24 05:26:10 UTC (rev 437)
@@ -82,5 +82,79 @@
PutRNGstate();
}
+/* Trial swap: try 'thin' times and swap when you can. This gives zero
+ * to many swaps for one call.
+ */
+
+void trialswap(int *m, int *nr, int *nc, int *thin)
+{
+
+ int i, a, b, c, d, row[2], col[2];
+
+ GetRNGstate();
+
+ for (i=0; i < *thin; i ++) {
+ i2rand(row, (*nr) - 1);
+ i2rand(col, (*nc) - 1);
+ a = INDX(row[0], col[0], *nr);
+ b = INDX(row[0], col[1], *nr);
+ c = INDX(row[1], col[0], *nr);
+ d = INDX(row[1], col[1], *nr);
+ if (m[a] == 1 && m[d] == 1 && m[b] == 0 & m[c] == 0) {
+ m[a] = 0;
+ m[d] = 0;
+ m[b] = 1;
+ m[c] = 1;
+ } else if (m[c] == 1 && m[b] == 1 && m[d] == 0 &&
+ m[a] == 0) {
+ m[a] = 1;
+ m[d] = 1;
+ m[b] = 0;
+ m[c] = 0;
+ }
+ }
+
+ PutRNGstate();
+}
+
+/* Ordinary swap: swap if you can, stop after you swapped, or repeat
+ * thin times. The data matrix 'm' must be binary: this is not
+ * checked.
+ */
+
+void swap(int *m, int *nr, int *nc, int *thin)
+{
+
+ int i, a, b, c, d, row[2], col[2];
+
+ GetRNGstate();
+
+ for (i=0; i < *thin; i ++) {
+ for(;;) {
+ i2rand(row, (*nr) - 1);
+ i2rand(col, (*nc) - 1);
+ a = INDX(row[0], col[0], *nr);
+ b = INDX(row[0], col[1], *nr);
+ c = INDX(row[1], col[0], *nr);
+ d = INDX(row[1], col[1], *nr);
+ if (m[a] == 1 && m[d] == 1 && m[b] == 0 & m[c] == 0) {
+ m[a] = 0;
+ m[d] = 0;
+ m[b] = 1;
+ m[c] = 1;
+ break;
+ } else if (m[c] == 1 && m[b] == 1 && m[d] == 0 &&
+ m[a] == 0) {
+ m[a] = 1;
+ m[d] = 1;
+ m[b] = 0;
+ m[c] = 0;
+ break;
+ }
+ }
+ }
+ PutRNGstate();
+}
+
#undef IRAND
#undef INDX
More information about the Vegan-commits
mailing list