[Vegan-commits] r2069 - in pkg/vegan: R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Feb 7 21:25:32 CET 2012
Author: jarioksa
Date: 2012-02-07 21:25:32 +0100 (Tue, 07 Feb 2012)
New Revision: 2069
Modified:
pkg/vegan/R/metaMDSiter.R
pkg/vegan/inst/ChangeLog
pkg/vegan/man/metaMDS.Rd
Log:
parallel processing in metaMDS
Modified: pkg/vegan/R/metaMDSiter.R
===================================================================
--- pkg/vegan/R/metaMDSiter.R 2012-02-07 17:16:30 UTC (rev 2068)
+++ pkg/vegan/R/metaMDSiter.R 2012-02-07 20:25:32 UTC (rev 2069)
@@ -1,6 +1,7 @@
`metaMDSiter` <-
function (dist, k = 2, trymax = 20, trace = 1, plot = FALSE,
- previous.best, engine = "monoMDS", ...)
+ previous.best, engine = "monoMDS",
+ parallel = getOption("mc.cores"), ...)
{
engine <- match.arg(engine, c("monoMDS", "isoMDS"))
if (engine == "isoMDS")
@@ -55,37 +56,84 @@
if (trace)
cat("Run 0 stress", s0$stress, "\n")
tries <- 0
- while(tries < trymax) {
- tries <- tries + 1
- stry <- switch(engine,
- "monoMDS" = monoMDS(dist, k = k, maxit = 200, ...),
- "isoMDS" = isoMDS(dist, initMDS(dist, k = k), k = k,
- maxit = 200, tol = 1e-07, trace = isotrace))
- if (trace) {
- cat("Run", tries, "stress", stry$stress, "\n")
+ ## Prepare for parallel processing
+ if (is.null(parallel) && getRversion() >= "2.15.0")
+ parallel <- get("default", envir = parallel:::.reg)
+ if (is.null(parallel) || getRversion() < "2.14.0")
+ parallel <- 1
+ hasClus <- inherits(parallel, "cluster")
+ isParal <- (hasClus || parallel > 1) && require(parallel)
+ isMulticore <- .Platform$OS.type == "unix" && !hasClus
+ if (isParal && !isMulticore && !hasClus) {
+ parallel <- makeCluster(parallel)
+ clusterEvalQ(parallel, library(vegan))
+ }
+ ## get the number of clusters
+ if (inherits(parallel, "cluster"))
+ nclus <- length(parallel)
+ else
+ nclus <- parallel
+ ## proper iterations
+ while(tries < trymax && !converged) {
+ init <- replicate(nclus, initMDS(dist, k = k))
+ if (nclus > 1) isotrace <- FALSE
+ if (isParal) {
+ if (isMulticore) {
+ stry <-
+ mclapply(1:nclus, function(i)
+ switch(engine,
+ "monoMDS" = monoMDS(dist, init[,,i], k = k,
+ maxit = 200, ...),
+ "isoMDS" = isoMDS(dist, init[,,i], k = k,
+ maxit = 200, tol = 1e-07, trace = isotrace)),
+ mc.cores = parallel)
+ } else {
+ stry <-
+ parLapply(parallel, 1:nclus, function(i)
+ switch(engine,
+ "monoMDS" = monoMDS(dist, init[,,i], k = k,
+ maxit = 200, ...),
+ "isoMDS" = isoMDS(dist, init[,,i], k = k,
+ maxit = 200, tol = 1e-07, trace = isotrace)))
+ }
+ } else {
+ stry <- list(switch(engine,
+ "monoMDS" = monoMDS(dist, init[,,1], k = k,
+ maxit = 200, ...),
+ "isoMDS" = isoMDS(dist, init[,,1], k = k,
+ maxit = 200, tol = 1e-07, trace = isotrace)))
}
- if ((s0$stress - stry$stress) > -EPS) {
- pro <- procrustes(s0, stry, symmetric = TRUE)
- if (plot && k > 1)
- plot(pro)
- if (stry$stress < s0$stress) {
- s0 <- stry
- if (trace)
- cat("... New best solution\n")
+ ## analyse results of 'nclus' tries
+ for (i in 1:nclus) {
+ tries <- tries + 1
+ if (trace) {
+ cat("Run", tries, "stress", stry[[i]]$stress, "\n")
}
- summ <- summary(pro)
- if (trace)
- cat("... procrustes: rmse", summ$rmse, " max resid",
- max(summ$resid), "\n")
- if (summ$rmse < RMSELIM && max(summ$resid) < RESLIM) {
+ if ((s0$stress - stry[[i]]$stress) > -EPS) {
+ pro <- procrustes(s0, stry[[i]], symmetric = TRUE)
+ if (plot && k > 1)
+ plot(pro)
+ if (stry[[i]]$stress < s0$stress) {
+ s0 <- stry[[i]]
+ if (trace)
+ cat("... New best solution\n")
+ }
+ summ <- summary(pro)
if (trace)
- cat("*** Solution reached\n\n")
- converged <- TRUE
- break
+ cat("... procrustes: rmse", summ$rmse, " max resid",
+ max(summ$resid), "\n")
+ if (summ$rmse < RMSELIM && max(summ$resid) < RESLIM) {
+ if (trace)
+ cat("*** Solution reached\n")
+ converged <- TRUE
+ }
}
+ flush.console()
}
- flush.console()
}
+ ## stop socket cluster
+ if (isParal && !isMulticore && !hasClus)
+ stopCluster(parallel)
if (!missing(previous.best) && inherits(previous.best, "metaMDS")) {
tries <- tries + previous.best$tries
}
Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog 2012-02-07 17:16:30 UTC (rev 2068)
+++ pkg/vegan/inst/ChangeLog 2012-02-07 20:25:32 UTC (rev 2069)
@@ -11,7 +11,7 @@
* adonis: added missing 'mc.cores=' for multicore parallel
processing.
- * bioenv: implemented parallel processing.
+ * bioenv, metaMDS: implemented parallel processing.
* nesteddisc: new argument 'niter' to give the number of
iterations to reorder tied columns.
Modified: pkg/vegan/man/metaMDS.Rd
===================================================================
--- pkg/vegan/man/metaMDS.Rd 2012-02-07 17:16:30 UTC (rev 2068)
+++ pkg/vegan/man/metaMDS.Rd 2012-02-07 20:25:32 UTC (rev 2069)
@@ -41,7 +41,7 @@
noshare = TRUE, trace = 1, commname, zerodist = "ignore",
distfun = vegdist, ...)
metaMDSiter(dist, k = 2, trymax = 20, trace = 1, plot = FALSE,
- previous.best, engine = "monoMDS", ...)
+ previous.best, engine = "monoMDS", parallel = getOption("mc.cores"), ...)
initMDS(x, k=2)
postMDS(X, dist, pc=TRUE, center=TRUE, halfchange, threshold=0.8,
nthreshold=10, plot=FALSE, ...)
@@ -118,6 +118,15 @@
\item{distfun}{Dissimilarity function. Any function returning a
\code{dist} object and accepting argument \code{method} can be used
(but some extra arguments may cause name conflicts).}
+
+ \item{parallel}{Number of parallel processes or a predefined socket
+ cluster. If you use pre-defined socket clusters (say,
+ \code{clus}), you must issue \code{clusterEvalQ(clus,
+ library(vegan))} to make available internal \pkg{vegan}
+ functions. With \code{parallel = 1} uses ordinary, non-parallel
+ processing. The parallel processing is done with \pkg{parallel}
+ package which is available only for \R 2.14.0 and later.}
+
\item{dist}{Dissimilarity matrix used in multidimensional scaling. }
\item{pc}{Rotate to principal components. }
\item{center}{Centre the configuration. }
More information about the Vegan-commits
mailing list