From noreply at r-forge.r-project.org Sun May 5 17:58:34 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 5 May 2013 17:58:34 +0200 (CEST) Subject: [Vegan-commits] r2499 - in pkg/vegan: . R inst man Message-ID: <20130505155834.BDD2C184F60@r-forge.r-project.org> Author: jarioksa Date: 2013-05-05 17:58:34 +0200 (Sun, 05 May 2013) New Revision: 2499 Added: pkg/vegan/R/veganMahatrans.R Modified: pkg/vegan/DESCRIPTION pkg/vegan/NAMESPACE pkg/vegan/R/bioenv.default.R pkg/vegan/R/bioenv.formula.R pkg/vegan/R/print.bioenv.R pkg/vegan/inst/ChangeLog pkg/vegan/man/bioenv.Rd pkg/vegan/man/vegan-internal.Rd Log: implement Mahalanobis, Manhattan and Gower metrics for bioenv Modified: pkg/vegan/DESCRIPTION =================================================================== --- pkg/vegan/DESCRIPTION 2013-04-29 08:00:00 UTC (rev 2498) +++ pkg/vegan/DESCRIPTION 2013-05-05 15:58:34 UTC (rev 2499) @@ -1,7 +1,7 @@ Package: vegan Title: Community Ecology Package -Version: 2.1-29 -Date: April 19, 2013 +Version: 2.1-30 +Date: May 5, 2013 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/NAMESPACE =================================================================== --- pkg/vegan/NAMESPACE 2013-04-29 08:00:00 UTC (rev 2498) +++ pkg/vegan/NAMESPACE 2013-05-05 15:58:34 UTC (rev 2499) @@ -58,7 +58,7 @@ ## export(ade2vegancca, orderingKM, ordiArgAbsorber, ordiArrowMul, ## ordiGetData, ordimedian, ordiNAexclude, ordiNApredict, ## ordiParseFormula, ordiTerminfo, pregraphKM, simpleRDA2, varpart2, -## varpart3, varpart4, veganCovEllipse) +## varpart3, varpart4, veganCovEllipse, veganMahatrans) ## Registration of S3 methods import(stats) Modified: pkg/vegan/R/bioenv.default.R =================================================================== --- pkg/vegan/R/bioenv.default.R 2013-04-29 08:00:00 UTC (rev 2498) +++ pkg/vegan/R/bioenv.default.R 2013-05-05 15:58:34 UTC (rev 2499) @@ -1,8 +1,14 @@ `bioenv.default` <- function (comm, env, method = "spearman", index = "bray", upto = ncol(env), - trace = FALSE, partial = NULL, parallel = getOption("mc.cores"), + trace = FALSE, partial = NULL, + metric = c("euclidean", "mahalanobis", "manhattan", "gower"), + parallel = getOption("mc.cores"), ...) { + metric <- match.arg(metric) + method <- match.arg(method, eval(formals(cor)$method)) + if (any(sapply(env, is.factor)) && metric != "gower") + stop("you have factors in 'env': only 'metric = \"gower\"' is allowed") if (is.null(partial)) { corfun <- function(dx, dy, dz, method) { cor(dx, dy, method=method) @@ -26,13 +32,31 @@ n <- ncol(env) ntake <- 2^n - 1 ndone <- 0 + upto <- min(upto, n) if (n > 8 || trace) { if (upto < n) cat("Studying", nall <- sum(choose(n, 1:upto)), "of ") cat(ntake, "possible subsets (this may take time...)\n") flush.console() } - x <- scale(env) + ## Check metric and adapt data and distance function + if (metric == "euclidean") { + x <- scale(env, scale = TRUE) + distfun <- function(x) dist(x) + } else if (metric == "mahalanobis") { + x <- as.matrix(scale(env, scale = FALSE)) + distfun <- function(x) dist(veganMahatrans(x)) + } else if (metric == "gower") { + require(cluster) || + stop("package 'cluster' needed for factor variables in 'env'") + x <- env + distfun <- function(x) daisy(x, metric = "gower") + } else if (metric == "manhattan") { + x <- decostand(env, "range") + distfun <- function(x) dist(x, "manhattan") + } else { + stop("unknown metric") + } best <- list() if (inherits(comm, "dist")) { comdis <- comm @@ -77,18 +101,19 @@ if (isParal && nrow(sets) >= CLUSLIM*nclus) { if (isMulticore) { est <- unlist(mclapply(1:nrow(sets), function(j) - corfun(comdis, dist(x[,sets[j, ]]), partial, - method = method), + corfun(comdis, + distfun(x[,sets[j,],drop = FALSE]), + partial, method = method), mc.cores = parallel)) } else { est <- parSapply(parallel, 1:nrow(sets), function(j) - corfun(comdis, dist(x[,sets[j, ]]), partial, - method = method)) + corfun(comdis, distfun(x[,sets[j,],drop = FALSE]), + partial, method = method)) } } else { est <- sapply(1:nrow(sets), function(j) - corfun(comdis, dist(x[,sets[j, ]]), partial, - method = method)) + corfun(comdis, distfun(x[,sets[j,], drop=FALSE ]), + partial, method = method)) } best[[i]] <- list(best = sets[which.max(est), ], est = max(est)) if (trace) { @@ -98,8 +123,9 @@ flush.console() } } - out <- list(names = colnames(env), method = method, index = index, - upto = upto, models = best, partial = partpart) + out <- list(names = colnames(env), method = method, index = index, + metric = metric, upto = upto, models = best, + partial = partpart) out$call <- match.call() out$call[[1]] <- as.name("bioenv") class(out) <- "bioenv" Modified: pkg/vegan/R/bioenv.formula.R =================================================================== --- pkg/vegan/R/bioenv.formula.R 2013-04-29 08:00:00 UTC (rev 2498) +++ pkg/vegan/R/bioenv.formula.R 2013-05-05 15:58:34 UTC (rev 2499) @@ -7,12 +7,7 @@ comm <- formula[[2]] comm <- eval(comm, data, parent.frame()) formula[[2]] <- NULL - mf <- model.frame(formula, data, na.action = NULL) - if (any(sapply(mf, function(x) is.factor(x) || !is.numeric(x)))) - stop("bioenv applies only to numeric variables") - env <- attr(mf, "terms") - attr(env, "intercept") <- 0 - env <- model.matrix(env, mf) + env <- model.frame(formula, data, na.action = NULL) out <- bioenv(comm, env, ...) out$formula <- fla out$call <- match.call() Modified: pkg/vegan/R/print.bioenv.R =================================================================== --- pkg/vegan/R/print.bioenv.R 2013-04-29 08:00:00 UTC (rev 2498) +++ pkg/vegan/R/print.bioenv.R 2013-05-05 15:58:34 UTC (rev 2499) @@ -1,11 +1,12 @@ -"print.bioenv" <- +`print.bioenv` <- function (x, ...) { cat("\nCall:\n") cat(deparse(x$call), "\n") cat("\nSubset of environmental variables with best correlation to community data.\n\n") - cat("Correlations: ", x$method, "\n") - cat("Dissimilarities: ", x$index, "\n\n") + cat("Correlations: ", x$method, "\n") + cat("Dissimilarities:", x$index, "\n") + cat("Metric: ", x$metric, "\n\n") i <- which.max(lapply(x$models, function(tmp) tmp$est)) cat("Best model has", i, "parameters (max.", x$upto, "allowed):\n") cat(paste(x$names[x$models[[i]]$best], collapse = " ")) Added: pkg/vegan/R/veganMahatrans.R =================================================================== --- pkg/vegan/R/veganMahatrans.R (rev 0) +++ pkg/vegan/R/veganMahatrans.R 2013-05-05 15:58:34 UTC (rev 2499) @@ -0,0 +1,20 @@ +### Internal function for Mahalanobis transformation of the matrix. +### Mahalanobis transformation of matrix X is M = X S^(-1/2) where S +### is the covariance matrix. The inverse square root of S is found +### via eigen decomposition S = G L G^T, where G is the matrix of +### eigenvectors, and L is the diagonal matrix of eigenvalues. Thus +### S^(-1/2) = G L^(-1/2) G^T. This is an internal function so that +### input must be correct: 'x' must be a centred matrix (not a +### data.frame, not raw data). +`veganMahatrans` <- + function (x, s2, tol = 1e-8) +{ + n <- nrow(x) + if (missing(s2)) + s2 <- cov(x) + e <- eigen(s2) + k <- e$values > tol + sisqr <- e$vectors[,k, drop=FALSE] %*% + (sqrt(1/e$values[k]) * t(e$vectors[,k, drop = FALSE])) + x %*% sisqr +} Modified: pkg/vegan/inst/ChangeLog =================================================================== --- pkg/vegan/inst/ChangeLog 2013-04-29 08:00:00 UTC (rev 2498) +++ pkg/vegan/inst/ChangeLog 2013-05-05 15:58:34 UTC (rev 2499) @@ -2,8 +2,23 @@ VEGAN DEVEL VERSIONS at http://r-forge.r-project.org/ -Version 2.1-29 (opened April 19, 2013) +Version 2.1-30 (opened May 5, 2013) + * bioenv: can now use Mahalanobis, Manhattan and Gower distances + for environmental variables. The Mahalanobis distances are based + on orthogonalized data, Manhattan distances give the direct sum of + differences of environmental variables, and Gower distances can + also handle factor variables. This involves adding internal + function veganMahatrans() for Mahalanobis transformation. The + change was triggered by a recent email by Lydia Beaudrot (UC + Davis) to implement Mahalanobis distances, and in the same I + also implemented Robby Marotte's suggestion of using Gower + distances (vegan Forum item in R-Forge in July 2012). The output + is changed to show the 'metric' and the name of the 'method' is + fully expanded. No more fails if 'upto' is too large. + +Version 2.1-29 (closed April 19, 2013) + * ordisurf: significant changes were made to this function: - The default for `method` and `select` were changed to `"REML"` Modified: pkg/vegan/man/bioenv.Rd =================================================================== --- pkg/vegan/man/bioenv.Rd 2013-04-29 08:00:00 UTC (rev 2498) +++ pkg/vegan/man/bioenv.Rd 2013-05-05 15:58:34 UTC (rev 2499) @@ -14,6 +14,7 @@ \usage{ \method{bioenv}{default}(comm, env, method = "spearman", index = "bray", upto = ncol(env), trace = FALSE, partial = NULL, + metric = c("euclidean", "mahalanobis", "manhattan", "gower"), parallel = getOption("mc.cores"), ...) \method{bioenv}{formula}(formula, data, ...) } @@ -30,6 +31,8 @@ \item{trace}{Trace the calculations } \item{partial}{Dissimilarities partialled out when inspecting variables in \code{env}.} + \item{metric}{Metric used for distances of environmental distances. See + Details.} \item{parallel}{Number of parallel processes or a predefined socket cluster. With \code{parallel = 1} uses ordinary, non-parallel processing. The parallel processing is done with \pkg{parallel} @@ -37,17 +40,33 @@ \item{...}{Other arguments passed to \code{\link{cor}}.} } \details{ + The function calculates a community dissimilarity matrix using \code{\link{vegdist}}. Then it selects all possible subsets of environmental variables, \code{\link{scale}}s the variables, and calculates Euclidean distances for this subset using - \code{\link{dist}}. Then it finds the correlation between community - dissimilarities and environmental distances, and for each size of - subsets, saves the best result. - There are \eqn{2^p-1} subsets of \eqn{p} variables, and an exhaustive - search may take a very, very, very long time (parameter \code{upto} offers a - partial relief). + \code{\link{dist}}. The function finds the correlation between + community dissimilarities and environmental distances, and for each + size of subsets, saves the best result. There are \eqn{2^p-1} + subsets of \eqn{p} variables, and an exhaustive search may take a + very, very, very long time (parameter \code{upto} offers a partial + relief). + The argument \code{metric} defines distances in the given set of + environmental variables. With \code{metric = "euclidean"}, the + variables are scaled to unit variance and Euclidean distances are + calculated. With \code{metric = "mahalanobis"}, the Mahalanobis + distances are calculated: in addition to scaling to unit variance, + the matrix of the current set of environmental variables is also + made orthogonal (uncorrelated). With \code{metric = "manhanttan"}, + the variables are scaled to unit range and Manhattan distances are + calculated, so that the distances are sums of differences of + environmental variables. With \code{metric = "gower"}, the Gower + distances are calculated using function + \code{\link[cluster]{daisy}}. This allows also using factor + variables, but with continuous variables the results are equal to + \code{metric = "manhattan"}. + The function can be called with a model \code{\link{formula}} where the LHS is the data matrix and RHS lists the environmental variables. The formula interface is practical in selecting or transforming Modified: pkg/vegan/man/vegan-internal.Rd =================================================================== --- pkg/vegan/man/vegan-internal.Rd 2013-04-29 08:00:00 UTC (rev 2498) +++ pkg/vegan/man/vegan-internal.Rd 2013-05-05 15:58:34 UTC (rev 2499) @@ -11,6 +11,7 @@ \alias{ordiArgAbsorber} \alias{veganCovEllipse} \alias{hierParseFormula} +\alias{veganMahatrans} \title{Internal vegan functions} @@ -32,6 +33,7 @@ permuted.index(n, strata) pasteCall(call, prefix = "Call:") veganCovEllipse(cov, center = c(0, 0), scale = 1, npoints = 100) +veganMahatrans(x, s2, tol = 1e-8) hierParseFormula(formula, data) } @@ -82,6 +84,12 @@ \code{veganCovEllipse} finds the coordinates for drawing a covariance ellipse. + \code{veganMahatrans} transforms data matrix so that its Euclidean + distances are Mahalanobis distances. The input data \code{x} must be + a matrix centred by columns, and \code{s2} its covariance matrix. If + \code{s2} is not given, covariance matrix is found from \code{x} + within the function. + \code{hierParseFormula} returns a list of one matrix (left hand side) and a model frame with factors representing hierarchy levels (right hand side) to be used in \code{\link{adipart}}, From noreply at r-forge.r-project.org Sun May 5 19:07:39 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 5 May 2013 19:07:39 +0200 (CEST) Subject: [Vegan-commits] r2500 - in pkg/vegan: R inst man Message-ID: <20130505170739.F20331801EF@r-forge.r-project.org> Author: jarioksa Date: 2013-05-05 19:07:39 +0200 (Sun, 05 May 2013) New Revision: 2500 Modified: pkg/vegan/R/rankindex.R pkg/vegan/inst/ChangeLog pkg/vegan/man/rankindex.Rd Log: rankindex gained Mahalanobis and Manhattan metrics for gradients Modified: pkg/vegan/R/rankindex.R =================================================================== --- pkg/vegan/R/rankindex.R 2013-05-05 15:58:34 UTC (rev 2499) +++ pkg/vegan/R/rankindex.R 2013-05-05 17:07:39 UTC (rev 2500) @@ -1,14 +1,22 @@ "rankindex" <- function (grad, veg, indices = c("euc", "man", "gow", "bra", - "kul"), stepacross = FALSE, method = "spearman", ...) + "kul"), stepacross = FALSE, method = "spearman", + metric = c("euclidean", "mahalanobis", "manhattan", "gower"), ...) { + metric = match.arg(metric) + if (metric == "gower") + require(cluster) || stop("metric = 'gower' needs package 'cluster'") grad <- as.data.frame(grad) if (any(sapply(grad, is.factor))) { require(cluster) || stop("factors in 'grad' need package 'cluster'") message("'grad' included factors: used cluster:::daisy") span <- daisy(grad) } else { - span <- vegdist(grad, "eucl") + span <- switch(metric, + "euclidean" = dist(scale(grad, scale=TRUE)), + "mahalanobis" = dist(veganMahatrans(scale(grad, scale=FALSE))), + "manhattan" = dist(decostand(grad, "range"), "manhattan"), + "gower" = daisy(grad, metric = "gower")) } veg <- as.matrix(veg) res <- numeric(length(indices)) Modified: pkg/vegan/inst/ChangeLog =================================================================== --- pkg/vegan/inst/ChangeLog 2013-05-05 15:58:34 UTC (rev 2499) +++ pkg/vegan/inst/ChangeLog 2013-05-05 17:07:39 UTC (rev 2500) @@ -17,6 +17,11 @@ is changed to show the 'metric' and the name of the 'method' is fully expanded. No more fails if 'upto' is too large. + * rankindex: can now use Mahalanobis or Manhattan + distances. Scales automatically gradient variables to unit + variance (Euclidean) or range (Manhattan), and the scaling is + already inbuilt in Mahalanobis and Gower. + Version 2.1-29 (closed April 19, 2013) * ordisurf: significant changes were made to this function: Modified: pkg/vegan/man/rankindex.Rd =================================================================== --- pkg/vegan/man/rankindex.Rd 2013-05-05 15:58:34 UTC (rev 2499) +++ pkg/vegan/man/rankindex.Rd 2013-05-05 17:07:39 UTC (rev 2500) @@ -8,7 +8,9 @@ } \usage{ rankindex(grad, veg, indices = c("euc", "man", "gow", "bra", "kul"), - stepacross = FALSE, method = "spearman", ...) + stepacross = FALSE, method = "spearman", + metric = c("euclidean", "mahalanobis", "manhattan", "gower"), + ...) } \arguments{ @@ -23,18 +25,24 @@ with no shared species are set \code{NA} using \code{\link{no.shared}} so that indices with no fixed upper limit can also be analysed.} - \item{method}{Correlation method used. } + \item{method}{Correlation method used.} + \item{metric}{Metric to evaluate the gradient separation. See Details.} \item{...}{Other parameters to \code{\link{stepacross}}.} } \details{ - A good dissimilarity index for multidimensional scaling - should have a high rank-order similarity with gradient separation. - The function compares most indices in \code{\link{vegdist}} against - gradient separation using rank correlation coefficients in - \code{\link{cor.test}}. The gradient separation between each - point is assessed as Euclidean distance for continuous variables, and - as Gower metric for mixed data using function - \code{\link[cluster]{daisy}} when \code{grad} has factors. + A good dissimilarity index for multidimensional scaling should have + a high rank-order similarity with gradient separation. The function + compares most indices in \code{\link{vegdist}} against gradient + separation using rank correlation coefficients in + \code{\link{cor}}. The gradient separation between each point is + assessed using given \code{metric}. The default is to use Euclidean + distance of continuous variables scaled to unit variance, or to use + Gower metric for mixed data using function + \code{\link[cluster]{daisy}} when \code{grad} has factors. The other + alternatives are Mahalanabis distances which are based on + \code{grad} matrix scaled so that columns are orthogonal + (uncorrelated) and have unit variance, or Manhattan distances of + \code{grad} variables scaled to unit range. The \code{indices} argument can accept any dissimilarity indices besides the ones calculated by the @@ -85,10 +93,9 @@ \examples{ data(varespec) data(varechem) -## The next scales all environmental variables to unit variance. -## Some would use PCA transformation. -rankindex(scale(varechem), varespec) -rankindex(scale(varechem), wisconsin(varespec)) +## The variables are automatically scaled +rankindex(varechem, varespec) +rankindex(varechem, wisconsin(varespec)) ## Using non vegdist indices as functions funs <- list(Manhattan=function(x) dist(x, "manhattan"), Gower=function(x) cluster:::daisy(x, "gower"), From noreply at r-forge.r-project.org Sun May 5 19:36:48 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 5 May 2013 19:36:48 +0200 (CEST) Subject: [Vegan-commits] r2501 - in pkg/vegan: R inst man src Message-ID: <20130505173648.B915B1801EF@r-forge.r-project.org> Author: jarioksa Date: 2013-05-05 19:36:48 +0200 (Sun, 05 May 2013) New Revision: 2501 Modified: pkg/vegan/R/vegdist.R pkg/vegan/inst/ChangeLog pkg/vegan/man/vegdist.Rd pkg/vegan/src/vegdist.c Log: add Mahalanobis to vegdist Modified: pkg/vegan/R/vegdist.R =================================================================== --- pkg/vegan/R/vegdist.R 2013-05-05 17:07:39 UTC (rev 2500) +++ pkg/vegan/R/vegdist.R 2013-05-05 17:36:48 UTC (rev 2501) @@ -7,7 +7,8 @@ method <- "euclidean" METHODS <- c("manhattan", "euclidean", "canberra", "bray", "kulczynski", "gower", "morisita", "horn", "mountford", - "jaccard", "raup", "binomial", "chao", "altGower", "cao") + "jaccard", "raup", "binomial", "chao", "altGower", "cao", + "mahalanobis") method <- pmatch(method, METHODS) inm <- METHODS[method] if (is.na(method)) @@ -25,6 +26,8 @@ dQuote(inm)) if (method == 6) # gower, but no altGower x <- decostand(x, "range", 2, na.rm = TRUE, ...) + if (method == 16) # mahalanobis + x <- veganMahatrans(scale(x, scale = FALSE)) if (binary) x <- decostand(x, "pa") N <- nrow(x <- as.matrix(x)) Modified: pkg/vegan/inst/ChangeLog =================================================================== --- pkg/vegan/inst/ChangeLog 2013-05-05 17:07:39 UTC (rev 2500) +++ pkg/vegan/inst/ChangeLog 2013-05-05 17:36:48 UTC (rev 2501) @@ -22,6 +22,8 @@ variance (Euclidean) or range (Manhattan), and the scaling is already inbuilt in Mahalanobis and Gower. + * vegdist: added Mahalanobis distance. + Version 2.1-29 (closed April 19, 2013) * ordisurf: significant changes were made to this function: Modified: pkg/vegan/man/vegdist.Rd =================================================================== --- pkg/vegan/man/vegdist.Rd 2013-05-05 17:07:39 UTC (rev 2500) +++ pkg/vegan/man/vegdist.Rd 2013-05-05 17:36:48 UTC (rev 2501) @@ -28,7 +28,7 @@ \code{"euclidean"}, \code{"canberra"}, \code{"bray"}, \code{"kulczynski"}, \code{"jaccard"}, \code{"gower"}, \code{"altGower"}, \code{"morisita"}, \code{"horn"}, \code{"mountford"}, \code{"raup"} , \code{"binomial"}, - \code{"chao"} or \code{"cao"}.} + \code{"chao"}, \code{"cao"} or \code{"mahalanobis"}.} \item{binary}{Perform presence/absence standardization before analysis using \code{\link{decostand}}.} \item{diag}{Compute diagonals. } @@ -209,6 +209,13 @@ Morisita index can be used with genuine count data (integers) only. Its Horn--Morisita variant is able to handle any abundance data. + Mahalanobis distances are Euclidean distances of a matrix where + columns are centred, have unit variance, and are uncorrelated. The + index is not commonly used for community data, but it is sometimes + used for environmental variables. The calculation is based on + transforming data matrix and then using Euclidean distances + following Mardia et al. (1979). + Euclidean and Manhattan dissimilarities are not good in gradient separation without proper standardization but are still included for comparison and special needs. @@ -272,6 +279,9 @@ Krebs, C. J. (1999). \emph{Ecological Methodology.} Addison Wesley Longman. + Mardia, K.V., Kent, J.T. and Bibby, J.M. (1979). \emph{Multivariate analysis}. + Academic Press. + Mountford, M. D. (1962). An index of similarity and its application to classification problems. In: P.W.Murphy (ed.), \emph{Progress in Soil Zoology}, 43--50. Butterworths. Modified: pkg/vegan/src/vegdist.c =================================================================== --- pkg/vegan/src/vegdist.c 2013-05-05 17:07:39 UTC (rev 2500) +++ pkg/vegan/src/vegdist.c 2013-05-05 17:36:48 UTC (rev 2501) @@ -44,6 +44,7 @@ #define CHAO 13 #define GOWERDZ 14 #define CAO 15 +#define MAHALANOBIS 16 #define MATCHING 50 #define NOSHARED 99 @@ -125,7 +126,9 @@ return dist; } -/* Euclidean distance: duplicates base R */ +/* Euclidean distance: duplicates base R. If Mahalanobis + * transformation was performred in the calling routine, this will + * give Mahalanobis distances. */ double veg_euclidean(double *x, int nr, int nc, int i1, int i2) { @@ -631,6 +634,7 @@ distfun = veg_manhattan; break; case EUCLIDEAN: + case MAHALANOBIS: distfun = veg_euclidean; break; case CANBERRA: From noreply at r-forge.r-project.org Mon May 13 09:44:34 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 13 May 2013 09:44:34 +0200 (CEST) Subject: [Vegan-commits] r2502 - pkg/vegan/R Message-ID: <20130513074434.4FE24181103@r-forge.r-project.org> Author: jarioksa Date: 2013-05-13 09:44:33 +0200 (Mon, 13 May 2013) New Revision: 2502 Modified: pkg/vegan/R/veganMahatrans.R Log: use 'symmetric' eigen analysis in veganMahatrans Modified: pkg/vegan/R/veganMahatrans.R =================================================================== --- pkg/vegan/R/veganMahatrans.R 2013-05-05 17:36:48 UTC (rev 2501) +++ pkg/vegan/R/veganMahatrans.R 2013-05-13 07:44:33 UTC (rev 2502) @@ -12,7 +12,7 @@ n <- nrow(x) if (missing(s2)) s2 <- cov(x) - e <- eigen(s2) + e <- eigen(s2, symmetric = TRUE) k <- e$values > tol sisqr <- e$vectors[,k, drop=FALSE] %*% (sqrt(1/e$values[k]) * t(e$vectors[,k, drop = FALSE])) From noreply at r-forge.r-project.org Fri May 24 09:02:13 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 24 May 2013 09:02:13 +0200 (CEST) Subject: [Vegan-commits] r2503 - in pkg/vegan: R inst Message-ID: <20130524070213.F23BC18515F@r-forge.r-project.org> Author: jarioksa Date: 2013-05-24 09:02:13 +0200 (Fri, 24 May 2013) New Revision: 2503 Modified: pkg/vegan/R/bioenv.default.R pkg/vegan/inst/ChangeLog Log: bioenv passes ... to cor() like documented Modified: pkg/vegan/R/bioenv.default.R =================================================================== --- pkg/vegan/R/bioenv.default.R 2013-05-13 07:44:33 UTC (rev 2502) +++ pkg/vegan/R/bioenv.default.R 2013-05-24 07:02:13 UTC (rev 2503) @@ -10,14 +10,14 @@ if (any(sapply(env, is.factor)) && metric != "gower") stop("you have factors in 'env': only 'metric = \"gower\"' is allowed") if (is.null(partial)) { - corfun <- function(dx, dy, dz, method) { - cor(dx, dy, method=method) + corfun <- function(dx, dy, dz, method, ...) { + cor(dx, dy, method=method, ...) } } else { - corfun <- function(dx, dy, dz, method) { - rxy <- cor(dx, dy, method=method) - rxz <- cor(dx, dz, method=method) - ryz <- cor(dy, dz, method=method) + corfun <- function(dx, dy, dz, method, ...) { + rxy <- cor(dx, dy, method=method, ...) + rxz <- cor(dx, dz, method=method, ...) + ryz <- cor(dy, dz, method=method, ...) (rxy - rxz*ryz)/sqrt(1-rxz*rxz)/sqrt(1-ryz*ryz) } } @@ -103,17 +103,17 @@ est <- unlist(mclapply(1:nrow(sets), function(j) corfun(comdis, distfun(x[,sets[j,],drop = FALSE]), - partial, method = method), + partial, method = method, ...), mc.cores = parallel)) } else { est <- parSapply(parallel, 1:nrow(sets), function(j) corfun(comdis, distfun(x[,sets[j,],drop = FALSE]), - partial, method = method)) + partial, method = method, ...)) } } else { est <- sapply(1:nrow(sets), function(j) corfun(comdis, distfun(x[,sets[j,], drop=FALSE ]), - partial, method = method)) + partial, method = method, ...)) } best[[i]] <- list(best = sets[which.max(est), ], est = max(est)) if (trace) { Modified: pkg/vegan/inst/ChangeLog =================================================================== --- pkg/vegan/inst/ChangeLog 2013-05-13 07:44:33 UTC (rev 2502) +++ pkg/vegan/inst/ChangeLog 2013-05-24 07:02:13 UTC (rev 2503) @@ -11,11 +11,12 @@ also handle factor variables. This involves adding internal function veganMahatrans() for Mahalanobis transformation. The change was triggered by a recent email by Lydia Beaudrot (UC - Davis) to implement Mahalanobis distances, and in the same I - also implemented Robby Marotte's suggestion of using Gower - distances (vegan Forum item in R-Forge in July 2012). The output - is changed to show the 'metric' and the name of the 'method' is - fully expanded. No more fails if 'upto' is too large. + Davis) to implement Mahalanobis distances, and in the same I also + implemented Robby Marotte's suggestion of using Gower distances + (vegan Forum item in R-Forge in July 2012). The output is changed + to show the 'metric' and the name of the 'method' is fully + expanded. No more fails if 'upto' is too large. Passes "..." to + cor() like documented, but never done. * rankindex: can now use Mahalanobis or Manhattan distances. Scales automatically gradient variables to unit From noreply at r-forge.r-project.org Tue May 28 17:42:43 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 28 May 2013 17:42:43 +0200 (CEST) Subject: [Vegan-commits] r2504 - pkg/vegan/man Message-ID: <20130528154243.8AB77185581@r-forge.r-project.org> Author: psolymos Date: 2013-05-28 17:42:43 +0200 (Tue, 28 May 2013) New Revision: 2504 Modified: pkg/vegan/man/adipart.Rd Log: ambiguous index notation fixed Modified: pkg/vegan/man/adipart.Rd =================================================================== --- pkg/vegan/man/adipart.Rd 2013-05-24 07:02:13 UTC (rev 2503) +++ pkg/vegan/man/adipart.Rd 2013-05-28 15:42:43 UTC (rev 2504) @@ -93,7 +93,7 @@ At the highest sampling level, the diversity components are calculated as \deqn{\beta_m = \gamma - \alpha_m}{beta_m = gamma - alpha_m} For each lower sampling level as \deqn{\beta_i = \alpha_{i+1} - - \alpha_i}{beta_i = alpha_i+1 - alpha_i} Then, the additive partition + \alpha_i}{beta_i = alpha_(i+1) - alpha_i} Then, the additive partition of diversity is \deqn{\gamma = \alpha_1 + \sum_{i=1}^m \beta_i}{gamma = alpha_1 + sum(beta_i)}