From noreply at r-forge.r-project.org Wed Mar 4 12:14:30 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 4 Mar 2015 12:14:30 +0100 (CET) Subject: [Vegan-commits] r2934 - pkg/vegan/R Message-ID: <20150304111430.32BE6185546@r-forge.r-project.org> Author: jarioksa Date: 2015-03-04 12:14:29 +0100 (Wed, 04 Mar 2015) New Revision: 2934 Modified: pkg/vegan/R/adonis.R pkg/vegan/R/anosim.R pkg/vegan/R/bioenv.default.R Log: Merge branch 'cran-2.2' into r-forge-svn-local Modified: pkg/vegan/R/adonis.R =================================================================== --- pkg/vegan/R/adonis.R 2015-02-23 08:41:47 UTC (rev 2933) +++ pkg/vegan/R/adonis.R 2015-03-04 11:14:29 UTC (rev 2934) @@ -25,6 +25,8 @@ grps <- grps[qrhs$pivot][1:qrhs$rank] u.grps <- unique(grps) nterms <- length(u.grps) - 1 + if (nterms < 1) + stop("right-hand-side of formula has no usable terms") H.s <- lapply(2:length(u.grps), function(j) {Xj <- rhs[, grps %in% u.grps[1:j] ] qrX <- qr(Xj, tol=TOL) Modified: pkg/vegan/R/anosim.R =================================================================== --- pkg/vegan/R/anosim.R 2015-02-23 08:41:47 UTC (rev 2933) +++ pkg/vegan/R/anosim.R 2015-03-04 11:14:29 UTC (rev 2934) @@ -14,6 +14,8 @@ warning("some dissimilarities are negative -- is this intentional?") sol <- c(call = match.call()) grouping <- as.factor(grouping) + if (length(levels(grouping)) < 2) + stop("there should be more than one class level") matched <- function(irow, icol, grouping) { grouping[irow] == grouping[icol] } Modified: pkg/vegan/R/bioenv.default.R =================================================================== --- pkg/vegan/R/bioenv.default.R 2015-02-23 08:41:47 UTC (rev 2933) +++ pkg/vegan/R/bioenv.default.R 2015-03-04 11:14:29 UTC (rev 2934) @@ -29,7 +29,16 @@ partial <- dist(partial) if (!is.null(partial) && !pmatch(method, c("pearson", "spearman"), nomatch=FALSE)) stop("method ", method, " invalid in partial bioenv") + ## remove constant variables + constant <- apply(env, 2, function(x) length(unique(x))) <= 1 + if (any(constant)) { + warning("the following variables are constant and were removed: ", + paste(colnames(env)[constant], collapse=", ")) + env <- env[, !constant, drop = FALSE] + } n <- ncol(env) + if (n < 1) + stop("no usable variables in 'env'") ntake <- 2^n - 1 ndone <- 0 upto <- min(upto, n) From noreply at r-forge.r-project.org Wed Mar 4 12:24:00 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 4 Mar 2015 12:24:00 +0100 (CET) Subject: [Vegan-commits] r2935 - in pkg/vegan: R man Message-ID: <20150304112400.830F7185A3A@r-forge.r-project.org> Author: jarioksa Date: 2015-03-04 12:24:00 +0100 (Wed, 04 Mar 2015) New Revision: 2935 Modified: pkg/vegan/R/capscale.R pkg/vegan/R/ordiGetData.R pkg/vegan/R/ordiParseFormula.R pkg/vegan/man/vegan-internal.Rd Log: Merge branch 'cran-2.2' into r-forge-svn-local Modified: pkg/vegan/R/capscale.R =================================================================== --- pkg/vegan/R/capscale.R 2015-03-04 11:14:29 UTC (rev 2934) +++ pkg/vegan/R/capscale.R 2015-03-04 11:24:00 UTC (rev 2935) @@ -16,8 +16,8 @@ ## The following line was eval'ed in environment(formula), but ## that made update() fail. Rethink the line if capscale() fails ## mysteriously at this point. - X <- eval(formula[[2]], envir=parent.frame(), - enclos = environment(formula)) + X <- eval(formula[[2]], envir=environment(formula), + enclos = globalenv()) if (!inherits(X, "dist")) { comm <- X dfun <- match.fun(dfun) @@ -45,22 +45,22 @@ ## evaluate formula: ordiParseFormula will return dissimilarities ## as a symmetric square matrix (except that some rows may be ## deleted due to missing values) - fla <- update(formula, X ~ .) - environment(fla) <- environment() - d <- ordiParseFormula(fla, - if(is.data.frame(data) && !is.null(comm)) cbind(data, comm) - else data, - envdepth = 1, na.action = na.action, + d <- ordiParseFormula(formula, + data, + na.action = na.action, subset = substitute(subset)) ## ordiParseFormula subsets rows of dissimilarities: do the same - ## for columns ('comm' is handled later) - if (!is.null(d$subset)) - d$X <- d$X[, d$subset, drop = FALSE] + ## for columns ('comm' is handled later). ordiParseFormula + ## returned the original data, but we use instead the potentially + ## changed X and discard d$X. + if (!is.null(d$subset)) { + X <- as.matrix(X)[d$subset, d$subset, drop = FALSE] + } ## Delete columns if rows were deleted due to missing values if (!is.null(d$na.action)) { - d$X <- d$X[, -d$na.action, drop = FALSE] + X <- as.matrix(X)[-d$na.action, -d$na.action, drop = FALSE] } - X <- as.dist(d$X) + X <- as.dist(X) k <- attr(X, "Size") - 1 if (sqrt.dist) X <- sqrt(X) Modified: pkg/vegan/R/ordiGetData.R =================================================================== --- pkg/vegan/R/ordiGetData.R 2015-03-04 11:14:29 UTC (rev 2934) +++ pkg/vegan/R/ordiGetData.R 2015-03-04 11:24:00 UTC (rev 2935) @@ -6,5 +6,5 @@ call$na.action <- na.pass call[[2]] <- NULL call[[1]] <- as.name("model.frame") - eval(call, env) + eval(call, env, enclos = .GlobalEnv) } Modified: pkg/vegan/R/ordiParseFormula.R =================================================================== --- pkg/vegan/R/ordiParseFormula.R 2015-03-04 11:14:29 UTC (rev 2934) +++ pkg/vegan/R/ordiParseFormula.R 2015-03-04 11:24:00 UTC (rev 2935) @@ -1,5 +1,5 @@ -"ordiParseFormula" <- -function (formula, data, xlev = NULL, envdepth = 2, na.action = na.fail, +`ordiParseFormula` <- +function (formula, data, xlev = NULL, na.action = na.fail, subset = NULL) { if (missing(data)) @@ -7,7 +7,7 @@ Terms <- terms(formula, "Condition", data = data) flapart <- fla <- formula <- formula(Terms, width.cutoff = 500) specdata <- formula[[2]] - X <- eval.parent(specdata, n = envdepth) + X <- eval(specdata, environment(formula), enclos=globalenv()) ## X is usually a matrix, but it is "dist" with capscale(): X <- as.matrix(X) indPartial <- attr(Terms, "specials")$Condition @@ -19,8 +19,12 @@ Pterm <- paste(Pterm, collapse = "+") P.formula <- as.formula(paste("~", Pterm), env = environment(formula)) zlev <- xlev[names(xlev) %in% Pterm] - zmf <- model.frame(P.formula, data, na.action = na.pass, - xlev = zlev) + zmf <- if (inherits(data, "environment")) + eval(substitute( + model.frame(P.formula, na.action = na.pass, xlev = zlev)), + envir = data, enclos = .GlobalEnv) + else + model.frame(P.formula, data, na.action = na.pass, xlev = zlev) partterm <- sapply(partterm, function(x) deparse(x, width.cutoff=500)) formula <- update(formula, paste("~.-", paste(partterm, collapse = "-"))) @@ -31,8 +35,13 @@ else { if (exists("Pterm")) xlev <- xlev[!(names(xlev) %in% Pterm)] - ymf <- model.frame(formula, data, na.action = na.pass, - xlev = xlev) + + ymf <- if (inherits(data, "environment")) + eval(substitute( + model.frame(formula, na.action = na.pass, xlev = xlev)), + envir=data, enclos=.GlobalEnv) + else + model.frame(formula, data, na.action = na.pass, xlev = xlev) } ## Combine condition an constrain data frames if (!is.null(zmf)) { Modified: pkg/vegan/man/vegan-internal.Rd =================================================================== --- pkg/vegan/man/vegan-internal.Rd 2015-03-04 11:14:29 UTC (rev 2934) +++ pkg/vegan/man/vegan-internal.Rd 2015-03-04 11:24:00 UTC (rev 2935) @@ -23,8 +23,8 @@ } \usage{ ordiGetData(call, env) -ordiParseFormula(formula, data, xlev = NULL, envdepth = 2, - na.action = na.fail, subset = NULL) +ordiParseFormula(formula, data, xlev = NULL, na.action = na.fail, + subset = NULL) ordiTerminfo(d, data) ordiNAexclude(x, excluded) ordiNApredict(omit, x) @@ -54,18 +54,13 @@ matrices (dependent variables, and \code{\link{model.matrix}} of constraints and conditions, possibly \code{NULL}) needed in constrained ordination. Argument \code{xlev} is passed to - \code{\link{model.frame}} and argument \code{envdepth} specifies the - depth at which the community data (dependent data) are evaluated; - default \code{envdepth = 2} evaluates that in the environment of the - parent of the calling function, and \code{envdepth = 1} within the - calling function (see - \code{\link{eval.parent}}). \code{ordiTermInfo} finds the term + \code{\link{model.frame}}. \code{ordiTermInfo} finds the term information for constrained ordination as described in \code{\link{cca.object}}. \code{ordiNAexclude} implements \code{na.action = na.exclude} for constrained ordination finding WA scores of CCA components and site scores of unconstrained component from \code{excluded} rows of observations. Function - \code{ordiNApredict} puts pads the result object with these or with + \code{ordiNApredict} pads the result object with these or with WA scores similarly as \code{\link{napredict}}. \code{ordiArrowMul} finds a multiplier to scale a bunch of arrows to From noreply at r-forge.r-project.org Mon Mar 9 11:10:02 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 9 Mar 2015 11:10:02 +0100 (CET) Subject: [Vegan-commits] r2936 - in pkg/vegan: R inst man Message-ID: <20150309101002.C15C3183B95@r-forge.r-project.org> Author: jarioksa Date: 2015-03-09 11:10:02 +0100 (Mon, 09 Mar 2015) New Revision: 2936 Modified: pkg/vegan/R/goodness.cca.R pkg/vegan/R/goodness.rda.R pkg/vegan/inst/NEWS.Rd pkg/vegan/man/goodness.cca.Rd Log: Merge branch 'cran-2.2' into r-forge-svn-local Modified: pkg/vegan/R/goodness.cca.R =================================================================== --- pkg/vegan/R/goodness.cca.R 2015-03-04 11:24:00 UTC (rev 2935) +++ pkg/vegan/R/goodness.cca.R 2015-03-09 10:10:02 UTC (rev 2936) @@ -28,9 +28,12 @@ } v <- sweep(object[[model]]$u, 2, lambda2, "*") } + if (ncol(v) > 1) + vexp <- t(apply(v^2, 1, cumsum)) + else + vexp <- v^2 if (!missing(choices)) - v <- v[, choices, drop = FALSE] - vexp <- t(apply(v^2, 1, cumsum)) + vexp <- vexp[, choices, drop = FALSE] if (statistic == "explained") { vexp <- sweep(vexp, 1, cs, "*") if (!is.null(object$pCCA)) { @@ -39,7 +42,8 @@ Xbar <- t(Xbar) ptot <- diag(crossprod(Xbar)) tot <- tot + ptot - vexp <- sweep(vexp, 1, ptot, "+") + if (model == "CCA") + vexp <- sweep(vexp, 1, ptot, "+") } vexp <- sweep(vexp, 1, tot, "/") } Modified: pkg/vegan/R/goodness.rda.R =================================================================== --- pkg/vegan/R/goodness.rda.R 2015-03-04 11:24:00 UTC (rev 2935) +++ pkg/vegan/R/goodness.rda.R 2015-03-09 10:10:02 UTC (rev 2936) @@ -15,7 +15,7 @@ cs <- weights(object, display = display) lambda2 <- sqrt(object[[model]]$eig) if (display == "species") { - if (is.null(object$CCA)) + if (is.null(object$CCA)) Xbar <- object$CA$Xbar else Xbar <- object$CCA$Xbar v <- sweep(object[[model]]$v, 2, lambda2, "*") @@ -34,18 +34,22 @@ } v <- sweep(object[[model]]$u, 2, lambda2, "*") } + if (ncol(v) > 1) + vexp <- t(apply(v^2, 1, cumsum)) + else + vexp <- v^2 + vexp <- sweep(vexp, 1, cs, "*") if (!missing(choices)) - v <- v[, choices, drop = FALSE] - vexp <- t(apply(v^2, 1, cumsum)) - vexp <- sweep(vexp, 1, cs, "*") + vexp <- vexp[, choices, drop = FALSE] if (statistic == "explained") { if (!is.null(object$pCCA)) { Xbar <- object$pCCA$Fit if (display == "sites") Xbar <- t(Xbar) - ptot <- diag(crossprod(Xbar)) + ptot <- diag(crossprod(Xbar))/(nrow(Xbar)-1) tot <- tot + ptot - vexp <- sweep(vexp, 1, ptot, "+") + if (model == "CCA") + vexp <- sweep(vexp, 1, ptot, "+") } vexp <- sweep(vexp, 1, tot, "/") } Modified: pkg/vegan/inst/NEWS.Rd =================================================================== --- pkg/vegan/inst/NEWS.Rd 2015-03-04 11:24:00 UTC (rev 2935) +++ pkg/vegan/inst/NEWS.Rd 2015-03-09 10:10:02 UTC (rev 2936) @@ -4,6 +4,30 @@ \section{Changes in version 2.2-2}{ + \subsection{BUG FIXES}{ + \itemize{ + + \item Constrained ordination functions \code{cca}, \code{rda} + and \code{capscale} are now more robust. Scoping of data set + names and variable names is much improved. + + \item Ordination functions \code{cca} and \code{rda} silently + accepted dissimilarities as input although their analysis makes + no sense with these methods. Dissimilarities should be analysed + with distance-based redundancy analysis (\code{capscale}). + + \item The variance of the conditional component was + over-estimated in \code{goodness} of \code{rda} results, and + results were wrong for partial RDA. The \code{goodness} + functions for \code{cca} and \code{rda} were both redesigned so + that the variation of the partial component was only combined + with the constrained variance, but not with the unconstrained + component. Previously the conditional variation was combined + with both components. + + } + } % bug fixes + \subsection{NEW FEATURES}{ \itemize{ Modified: pkg/vegan/man/goodness.cca.Rd =================================================================== --- pkg/vegan/man/goodness.cca.Rd 2015-03-04 11:24:00 UTC (rev 2935) +++ pkg/vegan/man/goodness.cca.Rd 2015-03-09 10:10:02 UTC (rev 2936) @@ -51,9 +51,11 @@ \details{ Function \code{goodness} gives the diagnostic statistics for species or sites. The alternative statistics are the cumulative proportion of - inertia accounted for by the axes, and the residual distance left - unaccounted for. The conditional (\dQuote{partialled out}) constraints are - always regarded as explained and included in the statistics. + inertia accounted for up to the axes, and the residual distance left + unaccounted for. The conditional (\dQuote{partialled out}) + constraints are always regarded as explained and included in the + statistics of the constrained component with\code{model = "CCA"} + (but not in the residual component with \code{model = "CA"}). Function \code{inertcomp} decomposes the inertia into partial, constrained and unconstrained components for each site or From noreply at r-forge.r-project.org Wed Mar 11 08:18:55 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 11 Mar 2015 08:18:55 +0100 (CET) Subject: [Vegan-commits] r2937 - in pkg/vegan: . R man Message-ID: <20150311071855.8AD8F18663F@r-forge.r-project.org> Author: jarioksa Date: 2015-03-11 08:18:55 +0100 (Wed, 11 Mar 2015) New Revision: 2937 Removed: pkg/vegan/R/goodness.rda.R Modified: pkg/vegan/NAMESPACE pkg/vegan/R/goodness.cca.R pkg/vegan/man/goodness.cca.Rd Log: Merge branch 'cran-2.2' into r-forge-svn-local Redesign goodness.cca, remove goodness.rda Modified: pkg/vegan/NAMESPACE =================================================================== --- pkg/vegan/NAMESPACE 2015-03-09 10:10:02 UTC (rev 2936) +++ pkg/vegan/NAMESPACE 2015-03-11 07:18:55 UTC (rev 2937) @@ -192,7 +192,6 @@ S3method(goodness, cca) S3method(goodness, metaMDS) S3method(goodness, monoMDS) -S3method(goodness, rda) # head: utils S3method(head, summary.cca) # hiersimu: vegan Modified: pkg/vegan/R/goodness.cca.R =================================================================== --- pkg/vegan/R/goodness.cca.R 2015-03-09 10:10:02 UTC (rev 2936) +++ pkg/vegan/R/goodness.cca.R 2015-03-11 07:18:55 UTC (rev 2937) @@ -1,33 +1,53 @@ `goodness.cca` <- function (object, display = c("species", "sites"), choices, model = c("CCA", "CA"), statistic = c("explained", "distance"), - summarize = FALSE, ...) + summarize = FALSE, addpartial = TRUE, ...) { model <- match.arg(model) + display <- match.arg(display) + if (inherits(object, "capscale") && display == "species") + stop("display = \"species\" not available for 'capscale'") + if (inherits(object, "rda")) + NR <- nobs(object) - 1 + else + NR <- 1 if (is.null(object$CCA)) model <- "CA" if (is.null(object[[model]]) || object[[model]]$rank == 0) stop("model ", model, " is not available") statistic <- match.arg(statistic) - display <- match.arg(display) - cs <- if(display == "species") object$colsum else object$rowsum + if (inherits(object, "rda")) + cs <- 1 + else { + cs <- + if (display == "species") object$colsum else object$rowsum + } lambda2 <- sqrt(object[[model]]$eig) + ## collect contributions to the variation and scores + ptot <- ctot <- rtot <- 0 if (display == "species") { - if (is.null(object$CCA)) - Xbar <- object$CA$Xbar - else Xbar <- object$CCA$Xbar + if (!is.null(object$pCCA)) + ptot <- diag(crossprod(object$pCCA$Fit)) / NR + if (!is.null(object$CCA)) { + Xbar <- qr.fitted(object$CCA$QR, object$CCA$Xbar) + ctot <- diag(crossprod(Xbar)) / NR + } + if (!is.null(object$CA)) + rtot <- diag(crossprod(object$CA$Xbar)) / NR v <- sweep(object[[model]]$v, 2, lambda2, "*") - tot <- diag(crossprod(Xbar)) } else { - tot <- diag(crossprod(t(object$CA$Xbar))) + if (!is.null(object$pCCA)) + ptot <- diag(tcrossprod(object$pCCA$Fit)) / NR if (!is.null(object$CCA)) { - Xbar <- object$CCA$Xbar - Xbar <- qr.fitted(object$CCA$QR, Xbar) - tot <- tot + diag(crossprod(t(Xbar))) + Xbar <- qr.fitted(object$CCA$QR, object$CCA$Xbar) + ctot <- diag(tcrossprod(Xbar)) / NR } + if (!is.null(object$CA)) + rtot <- diag(tcrossprod(object$CA$Xbar)) / NR v <- sweep(object[[model]]$u, 2, lambda2, "*") } + v <- sweep(v, 1, sqrt(cs), "*") if (ncol(v) > 1) vexp <- t(apply(v^2, 1, cumsum)) else @@ -35,27 +55,21 @@ if (!missing(choices)) vexp <- vexp[, choices, drop = FALSE] if (statistic == "explained") { - vexp <- sweep(vexp, 1, cs, "*") - if (!is.null(object$pCCA)) { - Xbar <- object$pCCA$Fit - if (display == "sites") - Xbar <- t(Xbar) - ptot <- diag(crossprod(Xbar)) - tot <- tot + ptot - if (model == "CCA") - vexp <- sweep(vexp, 1, ptot, "+") - } + tot <- ptot + ctot + rtot + if (addpartial && model == "CCA" && !is.null(object$pCCA)) + vexp <- sweep(vexp, 1, ptot, "+") vexp <- sweep(vexp, 1, tot, "/") } else { - if (display == "sites" && (!is.null(object$CCA) || !is.null(object$pCCA))) - stop("statistic 'distance' not available for sites in constrained analysis") - vexp <- sweep(-(vexp), 1, tot/cs, "+") + tot <- rtot + if (model == "CCA") + tot <- tot + ctot + vexp <- sweep(-(vexp), 1, tot, "+") vexp[vexp < 0] <- 0 vexp <- sqrt(vexp) + vexp <- sweep(vexp, 1, sqrt(cs), "/") } if (summarize) vexp <- vexp[, ncol(vexp)] vexp } - Deleted: pkg/vegan/R/goodness.rda.R =================================================================== --- pkg/vegan/R/goodness.rda.R 2015-03-09 10:10:02 UTC (rev 2936) +++ pkg/vegan/R/goodness.rda.R 2015-03-11 07:18:55 UTC (rev 2937) @@ -1,67 +0,0 @@ -`goodness.rda` <- - function (object, display = c("species", "sites"), choices, - model = c("CCA", "CA"), statistic = c("explained", "distance"), - summarize = FALSE, ...) -{ - model <- match.arg(model) - display <- match.arg(display) - if (inherits(object, "capscale") && display == "species") - stop("display = \"species\" not available for 'capscale'") - if (is.null(object$CCA)) - model <- "CA" - if (is.null(object[[model]]) || object[[model]]$rank == 0) - stop("model ", model, " is not available") - statistic <- match.arg(statistic) - cs <- weights(object, display = display) - lambda2 <- sqrt(object[[model]]$eig) - if (display == "species") { - if (is.null(object$CCA)) - Xbar <- object$CA$Xbar - else Xbar <- object$CCA$Xbar - v <- sweep(object[[model]]$v, 2, lambda2, "*") - tot <- diag(crossprod(Xbar)/(nrow(Xbar) - 1)) - } - else { - Xbar <- object$CA$Xbar - tot <- diag(crossprod(t(Xbar))) - if (!is.null(tot)) - tot <- tot/(nrow(Xbar) - 1) - if (!is.null(object$CCA)) { - Xbar <- object$CCA$Xbar - Xbar <- qr.fitted(object$CCA$QR, Xbar) - tot <- tot + diag(crossprod(t(Xbar)))/(nrow(Xbar) - - 1) - } - v <- sweep(object[[model]]$u, 2, lambda2, "*") - } - if (ncol(v) > 1) - vexp <- t(apply(v^2, 1, cumsum)) - else - vexp <- v^2 - vexp <- sweep(vexp, 1, cs, "*") - if (!missing(choices)) - vexp <- vexp[, choices, drop = FALSE] - if (statistic == "explained") { - if (!is.null(object$pCCA)) { - Xbar <- object$pCCA$Fit - if (display == "sites") - Xbar <- t(Xbar) - ptot <- diag(crossprod(Xbar))/(nrow(Xbar)-1) - tot <- tot + ptot - if (model == "CCA") - vexp <- sweep(vexp, 1, ptot, "+") - } - vexp <- sweep(vexp, 1, tot, "/") - } - else { - if (display == "sites" && (!is.null(object$CCA) || !is.null(object$pCCA))) - stop("statistic 'distance' not available for sites in constrained analysis") - vexp <- sweep(-(vexp), 1, tot, "+") - vexp[vexp < 0] <- 0 - vexp <- sweep(sqrt(vexp), 1, cs, "/") - } - if (summarize) - vexp <- vexp[, ncol(vexp)] - vexp -} - Modified: pkg/vegan/man/goodness.cca.Rd =================================================================== --- pkg/vegan/man/goodness.cca.Rd 2015-03-09 10:10:02 UTC (rev 2936) +++ pkg/vegan/man/goodness.cca.Rd 2015-03-11 07:18:55 UTC (rev 2937) @@ -1,6 +1,5 @@ \name{goodness.cca} \alias{goodness} -\alias{goodness.rda} \alias{goodness.cca} \alias{inertcomp} \alias{spenvcor} @@ -21,7 +20,7 @@ \usage{ \method{goodness}{cca}(object, display = c("species", "sites"), choices, model = c("CCA", "CA"), statistic = c("explained", "distance"), - summarize = FALSE, ...) + summarize = FALSE, addpartial = TRUE, ...) inertcomp(object, display = c("species", "sites"), statistic = c("explained", "distance"), proportional = FALSE) spenvcor(object) @@ -33,15 +32,26 @@ \arguments{ \item{object}{A result object from \code{\link{cca}}, \code{\link{rda}} or \code{\link{capscale}}. } - \item{display}{Display \code{"species"} or \code{"sites"}. } - \item{choices}{Axes shown. Default is to show all axes of the \code{"model"}. } + + \item{display}{Display \code{"species"} or \code{"sites"}. Species + are not available in \code{\link{capscale}}. } + + \item{choices}{Axes shown. Default is to show all axes of the + \code{"model"}. } + \item{model}{Show constrained (\code{"CCA"}) or unconstrained (\code{"CA"}) results. } + \item{statistic}{Statistic used: \code{"explained"} gives the cumulative - percentage accounted for, \code{"distance"} shows the residual - distances. Distances are not available for sites in constrained or - partial analyses. } - \item{summarize}{Show only the accumulated total. } + percentage accounted for, \code{"distance"} shows the residual + distances. } + + \item{summarize}{Show only the accumulated total.} + + \item{addpartial}{Add the variation explained by conditions + (partialled out variation) to the constraints when + \code{statistic="explained"}.} + \item{proportional}{Give the inertia components as proportional for the corresponding total.} \item{names.only}{Return only names of aliased variable(s) instead of @@ -52,10 +62,7 @@ Function \code{goodness} gives the diagnostic statistics for species or sites. The alternative statistics are the cumulative proportion of inertia accounted for up to the axes, and the residual distance left - unaccounted for. The conditional (\dQuote{partialled out}) - constraints are always regarded as explained and included in the - statistics of the constrained component with\code{model = "CCA"} - (but not in the residual component with \code{model = "CA"}). + unaccounted for. Function \code{inertcomp} decomposes the inertia into partial, constrained and unconstrained components for each site or @@ -117,12 +124,6 @@ total inertia is not a meaningful concept in \code{cca}, in particular for rare species. - Function \code{vif} is defined as generic in package \pkg{car} - (\code{\link[car]{vif}}), but if you have not loaded that package - you must specify the call as \code{vif.cca}. Variance inflation - factor is useful diagnostic tool for detecting nearly collinear - constraints, but these are not a problem with algorithm used in this - package to fit a constrained ordination. } \seealso{\code{\link{cca}}, \code{\link{rda}}, \code{\link{capscale}}, From noreply at r-forge.r-project.org Thu Mar 12 08:28:07 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 12 Mar 2015 08:28:07 +0100 (CET) Subject: [Vegan-commits] r2938 - in pkg/vegan: . R man vignettes Message-ID: <20150312072807.A8FB518673D@r-forge.r-project.org> Author: jarioksa Date: 2015-03-12 08:28:07 +0100 (Thu, 12 Mar 2015) New Revision: 2938 Modified: pkg/vegan/NAMESPACE pkg/vegan/R/goodness.cca.R pkg/vegan/R/ordiArrowTextXY.R pkg/vegan/man/goodness.cca.Rd pkg/vegan/man/ordiarrows.Rd pkg/vegan/man/vegan-internal.Rd pkg/vegan/vignettes/FAQ-vegan.texi Log: Merge branch 'cran-2.2' into r-forge-svn-local export ordiArrow*, goodness.cca gains addprevious Modified: pkg/vegan/NAMESPACE =================================================================== --- pkg/vegan/NAMESPACE 2015-03-11 07:18:55 UTC (rev 2937) +++ pkg/vegan/NAMESPACE 2015-03-12 07:28:07 UTC (rev 2938) @@ -16,10 +16,10 @@ mrpp, msoplot, mso, multipart, make.commsim, nestedbetajac, nestedbetasor, nestedchecker, nesteddisc, nestedn0, nestednodf, nestedtemp, nullmodel, oecosimu, ordiareatest, -ordiR2step, ordiarrows, ordicloud, ordicluster, ordiellipse, ordigrid, +ordiR2step, ordiarrows, ordiArrowMul, ordiArrowTextXY, ordicloud, ordicluster, ordiellipse, ordigrid, ordihull, ordilabel, ordiplot, ordipointlabel, ordiresids, ordisegments, ordispider, ordisplom, ordistep, ordisurf, -orditkplot, orditorp, ordixyplot, +orditkplot, orditorp, ordixyplot, pcnm, permatfull, permatswap, permustats, permutest, poolaccum, postMDS, prc, prestondistr, prestonfit, procrustes, protest, radfit, radlattice, rankindex, rarefy, rarecurve, raupcrick, Modified: pkg/vegan/R/goodness.cca.R =================================================================== --- pkg/vegan/R/goodness.cca.R 2015-03-11 07:18:55 UTC (rev 2937) +++ pkg/vegan/R/goodness.cca.R 2015-03-12 07:28:07 UTC (rev 2938) @@ -1,7 +1,7 @@ `goodness.cca` <- function (object, display = c("species", "sites"), choices, model = c("CCA", "CA"), statistic = c("explained", "distance"), - summarize = FALSE, addpartial = TRUE, ...) + summarize = FALSE, addprevious = TRUE, ...) { model <- match.arg(model) display <- match.arg(display) @@ -56,8 +56,12 @@ vexp <- vexp[, choices, drop = FALSE] if (statistic == "explained") { tot <- ptot + ctot + rtot - if (addpartial && model == "CCA" && !is.null(object$pCCA)) - vexp <- sweep(vexp, 1, ptot, "+") + if (addprevious) { + if (!is.null(object$pCCA)) + vexp <- sweep(vexp, 1, ptot, "+") + if (model == "CA" && !is.null(object$CCA)) + vexp <- sweep(vexp, 1, ctot, "+") + } vexp <- sweep(vexp, 1, tot, "/") } else { Modified: pkg/vegan/R/ordiArrowTextXY.R =================================================================== --- pkg/vegan/R/ordiArrowTextXY.R 2015-03-11 07:18:55 UTC (rev 2937) +++ pkg/vegan/R/ordiArrowTextXY.R 2015-03-12 07:28:07 UTC (rev 2938) @@ -1,18 +1,18 @@ -### Location of the text at the point of the arrow. 'vect' are the +### Location of the text at the point of the arrow. 'x' are the ### coordinates of the arrow heads, and 'labels' are the text used to ### label these heads, '...' passes arguments (such as 'cex') to ### strwidth() and strheight(). `ordiArrowTextXY` <- - function (vect, labels, ...) + function (x, labels, ...) { w <- strwidth(labels, ...) h <- strheight(labels, ...) ## slope of arrows - b <- vect[,2]/vect[,1] + b <- x[,2]/x[,1] ## offset based on string dimensions - off <- cbind(sign(vect[,1]) * (w/2 + h/4), 0.75 * h * sign(vect[,2])) + off <- cbind(sign(x[,1]) * (w/2 + h/4), 0.75 * h * sign(x[,2])) ## move the centre of the string to the continuation of the arrow - for(i in 1:nrow(vect)) { + for(i in seq_len(nrow(x))) { move <- off[i,2] / b[i] ## arrow points to the top/bottom of the text box if (is.finite(move) && abs(move) <= abs(off[i, 1])) @@ -21,7 +21,7 @@ ## arrow points to a side of the text box move <- b[i] * off[i,1] off[i, 2] <- move - } + } } - off + vect + off + x } Modified: pkg/vegan/man/goodness.cca.Rd =================================================================== --- pkg/vegan/man/goodness.cca.Rd 2015-03-11 07:18:55 UTC (rev 2937) +++ pkg/vegan/man/goodness.cca.Rd 2015-03-12 07:28:07 UTC (rev 2938) @@ -20,7 +20,7 @@ \usage{ \method{goodness}{cca}(object, display = c("species", "sites"), choices, model = c("CCA", "CA"), statistic = c("explained", "distance"), - summarize = FALSE, addpartial = TRUE, ...) + summarize = FALSE, addprevious = TRUE, ...) inertcomp(object, display = c("species", "sites"), statistic = c("explained", "distance"), proportional = FALSE) spenvcor(object) @@ -48,9 +48,14 @@ \item{summarize}{Show only the accumulated total.} - \item{addpartial}{Add the variation explained by conditions - (partialled out variation) to the constraints when - \code{statistic="explained"}.} + \item{addprevious}{Add the variation explained by previous components + when \code{statistic="explained"}. For \code{model="CCA"} add + conditionened (partialled out) variation, and for \code{model="CA"} + add both conditioned and constrained variation. This will give + cumulative explanation. The argument has no effect when + \code{statistic="distance"}, but this will always show the residual + distance after current axis and all previous components. + } \item{proportional}{Give the inertia components as proportional for the corresponding total.} Modified: pkg/vegan/man/ordiarrows.Rd =================================================================== --- pkg/vegan/man/ordiarrows.Rd 2015-03-11 07:18:55 UTC (rev 2937) +++ pkg/vegan/man/ordiarrows.Rd 2015-03-12 07:28:07 UTC (rev 2938) @@ -2,6 +2,8 @@ \alias{ordiarrows} \alias{ordisegments} \alias{ordigrid} +\alias{ordiArrowMul} +\alias{ordiArrowTextXY} \title{Add Arrows and Line Segments to Ordination Diagrams} @@ -17,6 +19,10 @@ show.groups, label = FALSE, ...) ordigrid(ord, levels, replicates, display = "sites", lty = c(1,1), col = c(1,1), lwd = c(1,1), ...) + +ordiArrowMul(x, at = c(0,0), fill = 0.75) + +ordiArrowTextXY(x, labels, ...) } \arguments{ @@ -56,18 +62,39 @@ \item{\dots}{Parameters passed to graphical functions such as \code{\link{lines}}, \code{\link{segments}}, \code{\link{arrows}}, - or to \code{\link{scores}} to select axes and scaling etc. } + or to \code{\link{scores}} to select axes and scaling etc. } + + \item{x}{two-column matrix (or matrix-like object) containing the + coordinates of arrow heads on the two plot axes.} + + \item{at}{numeric vector of coordinates for the origin of the arrows.} + + \item{fill}{numeric; the proportion of the plot to fill by the span of + the arrows.} + + \item{labels}{vector of character strings of length \code{nrow(x)} + that are to be used to label arrows.} } \details{ Function \code{ordiarrows} draws \code{\link{arrows}} and \code{ordisegments} draws line \code{\link{segments}} between successive items in the groups. Function \code{ordigrid} draws line \code{\link{segments}} both within the groups and for the - corresponding items among the groups. } + corresponding items among the groups. + \code{ordiArrowMul} finds a multiplier to scale a bunch of arrows to + fill an ordination plot, and \code{ordiArrowTextXY} finds the + coordinates for labels of these arrows. See \code{\link{envfit}} for + an application. +} + \note{These functions add graphical items to ordination graph: You must draw a graph first. - } + + \code{ordiArrowTextXY} does not draw labels; it simply returns + coordinates at which the labels should be drawn for use with another + function, such as \code{\link{text}}. +} \author{ Jari Oksanen } \seealso{The functions pass parameters to basic graphical functions, and @@ -89,5 +116,21 @@ ordiarrows(mod, ditch, label = TRUE, show = c("6", "9"), col = 2) legend("topright", c("Control", "Pyrifos 44"), lty = 1, col = c(1,2)) + +## Biplot arrows by hand +data(varespec, varechem) +ord <- cca(varespec ~ Al + P + K, varechem) +plot(ord, display = c("species","sites")) +## biplot scores +bip <- scores(ord, choices = 1:2, display = "bp") +## scaling factor for arrows to fill 80% of plot +(mul <- ordiArrowMul(bip, fill = 0.8)) +bip.scl <- bip * mul # Scale the biplot scores +labs <- c("Al","P","K") # Arrow labels +## calculate coordinate of labels for arrows +(bip.lab <- ordiArrowTextXY(bip.scl, labels = labs)) +## draw arrows and text labels +arrows(0, 0, bip.scl[,1], bip.scl[,2], length = 0.1) +text(bip.lab, labels = labs) } \keyword{aplot } Modified: pkg/vegan/man/vegan-internal.Rd =================================================================== --- pkg/vegan/man/vegan-internal.Rd 2015-03-11 07:18:55 UTC (rev 2937) +++ pkg/vegan/man/vegan-internal.Rd 2015-03-12 07:28:07 UTC (rev 2938) @@ -8,8 +8,6 @@ \alias{centroids.cca} \alias{ordiTerminfo} \alias{pasteCall} -\alias{ordiArrowMul} -\alias{oridArrowTextXY} \alias{ordiArgAbsorber} \alias{veganCovEllipse} \alias{hierParseFormula} @@ -28,8 +26,6 @@ ordiTerminfo(d, data) ordiNAexclude(x, excluded) ordiNApredict(omit, x) -ordiArrowMul(x, at = c(0,0), fill = 0.75) -ordiArrowTextXY(vect, labels, ...) ordiArgAbsorber(..., shrink, origin, scaling, triangular, display, choices, const, FUN) centroids.cca(x, mf, wt) @@ -63,11 +59,6 @@ \code{ordiNApredict} pads the result object with these or with WA scores similarly as \code{\link{napredict}}. - \code{ordiArrowMul} finds a multiplier to scale a bunch of arrows to - fill an ordination plot, and \code{ordiArrowTextXY} finds the - coordinates for labels of these arrows. See \code{\link{envfit}} - for an application. - \code{ordiArgAbsorber} absorbs arguments of \code{\link{scores}} function of \pkg{vegan} so that these do not cause superfluous warnings in graphical function \code{FUN}. If you implement Modified: pkg/vegan/vignettes/FAQ-vegan.texi =================================================================== --- pkg/vegan/vignettes/FAQ-vegan.texi 2015-03-11 07:18:55 UTC (rev 2937) +++ pkg/vegan/vignettes/FAQ-vegan.texi 2015-03-12 07:28:07 UTC (rev 2938) @@ -8,7 +8,7 @@ @setfilename FAQ- at pkg{vegan}.info @settitle @pkg{vegan} FAQ @setchapternewpage on - at set FAQ_YEAR 2014 + at set FAQ_YEAR 2015 @afourpaper @c %**end of header @@ -25,7 +25,7 @@ Creative Commons, 543 Howard Street, 5th Floor, San Francisco, California, 94105, USA. -Copyright @copyright{} 2008-2013 Jari Oksanen +Copyright @copyright{} 2008-2015 vegan development team @end quotation @end copying @@ -638,14 +638,14 @@ used @code{arrow.mul} which is saved as an attribute of @code{biplot} scores. -An unexported function @code{ordiArrowMul} is used to find the scaling -for the current plot. You can use this function to see how arrows would -be scaled: +Function @code{ordiArrowMul} is used to find the scaling for the +current plot. You can use this function to see how arrows would be +scaled: @example sol <- cca(varespec) ef <- envfit(sol ~ ., varechem) plot(sol) -vegan:::ordiArrowMul(scores(ef, display="vectors")) +ordiArrowMul(scores(ef, display="vectors")) @end example @node I want to use Helmert or sum contrasts, What are aliased variables and how to see them?, How are environmental arrows scaled?, Ordination From noreply at r-forge.r-project.org Thu Mar 12 14:56:16 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 12 Mar 2015 14:56:16 +0100 (CET) Subject: [Vegan-commits] r2939 - www Message-ID: <20150312135616.DC0C618781A@r-forge.r-project.org> Author: jarioksa Date: 2015-03-12 14:56:16 +0100 (Thu, 12 Mar 2015) New Revision: 2939 Modified: www/NEWS.html Log: Update NEWS in preparation of 2.2-2 release Modified: www/NEWS.html =================================================================== --- www/NEWS.html 2015-03-12 07:28:07 UTC (rev 2938) +++ www/NEWS.html 2015-03-12 13:56:16 UTC (rev 2939) @@ -1,10 +1,9 @@ - -R: vegan News - - +R: vegan News + + -
NEWSR Documentation
+
NEWSR Documentation

vegan News

@@ -12,12 +11,79 @@ +

BUG FIXES

+ + + + + + + +

WINDOWS

+ + + + + + +

NEW FEATURES

@@ -84,7 +150,7 @@ bias-corrected Chao estimate of extrapolated number of species. The new formula may be unpublished, but it was derived following the guidelines of Chiu, Wang, Walther & Chao, -Biometrics 70, 671–682 (2014), +Biometrics 70, 671–682 (2014), online supplementary material.

@@ -131,7 +197,7 @@ be used both in Windows and in unix-alikes. Vegan vignette on Design decision explains the implementation (use vegandocs("decission"), and parallel package has more -extensive documentation on parallel processing in R. +extensive documentation on parallel processing in R.

The following function use parallel processing in analysing permutation statistics: adonis, anosim, @@ -194,7 +260,7 @@