[Vegan-commits] r1011 - in pkg/vegan: . R inst
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Sep 18 06:51:07 CEST 2009
Author: jarioksa
Date: 2009-09-18 06:51:06 +0200 (Fri, 18 Sep 2009)
New Revision: 1011
Modified:
pkg/vegan/DESCRIPTION
pkg/vegan/R/ordiParseFormula.R
pkg/vegan/inst/ChangeLog
Log:
fix formula interpretatation in cca/rda/capscale
Modified: pkg/vegan/DESCRIPTION
===================================================================
--- pkg/vegan/DESCRIPTION 2009-09-16 17:27:07 UTC (rev 1010)
+++ pkg/vegan/DESCRIPTION 2009-09-18 04:51:06 UTC (rev 1011)
@@ -1,7 +1,7 @@
Package: vegan
Title: Community Ecology Package
-Version: 1.16-29
-Date: September 15, 2009
+Version: 1.16-30
+Date: September 18, 2009
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/vegan/R/ordiParseFormula.R
===================================================================
--- pkg/vegan/R/ordiParseFormula.R 2009-09-16 17:27:07 UTC (rev 1010)
+++ pkg/vegan/R/ordiParseFormula.R 2009-09-18 04:51:06 UTC (rev 1011)
@@ -7,39 +7,16 @@
specdata <- formula[[2]]
X <- eval.parent(specdata, n = envdepth)
indPartial <- attr(Terms, "specials")$Condition
- mf <- Z <- NULL
+ zmf <- ymf <- Y <- Z <- NULL
formula[[2]] <- NULL
- mf <- get_all_vars(formula, data)
- ## Select a subset of data and species
- if (!is.null(subset)) {
- subset <- eval(subset,
- if (inherits(data, "data.frame")) cbind(data, X) else X,
- parent.frame())
- X <- X[subset, , drop = FALSE]
- if (NROW(mf) > 0)
- mf <- mf[subset, , drop = FALSE]
- }
- ## Get na.action attribute, remove NA and drop unused levels
- if (NCOL(mf) > 0) {
- mf <- model.frame(formula(mf), mf,
- na.action = na.action, drop.unused.levels = TRUE)
- nas <- attr(mf, "na.action")
- }
- else
- nas <- NULL
if (!is.null(indPartial)) {
partterm <- attr(Terms, "variables")[1 + indPartial]
Pterm <- sapply(partterm, function(x) deparse(x[[2]], width.cutoff=500))
Pterm <- paste(Pterm, collapse = "+")
P.formula <- as.formula(paste("~", Pterm), env = environment(formula))
zlev <- xlev[names(xlev) %in% Pterm]
- zmf <- model.frame(P.formula, mf, na.action = na.pass,
+ zmf <- model.frame(P.formula, data, na.action = na.pass,
xlev = zlev)
- Z <- model.matrix(P.formula, zmf)
- if (any(colnames(Z) == "(Intercept)")) {
- xint <- which(colnames(Z) == "(Intercept)")
- Z <- Z[, -xint, drop = FALSE]
- }
partterm <- sapply(partterm, function(x) deparse(x, width.cutoff=500))
formula <- update(formula, paste("~.-", paste(partterm,
collapse = "-")))
@@ -50,14 +27,34 @@
else {
if (exists("Pterm"))
xlev <- xlev[!(names(xlev) %in% Pterm)]
- ymf <- model.frame(formula, mf, na.action = na.pass,
+ ymf <- model.frame(formula, data, na.action = na.pass,
xlev = xlev)
- Y <- model.matrix(formula, ymf)
- if (any(colnames(Y) == "(Intercept)")) {
- xint <- which(colnames(Y) == "(Intercept)")
- Y <- Y[, -xint, drop = FALSE]
- }
}
+ ## Combine condition an constrain data frames
+ if (!is.null(zmf)) {
+ ncond <- NCOL(zmf)
+ mf <- cbind(zmf, ymf)
+ } else {
+ ncond <- 0
+ mf <- ymf
+ }
+ ## Select a subset of data and species
+ if (!is.null(subset)) {
+ subset <- eval(subset,
+ if (inherits(data, "data.frame")) cbind(data, X) else X,
+ parent.frame())
+ X <- X[subset, , drop = FALSE]
+ if (NROW(mf) > 0)
+ mf <- mf[subset, , drop = FALSE]
+ }
+ ## Get na.action attribute, remove NA and drop unused levels
+ if (NROW(mf) > 0) {
+ mf <- model.frame(formula(mf), mf, xlev = xlev,
+ na.action = na.action, drop.unused.levels = TRUE)
+ nas <- attr(mf, "na.action")
+ } else {
+ nas <- NULL
+ }
## Check and remove NA in dependent data
if (!is.null(nas)) {
excluded <- X[nas, , drop = FALSE]
@@ -65,6 +62,16 @@
} else {
excluded <- NULL
}
+ if (ncond > 0) {
+ Z <- model.matrix(P.formula, mf)
+ if (any(colnames(Z) == "(Intercept)"))
+ Z <- Z[, -which(colnames(Z) == "(Intercept)"), drop = FALSE]
+ }
+ if ((NCOL(mf) - ncond) > 0 && NROW(mf) > 0) {
+ Y <- model.matrix(formula, mf)
+ if (any(colnames(Y) == "(Intercept)"))
+ Y <- Y[, -which(colnames(Y) == "(Intercept)"), drop = FALSE]
+ }
X <- as.matrix(X)
rownames(X) <- rownames(X, do.NULL = FALSE)
colnames(X) <- colnames(X, do.NULL = FALSE)
Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog 2009-09-16 17:27:07 UTC (rev 1010)
+++ pkg/vegan/inst/ChangeLog 2009-09-18 04:51:06 UTC (rev 1011)
@@ -2,15 +2,26 @@
VEGAN DEVEL VERSIONS at http://r-forge.r-project.org/
-Version 1.16-29 (opened September 15, 2009)
+Version 1.16-30 (opened September 18, 2009)
+ FIX BUGin cca, rda & capscale interpretation of
+ formulas. This was introduced in rev 972 (Sep 1, 2009), and closed
+ in rev 1010 (Sep 18, 2009). Basically, all evaluation of 'subset'
+ and 'na.action' is done after extracting the model frames with
+ proven methods so that the first half of 'ordiParseFormula' is
+ more similar to pre-972 versions. Function 'ordiParseFormula'
+ could be re-written more elegantly, but deliberately breaking it
+ twice instead of breaking it once is just now too much.
+
+Version 1.16-29 (closed September 18, 2009)
+
* meandist: plot got an 'ylim' argument. This is practical when
users want to display several plots side by side, and requested by
Heli Suurkuukka.
* WARNING OF A BUG in cca, rda & capscale: all versions have
failed since rev 972 (Sep 1, 2009) if an argument in a model was a
- matrix. Now these things work so that tess pass, but results are
+ matrix. Now these things work so that tests pass, but results are
wrong , because get_all_vars() does not get names right for matrix
columns in the model frame. This is manifest in the example of
varpart() that uses matrix items (such as mite.pcnm). It can be
More information about the Vegan-commits
mailing list