[Vegan-commits] r1604 - in branches/1.17: R inst
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu May 26 13:34:31 CEST 2011
Author: jarioksa
Date: 2011-05-26 13:34:31 +0200 (Thu, 26 May 2011)
New Revision: 1604
Modified:
branches/1.17/R/add1.cca.R
branches/1.17/R/anova.ccabyaxis.R
branches/1.17/R/anova.ccabymargin.R
branches/1.17/R/anova.ccanull.R
branches/1.17/R/drop1.cca.R
branches/1.17/R/model.frame.cca.R
branches/1.17/R/model.matrix.cca.R
branches/1.17/R/scores.cca.R
branches/1.17/R/scores.rda.R
branches/1.17/inst/ChangeLog
Log:
merge r1600,2,3: janitorial changes in cca/rda support functions
Modified: branches/1.17/R/add1.cca.R
===================================================================
--- branches/1.17/R/add1.cca.R 2011-05-17 11:00:03 UTC (rev 1603)
+++ branches/1.17/R/add1.cca.R 2011-05-26 11:34:31 UTC (rev 1604)
@@ -2,6 +2,8 @@
function(object, scope, test = c("none", "permutation"),
pstep = 100, perm.max = 200, ...)
{
+ if (inherits(object, "prc"))
+ stop("'step'/'add1' cannot be used for 'prc' objects")
test <- match.arg(test)
## Default add1
out <- NextMethod("add1", object, test = "none", ...)
Modified: branches/1.17/R/anova.ccabyaxis.R
===================================================================
--- branches/1.17/R/anova.ccabyaxis.R 2011-05-17 11:00:03 UTC (rev 1603)
+++ branches/1.17/R/anova.ccabyaxis.R 2011-05-26 11:34:31 UTC (rev 1604)
@@ -1,6 +1,8 @@
-"anova.ccabyaxis" <-
-function (object, cutoff = 1, ...)
+`anova.ccabyaxis` <-
+ function (object, cutoff = 1, ...)
{
+ if(inherits(object, "prc"))
+ stop("anova(..., by = 'axis') cannot be used for 'prc' results")
cutoff <- cutoff + sqrt(.Machine$double.eps)
rnk <- object$CCA$rank
if (!max(rnk, 0))
Modified: branches/1.17/R/anova.ccabymargin.R
===================================================================
--- branches/1.17/R/anova.ccabymargin.R 2011-05-17 11:00:03 UTC (rev 1603)
+++ branches/1.17/R/anova.ccabymargin.R 2011-05-26 11:34:31 UTC (rev 1604)
@@ -1,6 +1,8 @@
`anova.ccabymargin` <-
function(object, step=100, scope, ...)
{
+ if(inherits(object, "prc"))
+ stop("anova(..., by = 'margin') cannot be used for 'prc' results")
if (!missing(scope) && is.character(scope))
trms <- scope
else
Modified: branches/1.17/R/anova.ccanull.R
===================================================================
--- branches/1.17/R/anova.ccanull.R 2011-05-17 11:00:03 UTC (rev 1603)
+++ branches/1.17/R/anova.ccanull.R 2011-05-26 11:34:31 UTC (rev 1604)
@@ -25,7 +25,10 @@
else
head <- c("!!!!! ERROR !!!!!\n")
head <- c(head, paste("Model:", c(object$call)))
- seed <- get(".Random.seed", envir = .GlobalEnv, inherits = FALSE)
+ if (exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE))
+ seed <- get(".Random.seed", envir = .GlobalEnv, inherits = FALSE)
+ else
+ seed <- NULL
structure(table, heading = head, Random.seed = seed,
class = c("anova.cca", "anova", "data.frame"))
}
Modified: branches/1.17/R/drop1.cca.R
===================================================================
--- branches/1.17/R/drop1.cca.R 2011-05-17 11:00:03 UTC (rev 1603)
+++ branches/1.17/R/drop1.cca.R 2011-05-26 11:34:31 UTC (rev 1604)
@@ -2,6 +2,8 @@
function(object, scope, test = c("none", "permutation"),
pstep = 100, perm.max = 200, ...)
{
+ if (inherits(object, "prc"))
+ stop("'step'/'drop1' cannot be used for 'prc' objects")
test <- match.arg(test)
out <- NextMethod("drop1", object, test="none", ...)
cl <- class(out)
Modified: branches/1.17/R/model.frame.cca.R
===================================================================
--- branches/1.17/R/model.frame.cca.R 2011-05-17 11:00:03 UTC (rev 1603)
+++ branches/1.17/R/model.frame.cca.R 2011-05-26 11:34:31 UTC (rev 1604)
@@ -1,6 +1,8 @@
`model.frame.cca` <-
function (formula, ...)
{
+ if (inherits(formula, "prc"))
+ stop("model.frame does not work with 'prc' results")
call <- formula$call
m <- match(c("formula", "data", "na.action", "subset"), names(call),
0)
Modified: branches/1.17/R/model.matrix.cca.R
===================================================================
--- branches/1.17/R/model.matrix.cca.R 2011-05-17 11:00:03 UTC (rev 1603)
+++ branches/1.17/R/model.matrix.cca.R 2011-05-26 11:34:31 UTC (rev 1604)
@@ -1,6 +1,8 @@
`model.matrix.cca` <-
function (object, ...)
{
+ if (inherits(object, "prc"))
+ stop("model.matrix does not work with 'prc' results")
call <- object$call
m <- match(c("formula", "data", "na.action", "subset"), names(call),
0)
Modified: branches/1.17/R/scores.cca.R
===================================================================
--- branches/1.17/R/scores.cca.R 2011-05-17 11:00:03 UTC (rev 1603)
+++ branches/1.17/R/scores.cca.R 2011-05-26 11:34:31 UTC (rev 1604)
@@ -91,11 +91,13 @@
}
}
## Take care that scores have names
- for (i in 1:length(sol)) {
- if (is.matrix(sol[[i]]))
- rownames(sol[[i]]) <-
- rownames(sol[[i]], do.NULL = FALSE,
- prefix = substr(names(sol)[i], 1, 3))
+ if (length(sol)) {
+ for (i in 1:length(sol)) {
+ if (is.matrix(sol[[i]]))
+ rownames(sol[[i]]) <-
+ rownames(sol[[i]], do.NULL = FALSE,
+ prefix = substr(names(sol)[i], 1, 3))
+ }
}
## Only one type of scores: return a matrix instead of a list
if (length(sol) == 1)
Modified: branches/1.17/R/scores.rda.R
===================================================================
--- branches/1.17/R/scores.rda.R 2011-05-17 11:00:03 UTC (rev 1603)
+++ branches/1.17/R/scores.rda.R 2011-05-26 11:34:31 UTC (rev 1604)
@@ -94,11 +94,13 @@
}
}
## Take care that scores have names
- for (i in 1:length(sol)) {
- if (is.matrix(sol[[i]]))
- rownames(sol[[i]]) <-
- rownames(sol[[i]], do.NULL = FALSE,
- prefix = substr(names(sol)[i], 1, 3))
+ if (length(sol)) {
+ for (i in 1:length(sol)) {
+ if (is.matrix(sol[[i]]))
+ rownames(sol[[i]]) <-
+ rownames(sol[[i]], do.NULL = FALSE,
+ prefix = substr(names(sol)[i], 1, 3))
+ }
}
## Only one type of scores: return a matrix instead of a list
if (length(sol) == 1)
Modified: branches/1.17/inst/ChangeLog
===================================================================
--- branches/1.17/inst/ChangeLog 2011-05-17 11:00:03 UTC (rev 1603)
+++ branches/1.17/inst/ChangeLog 2011-05-26 11:34:31 UTC (rev 1604)
@@ -4,6 +4,15 @@
Version 1.17-11 (opened April 29, 2011)
+ * merged r1603: cca/rda support functions failed with prc() and
+ now refuse its results.
+
+ * merged r1602: scores.cca/rda failed if user asked only for
+ non-existing type of scores.
+
+ * merged r1600: anova.cccanull checks that seed exists before
+ trying to get it.
+
* merged r1598: doc of nobs in cca.object.Rd.
* nobs: copied nobs() methods for vegan from r1596.
More information about the Vegan-commits
mailing list