[Analogue-commits] r404 - in pkg: . R inst man tests/Examples
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Feb 11 21:04:32 CET 2014
Author: gsimpson
Date: 2014-02-11 21:04:31 +0100 (Tue, 11 Feb 2014)
New Revision: 404
Added:
pkg/R/points.timetrack.R
pkg/R/predict.timetrack.R
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/R/plot.timetrack.R
pkg/R/timetrack.R
pkg/inst/ChangeLog
pkg/man/timetrack.Rd
pkg/tests/Examples/analogue-Ex.Rout.save
Log:
Enhancements to timetrack; new points and predict methods; plot method enhanced; new example; bump to 0.13-3; update reference materials for checks.
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2014-02-11 18:10:37 UTC (rev 403)
+++ pkg/DESCRIPTION 2014-02-11 20:04:31 UTC (rev 404)
@@ -1,7 +1,7 @@
Package: analogue
Type: Package
Title: Analogue and weighted averaging methods for palaeoecology
-Version: 0.13-2
+Version: 0.13-3
Date: $Date$
Depends: R (>= 2.15.0), vegan (>= 1.17-12), lattice, rgl
Imports: mgcv, MASS, stats, graphics, grid, brglm, princurve
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2014-02-11 18:10:37 UTC (rev 403)
+++ pkg/NAMESPACE 2014-02-11 20:04:31 UTC (rev 404)
@@ -187,6 +187,7 @@
S3method(predict, mat)
S3method(predict, pcr)
S3method(predict, prcurve)
+S3method(predict, timetrack)
S3method(predict, wa)
S3method(residuals, bootstrap.mat)
S3method(residuals, mat)
@@ -214,6 +215,7 @@
S3method(plot, roc)
S3method(plot, sppResponse)
S3method(plot, timetrack)
+S3method(points, timetrack)
S3method(plot, wa)
S3method(plot, weightedCor)
S3method(plot3d, prcurve)
Modified: pkg/R/plot.timetrack.R
===================================================================
--- pkg/R/plot.timetrack.R 2014-02-11 18:10:37 UTC (rev 403)
+++ pkg/R/plot.timetrack.R 2014-02-11 20:04:31 UTC (rev 404)
@@ -1,22 +1,30 @@
`plot.timetrack` <- function(x, choices = 1:2,
display = c("wa","lc"),
order,
- ptype = c("l", "p", "o", "b"),
+ type = c("p", "n"),
+ ptype = c("l", "p", "o", "b", "n"),
pch = c(1,2),
col = c("black","red"),
lty = "solid", lwd = 1,
- ...) {
+ xlim = NULL, ylim = NULL, ...) {
ptype <- match.arg(ptype)
+ type <- match.arg(type)
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])
+ if (is.null(xlim)) {
+ xlim <- range(scrs[,1], pass[,1])
+ }
+ if (is.null(ylim)) {
+ ylim <- range(scrs[,2], pass[,2])
+ }
plt <- plot(x$ord, choices = choices, scaling = x$scaling,
type = "n", display = display, ...,
ylim = ylim, xlim = xlim)
- points(scrs, pch = pch[1], col = col[1], ...)
+ if (isTRUE(all.equal(type, "p"))) {
+ 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.")
@@ -25,7 +33,7 @@
if(ptype %in% c("l", "o", "b")) {
lines(pass, pch = pch[2], col = col[2],
lty = lty, lwd = lwd, type = ptype, ...)
- } else {
+ } else if (isTRUE(all.equal(ptype, "p"))) {
points(pass, pch = pch[2], col = col[2], ...)
}
invisible(x$ord)
Added: pkg/R/points.timetrack.R
===================================================================
--- pkg/R/points.timetrack.R (rev 0)
+++ pkg/R/points.timetrack.R 2014-02-11 20:04:31 UTC (rev 404)
@@ -0,0 +1,23 @@
+`points.timetrack` <- function(x, choices = 1:2,
+ which = c("passive", "ordination"),
+ display = c("wa","lc"),
+ order,
+ ...) {
+ display <- match.arg(display)
+ which <- match.arg(which)
+
+ ## Select the coordinates for the relevant type of sample
+ if (isTRUE(all.equal(which, "ordination"))) {
+ scrs <- scores(x$ord, choices = choices, scaling = x$scaling,
+ display = display, ...)
+ } else {
+ scrs <- fitted(x, type = "passive", choices = choices)
+ if(!missing(order)) {
+ if(length(order) != NROW(scrs))
+ stop("'length(order)' not equal to number of passive samples.")
+ scrs[order, ]
+ }
+ }
+
+ points(scrs, ...)
+}
Added: pkg/R/predict.timetrack.R
===================================================================
--- pkg/R/predict.timetrack.R (rev 0)
+++ pkg/R/predict.timetrack.R 2014-02-11 20:04:31 UTC (rev 404)
@@ -0,0 +1,31 @@
+`predict.timetrack` <- function(object, newdata, ...) {
+ namNew <- deparse(substitute(newdata))
+ ## Apply a transformation - let tran deal with arg matching
+ if(!isTRUE(all.equal(transform, "none"))) {
+ newdata <- tran(newdata, method = object$transform, ...)
+ }
+ ## merge X and passive
+ dat <- join(object$X, newdata, type = "left")
+ X <- dat[[1]]
+ newdata <- dat[[2]]
+ ## common set of species
+ tmp <- colSums(X > 0) > 0
+ X <- X[, tmp]
+ newdata <- newdata[, tmp]
+
+ ## fitted values for newdata
+ pred <- predict(object$ordination, newdata = newdata, type = "wa",
+ scaling = object$scaling, model = "CCA",
+ rank = object$rank)
+ pred2 <- predict(object$ordination, newdata = newdata, type = "wa",
+ scaling = object$scaling, model = "CA",
+ rank = object$rank)
+ pred <- cbind(pred, pred2)
+ ## return object
+ nams <- object$labels
+ nams[["passive"]] <- namNew
+ ## update object with the new passive data predictions
+ object$fitted.values <- pred
+ object$labels <- nams
+ object
+}
Modified: pkg/R/timetrack.R
===================================================================
--- pkg/R/timetrack.R 2014-02-11 18:10:37 UTC (rev 403)
+++ pkg/R/timetrack.R 2014-02-11 20:04:31 UTC (rev 404)
@@ -5,7 +5,9 @@
transform = "none",
formula, ##type = c("wa","lc"),
scaling = 3, rank = "full",
- model = c("CCA", "CA"), ...) {
+ ##model = c("CCA", "CA"),
+ ...) {
+ origX <- X ## store for later
namX <- deparse(substitute(X))
namP <- deparse(substitute(passive))
## Apply a transformation - let tran deal with arg matching
@@ -56,9 +58,9 @@
}
}
## process predict args
- if(isTRUE(missing(model)))
- model <- "CCA"
- model <- match.arg(model)
+ ##if(isTRUE(missing(model)))
+ ## model <- "CCA"
+ ##model <- match.arg(model)
## fitted values for passive
pred <- predict(ord, newdata = passive, type = "wa",
scaling = scaling, model = "CCA", rank = rank)
@@ -69,10 +71,11 @@
## return object
res <- list(ordination = ord, fitted.values = pred,
method = method, formula = formula, #type = type,
- scaling = scaling, rank = rank, model = model,
- labels = nams, call = match.call())
+ scaling = scaling, rank = rank, ##model = model,
+ labels = nams, call = match.call(),
+ X = origX, transform = transform)
class(res) <- "timetrack"
- return(res)
+ res
}
`print.timetrack` <- function(x, ...) {
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2014-02-11 18:10:37 UTC (rev 403)
+++ pkg/inst/ChangeLog 2014-02-11 20:04:31 UTC (rev 404)
@@ -1,5 +1,21 @@
analogue Change Log
+Version 0.13-3 Opened 11 Feb 2014
+
+ * timetrack: A number of additions added and improvements made:
+
+ o New `predict()` method allows additional passive points
+ to be located in the timetrack space.
+
+ o New `points()` method to allow drawing of points for
+ training or passive samples on an existing plot.
+
+ o The `plot()` method can now suppress plotting of all
+ points, for a clean canvas with axes/labelling ready to
+ accept additional plotting function calls.
+
+ These changes were made following a query by Andrew Medeiros.
+
Version 0.13-2 Opened 1 Jan 2014
* prcurve: uses `dev.hold()` & `dev.flush()` to smooth graphics
Modified: pkg/man/timetrack.Rd
===================================================================
--- pkg/man/timetrack.Rd 2014-02-11 18:10:37 UTC (rev 403)
+++ pkg/man/timetrack.Rd 2014-02-11 20:04:31 UTC (rev 404)
@@ -2,8 +2,10 @@
\alias{timetrack}
\alias{print.timetrack}
\alias{plot.timetrack}
+\alias{points.timetrack}
\alias{fitted.timetrack}
\alias{scores.timetrack}
+\alias{predict.timetrack}
\title{Timetracks of change in species composition}
@@ -15,17 +17,23 @@
\usage{
timetrack(X, passive, env, method = c("cca", "rda"),
transform = "none", formula, scaling = 3,
- rank = "full", model = c("CCA", "CA"), \dots)
+ rank = "full", \dots)
\method{fitted}{timetrack}(object, which = c("passive", "ordination"),
model = NULL, choices = 1:2, \dots)
+\method{predict}{timetrack}(object, newdata, \dots)
+
\method{scores}{timetrack}(x, which = c("ordination", "passive"),
scaling = x$scaling, choices = 1:2, display = "sites", \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)
+ order, type = c("p", "n"), ptype = c("l", "p", "o", "b", "n"),
+ pch = c(1,2), col = c("black","red"), lty = "solid", lwd = 1,
+ xlim = NULL, ylim = NULL, \dots)
+
+\method{points}{timetrack}(x, choices = 1:2, which = c("passive", "ordination"),
+ display = c("wa","lc"), order, \dots)
}
\arguments{
@@ -55,21 +63,37 @@
the samples.}
\item{rank}{character; see argument of same name in function
\code{\link[vegan]{cca}} or \code{\link[vegan]{rda}}.}
- \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{which}{character; which fitted values should be returned?}
+ \item{model}{character; which ordination component should be used for
+ the fitted values; the constrained or unconstrained part? See
+ \code{\link{fitted.cca}} for details, but essentially, one of
+ \code{"CCA"} for the constrained part and \code{"CA"} for the
+ unconstrained part. If \code{NULL}, the default, \code{"CA"} is used
+ unless the underlying ordination was constrained, in which case
+ \code{"CCA"} is used.}
\item{choices}{numeric; the length-2 vector of ordination axes to
plot.}
+ \item{newdata}{a data frame of new observations for which locations in
+ the plot (or a timetrack) are required. This need not have exactly
+ the same set of species as the fitted ordination as internally only
+ those species in \code{newdata} that were included in the data used
+ for the ordination will be retained. In addition, if a
+ transformation was applied to the species data used to fit the
+ ordination, the same transformation will be automatically applied to
+ \code{newdata} using \code{\link{tran}}.}
\item{display}{character; which type of sites scores to display? See
\code{\link{scores.cca}} for details.}
\item{order}{numeric; vector of indices to use to reorder the passive
samples. Useful to get passive samples into temporal order for
plotting with a line.}
+ \item{type}{character; the type of plotting required for the training
+ set samples. Options are \code{"p"} for points or \code{"n"} to not
+ draw training set samples.}
\item{ptype}{character; controls how the time track should be
drawn. Default is draw the passive samples connected by a line in
the order in which they appear in the data. With \code{ptype = "p"}
- no line is drawn. The other two types have their usual meaning from
+ no line is drawn. The other types have their usual meaning from
\code{\link{plot.default}}.}
\item{pch}{The length-2 vector of plotting characters. The first
element is used for the ordination samples, the second for the
@@ -79,12 +103,14 @@
passive samples.}
\item{lty, lwd}{graphical parameters for the plotted time track for
\code{ptype != "p"}.}
+ \item{xlim, ylim}{user specified axis limits for the plot.}
\item{\dots}{arguments passed to other methods.
\code{timetrack} passes arguments on to \code{tran} and the
ordination function given in \code{method}. \code{fitted} passes
arguments on to other \code{fitted} methods as
appropriate. \code{plot} passes arguments on to the underlying
- plotting functions.}
+ plotting functions. \code{predict} passes arguments on to
+ \code{\link{tran}} for use in applyign the transformation.}
}
\details{
@@ -132,22 +158,14 @@
\item{labels }{a list of names for the \code{X}, \code{passive}, and
\code{env} arguments.}
\item{call }{The matched function call.}
+ \item{X}{The training data.}
+ \item{transform}{The transformation applied, if any.}
}
-%\references{
-%% ~put references to the literature/web site here ~
-%}
-
\author{
-Gavin L. Simpson
+ Gavin L. Simpson
}
-%\note{
-%% ~~further notes~~
-%}
-
-%% ~Make other sections like Warning with \section{Warning }{....} ~
-
\seealso{
\code{\link[vegan]{cca}} and \code{\link[vegan]{rda}} for the
underlying ordination functions.
@@ -181,9 +199,22 @@
## scores and fitted methods
head(fitted(mod, type = "passive"))
head(scores(mod, type = "passive"))
+
+## predict locations in timetrack for new observations
+take <- rlgh[1:50, ]
+take <- take[ , colSums(take) > 0]
+mod3 <- predict(mod, newdata = take)
+class(mod3) ## returns a timetrack object
+take <- rlgh[-(1:50), ]
+take <- take[ , colSums(take) > 0]
+mod4 <- predict(mod, newdata = take)
+
+## build a plot up from base parts
+plot(mod, type = "n", ptype = "n")
+points(mod, which = "ordination", col = "grey", pch = 19, cex = 0.7)
+points(mod3, which = "passive", col = "red")
+points(mod4, which = "passive", col = "blue")
}
-% Add one or more standard keywords, see file 'KEYWORDS' in the
-% R documentation directory.
\keyword{methods}
\keyword{hplot}
Modified: pkg/tests/Examples/analogue-Ex.Rout.save
===================================================================
--- pkg/tests/Examples/analogue-Ex.Rout.save 2014-02-11 18:10:37 UTC (rev 403)
+++ pkg/tests/Examples/analogue-Ex.Rout.save 2014-02-11 20:04:31 UTC (rev 404)
@@ -1,5 +1,5 @@
-R version 3.0.2 Patched (2013-09-26 r64005) -- "Frisbee Sailing"
+R version 3.0.2 Patched (2013-10-07 r64035) -- "Frisbee Sailing"
Copyright (C) 2013 The R Foundation for Statistical Computing
Platform: x86_64-unknown-linux-gnu (64-bit)
@@ -26,7 +26,7 @@
Loading required package: lattice
This is vegan 2.0-10
Loading required package: rgl
-This is analogue 0.13-2
+This is analogue 0.13-3
>
> base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')
> cleanEx()
@@ -7267,8 +7267,8 @@
>
> ### Name: timetrack
> ### Title: Timetracks of change in species composition
-> ### Aliases: timetrack print.timetrack plot.timetrack fitted.timetrack
-> ### scores.timetrack
+> ### Aliases: timetrack print.timetrack plot.timetrack points.timetrack
+> ### fitted.timetrack scores.timetrack predict.timetrack
> ### Keywords: methods hplot
>
> ### ** Examples
@@ -7358,8 +7358,24 @@
115.11 0.0907404572 -0.015968707
12.11 0.1220684180 -0.237747308
>
+> ## predict locations in timetrack for new observations
+> take <- rlgh[1:50, ]
+> take <- take[ , colSums(take) > 0]
+> mod3 <- predict(mod, newdata = take)
+> class(mod3) ## returns a timetrack object
+[1] "timetrack"
+> take <- rlgh[-(1:50), ]
+> take <- take[ , colSums(take) > 0]
+> mod4 <- predict(mod, newdata = take)
>
+> ## build a plot up from base parts
+> plot(mod, type = "n", ptype = "n")
+> points(mod, which = "ordination", col = "grey", pch = 19, cex = 0.7)
+> points(mod3, which = "passive", col = "red")
+> points(mod4, which = "passive", col = "blue")
>
+>
+>
> cleanEx()
> nameEx("tran")
> ### * tran
@@ -7791,7 +7807,7 @@
> ###
> options(digits = 7L)
> base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed: 21.712 0.38 23.116 0.001 0.002
+Time elapsed: 17.35 0.299 17.92 0.001 0.002
> grDevices::dev.off()
null device
1
More information about the Analogue-commits
mailing list