[Analogue-commits] r316 - in pkg: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 22 06:59:33 CET 2013
Author: gsimpson
Date: 2013-03-22 06:59:32 +0100 (Fri, 22 Mar 2013)
New Revision: 316
Added:
pkg/R/scores.timetrack.R
Modified:
pkg/NAMESPACE
pkg/R/fitted.timetrack.R
pkg/R/plot.timetrack.R
pkg/R/timetrack.R
pkg/inst/ChangeLog
pkg/man/timetrack.Rd
Log:
add a proper formula implementation in timetrack; adds a scores method; change argument name in fitted method
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2013-03-21 22:11:50 UTC (rev 315)
+++ pkg/NAMESPACE 2013-03-22 05:59:32 UTC (rev 316)
@@ -138,6 +138,7 @@
S3method(roc, analog)
S3method(roc, mat)
S3method(scores, prcurve)
+S3method(scores, timetrack)
S3method(stdError, mat)
S3method(stdError, predict.mat)
S3method("setK<-", default)
Modified: pkg/R/fitted.timetrack.R
===================================================================
--- pkg/R/fitted.timetrack.R 2013-03-21 22:11:50 UTC (rev 315)
+++ pkg/R/fitted.timetrack.R 2013-03-22 05:59:32 UTC (rev 316)
@@ -1,14 +1,14 @@
`fitted.timetrack` <-
- function(object, type = c("passive", "ordination"),
+ function(object, which = c("passive", "ordination"),
model = NULL, choices = 1:2, ...)
{
- if(missing(type))
- type <- "passive"
- type <- match.arg(type)
+ if(missing(which))
+ which <- "passive"
+ which <- match.arg(which)
model <- if(is.null(model)) {
if(is.null(object$ordination$CCA)) "CA" else "CCA"
}
- if(isTRUE(all.equal(type, "passive"))) {
+ if(isTRUE(all.equal(which, "passive"))) {
fit <- fitted(unclass(object), ...)[, choices, drop = FALSE]
} else {
fit <- fitted(object$ordination, model = model,
Modified: pkg/R/plot.timetrack.R
===================================================================
--- pkg/R/plot.timetrack.R 2013-03-21 22:11:50 UTC (rev 315)
+++ pkg/R/plot.timetrack.R 2013-03-22 05:59:32 UTC (rev 316)
@@ -8,10 +8,19 @@
...) {
ptype <- match.arg(ptype)
display <- match.arg(display)
+ scrs <- scores(x$ord, choices = choices, scaling = x$scaling,
+ display = display, ...)
+ pass <- fitted(x, type = "passive", choices = choices)
+ xlim <- range(scrs[,1], pass[,1])
+ ylim <- range(scrs[,2], pass[,2])
+ ## plt <- plot(x$ord, choices = choices, scaling = x$scaling,
+ ## type = "p", display = display, ...,
+ ## ylim = ylim, xlim = xlim,
+ ## pch = pch[1], col = col[1])
plt <- plot(x$ord, choices = choices, scaling = x$scaling,
- type = "p", display = display, ...,
- pch = pch[1], col = col[1])
- pass <- fitted(x, type = "passive", choices = choices)
+ type = "n", display = display, ...,
+ ylim = ylim, xlim = xlim)
+ points(scrs, pch = pch[1], col = col[1], ...)
if(!missing(order)) {
if(length(order) != NROW(pass))
stop("'length(order)' not equal to number of passive samples.")
Added: pkg/R/scores.timetrack.R
===================================================================
--- pkg/R/scores.timetrack.R (rev 0)
+++ pkg/R/scores.timetrack.R 2013-03-22 05:59:32 UTC (rev 316)
@@ -0,0 +1,11 @@
+`scores.timetrack` <- function(x, which = c("passive","ordination"),
+ scaling = x$scaling, choices = 1:2,
+ ...) {
+ which <- match.arg(which)
+ scrs <- if(which == "passive") {
+ fitted(x, which = which, choices = choices, ...)
+ } else {
+ scores(x, ..., choices = choices, scaling = scaling)
+ }
+ scrs
+}
Modified: pkg/R/timetrack.R
===================================================================
--- pkg/R/timetrack.R 2013-03-21 22:11:50 UTC (rev 315)
+++ pkg/R/timetrack.R 2013-03-22 05:59:32 UTC (rev 316)
@@ -41,13 +41,21 @@
formula <- FALSE
ord <- FUN(X = X, Y = env, ...)
} else {
- ord <- FUN(formula = formula, ...)
+ mf <- match.call(expand.dots = FALSE)
+ m <- match(c("X","passive","env","transform","scaling","rank",
+ "model","method","condition"), names(mf), 0L)
+ mf <- mf[-m]
+ mf[[1]] <- as.name("model.frame")
+ mt <- terms(formula, data = env, simplify = TRUE)
+ mf$formula <- formula(mt, data = env)
+ mf$data <- env
+ dots <- list(...)
+ mf[names(dots)] <- NULL
+ mf <- eval(mf, parent.frame())
+ ord <- FUN(X = X, Y = mf, ...)
}
}
## process predict args
- ##if(isTRUE(missing(type)))
- ## type <- "wa"
- ##type <- match.arg(type)
if(isTRUE(missing(model)))
model <- "CCA"
model <- match.arg(model)
@@ -79,11 +87,6 @@
invisible(x)
}
-## TODO
-## scores methods - should extract the relevant scores from
-## the 'ordination'
-## plot methods
-
## require(analogue)
## data(rlgh, swapdiat)
## mod <- timetrack(swapdiat, rlgh, transform = "hellinger",
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2013-03-21 22:11:50 UTC (rev 315)
+++ pkg/inst/ChangeLog 2013-03-22 05:59:32 UTC (rev 316)
@@ -6,6 +6,20 @@
site scores for the base ordination. The latter is the default
to maintain backwards compatability.
+ The `formula` argument was not well implemented; using it would
+ mean that `X`, the main species data, would not be transformed,
+ and you couldn't use direct variables as these would not be found.
+
+ Now `formula` takes a one-sided formula describing the constraints.
+ Variables will be looked up inside the object passed to `env`. As
+ such, `env` needs to be a data frame or an object accepted as the
+ `data` argument in `model.frame()`.
+
+ The `fitted` method has changed slightly. The `type` argument
+ has been renamed `which`.
+
+ * scores: new method for objects of class "timetrack".
+
* distanceX: experimental replacement for distance() which uses
fast C code for computing dissimilarities via a .Call interface
based on base::dist().
Modified: pkg/man/timetrack.Rd
===================================================================
--- pkg/man/timetrack.Rd 2013-03-21 22:11:50 UTC (rev 315)
+++ pkg/man/timetrack.Rd 2013-03-22 05:59:32 UTC (rev 316)
@@ -3,6 +3,7 @@
\alias{print.timetrack}
\alias{plot.timetrack}
\alias{fitted.timetrack}
+\alias{scores.timetrack}
\title{Timetracks of change in species composition}
@@ -16,9 +17,12 @@
transform = "none", formula, scaling = 3,
rank = "full", model = c("CCA", "CA"), \dots)
-\method{fitted}{timetrack}(object, type = c("passive", "ordination"),
+\method{fitted}{timetrack}(object, which = c("passive", "ordination"),
model = NULL, choices = 1:2, \dots)
+\method{scores}{timetrack}(x, which = c("passive", "ordination"),
+ scaling = x$scaling, choices = 1:2, \dots)
+
\method{plot}{timetrack}(x, choices = 1:2, display = c("wa", "lc"),
order, ptype = c("l", "p", "o", "b"), pch = c(1,2),
col = c("black","red"), lty = "solid", lwd = 1, \dots)
@@ -30,9 +34,10 @@
\item{passive}{matrix-like object containing the samples to be
projected into the ordination of \code{X}. Usually a set of sediment
core samples.}
- \item{env}{optional vector or matrix of environmental or constraining
+ \item{env}{optional data frame of environmental or constraining
variables. If provided, a constrained ordination of \code{X} is
- performed.}
+ performed. If \code{formula} is supplied variables named in
+ \code{formula} are looked up with \code{env}.}
\item{method}{character, resolving to an ordination function available
in \pkg{vegan}. Currently only \code{"cca"}, the default, and
\code{"rda"} are supported.}
@@ -40,9 +45,11 @@
both \code{X} and \code{passive}. The transformations are performed
using \code{tran} and valid options are given by that function's
\code{method} argument.}
- \item{formula}{a model formula; if provided, it defines the model
- formula for the ordination function and is supplied as argument
- \code{formula} to the ordination function.}
+ \item{formula}{a one-sided model formula; if provided, it defines the
+ right hand side of the model formula for the ordination function and
+ is supplied as argument \code{formula} to the ordination
+ function. E.g.~\code{formula = ~ var1 + var2}. If supplied then
+ \code{env} must also be supplied}
\item{scaling}{numeric; the ordination scaling to apply. Useful
options are likely to be \code{1} or \code{3} where the focus is on
the samples.}
@@ -51,7 +58,7 @@
\item{model}{character; see argument of same name in function
\code{\link[vegan]{cca}} or \code{\link[vegan]{rda}}.}
\item{object, x}{an object of class \code{"timetrack"}.}
- \item{type}{character; which fitted values should be returned?}
+ \item{which}{character; which fitted values should be returned?}
\item{choices}{numeric; the length-2 vector of ordination axes to
plot.}
\item{display}{character; which type of sites scores to display? See
@@ -104,8 +111,8 @@
\value{
The \code{plot} method results in a plot on the currently active
- device, whilst the \code{fitted} method returns the matrix of fitted
- locations on the set of ordination axes.
+ device, whilst the \code{fitted} and \code{scores} methods return the
+ matrix of fitted locations on the set of ordination axes.
\code{timetrack} returns an object of class \code{"timetrack"}, a list
with the following components:
@@ -162,6 +169,18 @@
ord <- rev(seq_len(nrow(rlgh)))
plot(mod, choices = 2:3, order = ord, ptype = "b",
col = c("forestgreen", "orange"), lwd = 2)
+
+## illustrating use of the formula
+data(swappH)
+mod2 <- timetrack(swapdiat, rlgh, env = data.frame(pH = swappH),
+ transform = "hellinger", method = "rda",
+ formula = ~ pH)
+mod2
+plot(mod2)
+
+## scores and fitted methods
+head(fitted(mod, type = "passive"))
+head(scores(mod, type = "passive"))
}
% Add one or more standard keywords, see file 'KEYWORDS' in the
More information about the Analogue-commits
mailing list