[Vegan-commits] r524 - in branches/1.15: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Oct 10 11:34:07 CEST 2008
Author: jarioksa
Date: 2008-10-10 11:34:07 +0200 (Fri, 10 Oct 2008)
New Revision: 524
Added:
branches/1.15/R/head.summary.cca.R
Modified:
branches/1.15/DESCRIPTION
branches/1.15/R/fitted.radfit.R
branches/1.15/R/ordiParseFormula.R
branches/1.15/R/plot.radfit.R
branches/1.15/R/plot.radfit.frame.R
branches/1.15/R/print.radfit.R
branches/1.15/R/rad.lognormal.R
branches/1.15/R/rad.null.R
branches/1.15/R/rad.preempt.R
branches/1.15/R/rad.zipf.R
branches/1.15/R/rad.zipfbrot.R
branches/1.15/R/radfit.data.frame.R
branches/1.15/R/radfit.default.R
branches/1.15/inst/ChangeLog
branches/1.15/man/plot.cca.Rd
Log:
merged 511, 516, 519, 521, 522 and head/tail.summary.cca from pkg/
Modified: branches/1.15/DESCRIPTION
===================================================================
--- branches/1.15/DESCRIPTION 2008-10-10 08:54:54 UTC (rev 523)
+++ branches/1.15/DESCRIPTION 2008-10-10 09:34:07 UTC (rev 524)
@@ -1,7 +1,7 @@
Package: vegan
Title: Community Ecology Package
-Version: 1.15-0
-Date: September 30, 2008
+Version: 1.15-1
+Date: October 10, 2008
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: branches/1.15/R/fitted.radfit.R
===================================================================
--- branches/1.15/R/fitted.radfit.R 2008-10-10 08:54:54 UTC (rev 523)
+++ branches/1.15/R/fitted.radfit.R 2008-10-10 09:34:07 UTC (rev 524)
@@ -1,2 +1,5 @@
-"fitted.radfit" <-
-function(object, ...) sapply(object$models, fitted)
+`fitted.radfit` <-
+ function(object, ...)
+{
+ matrix(sapply(object$models, fitted), ncol=length(object$models))
+}
Copied: branches/1.15/R/head.summary.cca.R (from rev 523, pkg/R/head.summary.cca.R)
===================================================================
--- branches/1.15/R/head.summary.cca.R (rev 0)
+++ branches/1.15/R/head.summary.cca.R 2008-10-10 09:34:07 UTC (rev 524)
@@ -0,0 +1,9 @@
+`head.summary.cca` <-
+ function(x, n=6, tail = 0, ...) {
+ print(x, head=n, tail=tail, ...)
+ }
+
+`tail.summary.cca` <-
+ function(x, n=6, head = 0, ...) {
+ print(x, head=head, tail=n, ...)
+ }
Property changes on: branches/1.15/R/head.summary.cca.R
___________________________________________________________________
Name: svn:mergeinfo
+
Modified: branches/1.15/R/ordiParseFormula.R
===================================================================
--- branches/1.15/R/ordiParseFormula.R 2008-10-10 08:54:54 UTC (rev 523)
+++ branches/1.15/R/ordiParseFormula.R 2008-10-10 09:34:07 UTC (rev 524)
@@ -40,6 +40,16 @@
Y <- Y[, -xint, drop = FALSE]
}
}
+ rownames(X) <- rownames(X, do.NULL = FALSE)
+ colnames(X) <- colnames(X, do.NULL = FALSE)
+ if (!is.null(Y)) {
+ rownames(Y) <- rownames(Y, do.NULL = FALSE)
+ colnames(Y) <- colnames(Y, do.NULL = FALSE)
+ }
+ if (!is.null(Z)) {
+ rownames(Z) <- rownames(Z, do.NULL = FALSE)
+ colnames(Z) <- colnames(Z, do.NULL = FALSE)
+ }
list(X = X, Y = Y, Z = Z, terms = terms(fla, width.cutoff = 500),
terms.expand = terms(flapart, width.cutoff = 500), modelframe = mf)
}
Modified: branches/1.15/R/plot.radfit.R
===================================================================
--- branches/1.15/R/plot.radfit.R 2008-10-10 08:54:54 UTC (rev 523)
+++ branches/1.15/R/plot.radfit.R 2008-10-10 09:34:07 UTC (rev 524)
@@ -1,7 +1,11 @@
"plot.radfit" <-
function (x, BIC = FALSE, legend = TRUE, ...)
{
+ if (length(x$y) == 0)
+ stop("No species, nothing to plot")
out <- plot(x$y, ...)
+ if (length(x$y) == 1)
+ return(invisible(out))
fv <- fitted(x)
if (BIC)
k = log(length(x$y))
Modified: branches/1.15/R/plot.radfit.frame.R
===================================================================
--- branches/1.15/R/plot.radfit.frame.R 2008-10-10 08:54:54 UTC (rev 523)
+++ branches/1.15/R/plot.radfit.frame.R 2008-10-10 09:34:07 UTC (rev 524)
@@ -19,7 +19,7 @@
}
Nhm <- length(x)
Abundance <- unlist(lapply(x, function(x) x$y))
- Rank <- unlist(lapply(x, function(x) 1:length(x$y)))
+ Rank <- unlist(lapply(x, function(x) if (length(x$y) > 0) 1:length(x$y) else NULL))
Site <- unlist(lapply(x, function(x) length(x$y)))
N <- Site
sitenames <- names(Site)
@@ -28,8 +28,9 @@
order.by <- 1:Nhm
else order.by <- order(order.by)
Site <- factor(Site, levels = sitenames[order.by])
- fit <- unlist(lapply(x, function(x) fitted(x)[, pickmod(x,
- pick, BIC)]))
+ fit <- unlist(lapply(x, function(x)
+ as.matrix(fitted(x))[, pickmod(x,
+ pick, BIC)]))
take <- sapply(x, function(x) pickmod(x, pick, BIC))
take <- rep(take, N)
cols <- trellis.par.get("superpose.line")$col
@@ -59,4 +60,3 @@
}, ...)
out
}
-
Modified: branches/1.15/R/print.radfit.R
===================================================================
--- branches/1.15/R/print.radfit.R 2008-10-10 08:54:54 UTC (rev 523)
+++ branches/1.15/R/print.radfit.R 2008-10-10 09:34:07 UTC (rev 524)
@@ -5,7 +5,8 @@
cat("No. of species ", length(x$y), ", total abundance ",
sum(x$y), "\n\n", sep = "")
p <- coef(x)
- p <- formatC(p, format="g", flag = " ", digits = digits)
+ if (any(!is.na(p)))
+ p <- formatC(p, format="g", flag = " ", digits = digits)
p <- apply(p, 2, function(x) gsub("NA", " ", x))
aic <- sapply(x$models, AIC)
bic <- sapply(x$models, AIC, k = log(length(x$y)))
@@ -15,4 +16,3 @@
print(out, quote=FALSE)
invisible(x)
}
-
Modified: branches/1.15/R/rad.lognormal.R
===================================================================
--- branches/1.15/R/rad.lognormal.R 2008-10-10 08:54:54 UTC (rev 523)
+++ branches/1.15/R/rad.lognormal.R 2008-10-10 09:34:07 UTC (rev 524)
@@ -5,8 +5,19 @@
n <- length(x)
rnk <- -qnorm(ppoints(n))
fam <- family(link = "log")
- ln <- try(glm(x ~ rnk, family = fam))
- if (inherits(ln, "try-error")) {
+ ## Must be > 2 species to fit a model
+ if (length(x) > 1)
+ ln <- try(glm(x ~ rnk, family = fam))
+ if (length(x) < 2) {
+ aic <- NA
+ dev <- rdf <- 0
+ ln <- nl <- NA
+ p <- rep(NA, 2)
+ fit <- x
+ res <- rep(0, length(x))
+ wts <- rep(1, length(x))
+ }
+ else if (inherits(ln, "try-error")) {
aic <- rdf <- ln <- nl <- dev <- NA
p <- rep(NA, 2)
fit <- res <- wts <- rep(NA, length(x))
Modified: branches/1.15/R/rad.null.R
===================================================================
--- branches/1.15/R/rad.null.R 2008-10-10 08:54:54 UTC (rev 523)
+++ branches/1.15/R/rad.null.R 2008-10-10 09:34:07 UTC (rev 524)
@@ -7,11 +7,17 @@
x <- as.rad(x)
nsp <- length(x)
wt <- rep(1, nsp)
- fit <- rev(cumsum(1/nsp:1)/nsp) * sum(x)
+ if (nsp > 0) {
+ fit <- rev(cumsum(1/nsp:1)/nsp) * sum(x)
+ aic <- aicfun(x, nsp, fit, wt, deviance)
+ }
+ else {
+ fit <- NA
+ aic <- NA
+ }
res <- dev.resids(x, fit, wt)
deviance <- sum(res)
residuals <- x - fit
- aic <- aicfun(x, wt, fit, wt, deviance)
rdf <- nsp
p <- NA
names(p) <- "S"
@@ -21,4 +27,3 @@
class(out) <- c("radline", "glm")
out
}
-
Modified: branches/1.15/R/rad.preempt.R
===================================================================
--- branches/1.15/R/rad.preempt.R 2008-10-10 08:54:54 UTC (rev 523)
+++ branches/1.15/R/rad.preempt.R 2008-10-10 09:34:07 UTC (rev 524)
@@ -2,6 +2,8 @@
function (x, family = poisson, ...)
{
canfun <- function(p, x, ...) {
+ if (length(x) <= 1)
+ return(0)
p <- plogis(p)
if (p == 1)
p <- 1 - .Machine$double.eps
@@ -15,6 +17,7 @@
linkinv <- fam$linkinv
dev.resids <- fam$dev.resids
x <- as.rad(x)
+ nsp <- length(x)
rnk <- seq(along = x) - 1
wt <- rep(1, length(x))
logJ <- log(sum(x))
@@ -25,14 +28,21 @@
aic <- rdf <- deviance <- NA
p <- rep(NA, 1)
fit <- residuals <- prior.weights <- rep(NA, length(x))
- }
- else {
- p <- plogis(canon$estimate)
- fit <- exp(logJ + log(p) + log(1 - p) * rnk)
+ } else {
+ if (nsp > 1) {
+ p <- plogis(canon$estimate)
+ fit <- exp(logJ + log(p) + log(1 - p) * rnk)
+ } else {
+ p <- if (nsp > 0) 1 else NA
+ fit <- x
+ }
res <- dev.resids(x, fit, wt)
deviance <- sum(res)
residuals <- x - fit
- aic <- aicfun(x, rep(1, length(x)), fit, wt, deviance) + 2
+ if (nsp > 0)
+ aic <- aicfun(x, rep(1, length(x)), fit, wt, deviance) + 2
+ else
+ aic <- NA
rdf <- length(x) - 1
}
names(p) <- c("alpha")
@@ -42,4 +52,3 @@
class(out) <- c("radline", "glm")
out
}
-
Modified: branches/1.15/R/rad.zipf.R
===================================================================
--- branches/1.15/R/rad.zipf.R 2008-10-10 08:54:54 UTC (rev 523)
+++ branches/1.15/R/rad.zipf.R 2008-10-10 09:34:07 UTC (rev 524)
@@ -5,8 +5,18 @@
rnk <- seq(along = x)
off <- rep(log(sum(x)), length(x))
fam <- family(link = "log")
- ln <- try(glm(x ~ log(rnk) + offset(off), family = fam))
- if (inherits(ln, "try-error")) {
+ if (length(x) > 1)
+ ln <- try(glm(x ~ log(rnk) + offset(off), family = fam))
+ if (length(x) < 2) {
+ aic <- NA
+ dev <- rdf <- 0
+ ln <- nl <- NA
+ p <- rep(NA, 2)
+ fit <- x
+ res <- rep(0, length(x))
+ wts <- rep(1, length(x))
+ }
+ else if (inherits(ln, "try-error")) {
aic <- rdf <- ln <- nl <- dev <- NA
p <- rep(NA, 2)
fit <- res <- wts <- rep(NA, length(x))
Modified: branches/1.15/R/rad.zipfbrot.R
===================================================================
--- branches/1.15/R/rad.zipfbrot.R 2008-10-10 08:54:54 UTC (rev 523)
+++ branches/1.15/R/rad.zipfbrot.R 2008-10-10 09:34:07 UTC (rev 524)
@@ -11,9 +11,19 @@
off <- rep(log(sum(x)), length(x))
p <- 0
fam <- family(link = "log")
- nl <- try(nlm(mandelfun, p = p, x = x, rnk = rnk, off = off,
- family = fam, hessian = TRUE, ...))
- if (inherits(nl, "try-error")) {
+ if (length(x) > 2)
+ nl <- try(nlm(mandelfun, p = p, x = x, rnk = rnk, off = off,
+ family = fam, hessian = TRUE, ...))
+ if (length(x) < 3) {
+ aic <- NA
+ dev <- rdf <- 0
+ ln <- nl <- NA
+ p <- rep(NA, 3)
+ fit <- x
+ res <- rep(0, length(x))
+ wts <- rep(1, length(x))
+ }
+ else if (inherits(nl, "try-error")) {
aic <- rdf <- ln <- nl <- dev <- NA
p <- rep(NA, 3)
fit <- res <- wts <- rep(NA, length(x))
Modified: branches/1.15/R/radfit.data.frame.R
===================================================================
--- branches/1.15/R/radfit.data.frame.R 2008-10-10 08:54:54 UTC (rev 523)
+++ branches/1.15/R/radfit.data.frame.R 2008-10-10 09:34:07 UTC (rev 524)
@@ -1,6 +1,8 @@
"radfit.data.frame" <-
function(df, ...)
{
+ ## df *must* have rownames
+ rownames(df) <- rownames(df, do.NULL = TRUE)
out <- apply(df, 1, radfit, ...)
if (length(out) == 1)
out <- out[[1]]
Modified: branches/1.15/R/radfit.default.R
===================================================================
--- branches/1.15/R/radfit.default.R 2008-10-10 08:54:54 UTC (rev 523)
+++ branches/1.15/R/radfit.default.R 2008-10-10 09:34:07 UTC (rev 524)
@@ -4,7 +4,7 @@
x <- as.rad(x)
NU <- rad.null(x, ...)
PE <- rad.preempt(x, ...)
- #BS <- rad.brokenstick(x, ...)
+ ##BS <- rad.brokenstick(x, ...)
LN <- rad.lognormal(x, ...)
ZP <- rad.zipf(x, ...)
ZM <- rad.zipfbrot(x, ...)
@@ -15,4 +15,3 @@
class(out) <- "radfit"
out
}
-
Modified: branches/1.15/inst/ChangeLog
===================================================================
--- branches/1.15/inst/ChangeLog 2008-10-10 08:54:54 UTC (rev 523)
+++ branches/1.15/inst/ChangeLog 2008-10-10 09:34:07 UTC (rev 524)
@@ -3,6 +3,16 @@
VEGAN STABLE VERSIONS
+Version 1.15-1 (opened October 10, 2008)
+
+ * copied head/tail of summary.cca.
+
+ * merged r516, 519, 521: radfit fixes for 0..2 species
+ communities.
+
+ * merged 522: ordiParseFormula takes care of non-NULL row names.
+
+
Version 1.15-0 (released September 30, 2008)
* based on rev506 at http://r-forge.r-project.org/
Modified: branches/1.15/man/plot.cca.Rd
===================================================================
--- branches/1.15/man/plot.cca.Rd 2008-10-10 08:54:54 UTC (rev 523)
+++ branches/1.15/man/plot.cca.Rd 2008-10-10 09:34:07 UTC (rev 524)
@@ -7,6 +7,8 @@
\alias{summary.cca}
\alias{print.summary.cca}
\alias{ade2vegancca}
+\alias{head.summary.cca}
+\alias{tail.summary.cca}
\title{Plot or Extract Results of Constrained Correspondence Analysis
or Redundancy Analysis}
@@ -28,6 +30,8 @@
\method{summary}{cca}(object, scaling = 2, axes = 6, display = c("sp", "wa",
"lc", "bp", "cn"), digits = max(3, getOption("digits") - 3), ...)
\method{print}{summary.cca}(x, digits = x$digits, head = NA, tail = head, ...)
+\method{head}{summary.cca}(x, n = 6, tail = 0, ...)
+\method{tail}{summary.cca}(x, n = 6, head = 0, ...)
}
\arguments{
@@ -69,9 +73,9 @@
approximate original data.}
\item{axes}{Number of axes in summaries.}
\item{digits}{Number of digits in output.}
- \item{head, tail}{Number of rows printed from the head and tail of
+ \item{n, head, tail}{Number of rows printed from the head and tail of
species and site scores. Default \code{NA} prints all.}
- \item{...}{Other parameters for plotting functions.}
+ \item{...}{Parameters passed to other functions.}
}
\details{
@@ -106,9 +110,12 @@
needed components with the selected \code{scaling}.
Function \code{summary} lists all scores and the output can be very
- long. You can suppress all output for scores by setting \code{axes =
- 0} or \code{display = NA} or \code{display = NULL}.
- Palmer (1993) suggested using linear constraints
+ long. You can suppress scores by setting \code{axes = 0} or
+ \code{display = NA} or \code{display = NULL}. You can display some
+ first or last (or both) rows of scores by using \code{head} or
+ \code{tail} or explicit \code{print} command for the \code{summary}.
+
+ Palmer (1993) suggested using linear constraints
(``LC scores'') in ordination diagrams, because these gave better
results in simulations and site scores (``WA scores'') are a step from
constrained to unconstrained analysis. However, McCune (1997) showed
@@ -151,6 +158,8 @@
text(mod, dis="cn")
points(mod, pch=21, col="red", bg="yellow", cex=1.2)
text(mod, "species", col="blue", cex=0.8)
+## Limited output of 'summary'
+head(summary(mod), tail=2)
}
\keyword{hplot}
\keyword{aplot}
More information about the Vegan-commits
mailing list