[Analogue-commits] r228 - in pkg: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Aug 23 10:47:53 CEST 2011
Author: gsimpson
Date: 2011-08-23 10:47:53 +0200 (Tue, 23 Aug 2011)
New Revision: 228
Added:
pkg/R/gradientDist.R
pkg/R/plot.gradientDist.R
pkg/man/gradientDist.Rd
Log:
Adds gradientDist()
Added: pkg/R/gradientDist.R
===================================================================
--- pkg/R/gradientDist.R (rev 0)
+++ pkg/R/gradientDist.R 2011-08-23 08:47:53 UTC (rev 228)
@@ -0,0 +1,43 @@
+## gradientDist - function for finding distance along gradient
+## given object (a vector or something coercible to) that
+## represents the gradient position, standardise to locations
+## into the range 0, ..., 1
+gradientDist <- function(object, ...) {
+ UseMethod("gradientDist")
+}
+
+gradientDist.default <- function(object, order, na.rm = TRUE, ...) {
+ object <- as.vector(object)
+ if(missing(order))
+ order <- seq_along(object)
+ object <- object[order]
+ minD <- min(object, na.rm = na.rm)
+ k <- if(any(object < 0, na.rm = na.rm)) {
+ minD
+ } else {
+ .Machine$double.eps
+ }
+ ran <- max(object, na.rm = na.rm)
+ ran <- ran - minD
+ ran <- pmax(k, ran, na.rm = na.rm)
+ object <- object - minD
+ object <- object / ran
+ class(object) <- "gradientDist"
+ object
+}
+
+gradientDist.cca <- function(object, na.rm = TRUE, axis = 1L,
+ scaling = 0, ...) {
+ if(length(axis) > 1L) {
+ axis <- axis[1L]
+ }
+ scrs <- as.vector(scores(object, choices = axis, scaling = scaling,
+ display = "sites", ...))
+ gradientDist.default(scrs, na.rm = na.rm, ...)
+}
+
+gradientDist.prcurve <- function(object, na.rm = TRUE, ...) {
+ order <- object$tag
+ scrs <- object$lambda
+ gradientDist.default(scrs, order, na.rm = na.rm, ...)
+}
Added: pkg/R/plot.gradientDist.R
===================================================================
--- pkg/R/plot.gradientDist.R (rev 0)
+++ pkg/R/plot.gradientDist.R 2011-08-23 08:47:53 UTC (rev 228)
@@ -0,0 +1,53 @@
+plot.gradientDist <- function(x, orderBy,
+ flipAxes = FALSE,
+ main = NULL,
+ xlab = NULL,
+ ylab = "Distance along gradient",
+ xlim = NULL, ylim = NULL, ...) {
+ X <- as.numeric(x)
+ if(missing(orderBy)) {
+ orderBy <- seq_along(X)
+ if(is.null(xlab))
+ xlab <- "Sample"
+ } else {
+ if(is.null(xlab))
+ xlab <- deparse(substitute(orderBy))
+ }
+ xlim <- if(is.null(xlim))
+ range(orderBy[is.finite(orderBy)])
+ else xlim
+ ylim <- if(is.null(ylim))
+ range(X[is.finite(X)])
+ else ylim
+ if(flipAxes)
+ plot.default(x = X, y = orderBy, xlab = ylab, ylab = xlab,
+ main = main, ylim = xlim, xlim = ylim, ...)
+ else
+ plot.default(x = orderBy, y = X, xlab = xlab, ylab = ylab,
+ main = main, ylim = ylim, xlim = xlim, ...)
+ invisible(x)
+}
+
+lines.gradientDist <- function(x, orderBy, flipAxes = FALSE,
+ type = "l", ...) {
+ X <- as.numeric(x)
+ if(missing(orderBy)) {
+ orderBy <- seq_along(X)
+ }
+ if(flipAxes)
+ lines.default(x = X, y = orderBy, type = type, ...)
+ else
+ lines.default(x = orderBy, y = X, type = type, ...)
+}
+
+points.gradientDist <- function(x, orderBy, flipAxes = FALSE, type = "p",
+ ...) {
+ X <- as.numeric(x)
+ if(missing(orderBy)) {
+ orderBy <- seq_along(X)
+ }
+ if(flipAxes)
+ points.default(x = X, y = orderBy, type = type, ...)
+ else
+ points.default(x = orderBy, y = X, type = type, ...)
+}
Added: pkg/man/gradientDist.Rd
===================================================================
--- pkg/man/gradientDist.Rd (rev 0)
+++ pkg/man/gradientDist.Rd 2011-08-23 08:47:53 UTC (rev 228)
@@ -0,0 +1,79 @@
+\name{gradientDist}
+\alias{gradientDist}
+\alias{gradientDist.default}
+\alias{gradientDist.cca}
+\alias{gradientDist.prcurve}
+
+\title{
+ Locations of samples along ordination gradients.
+}
+\description{
+ Extracts information as to the locations of samples along an
+ ordination gradient. \code{gradientDist()} standardises the entire
+ gradient to the interval 0, \ldots, 1, to allow comparison between
+ methods or data sets.
+}
+\usage{
+gradientDist(object, \dots)
+
+\method{gradientDist}{default}(object, order, na.rm = TRUE, \dots)
+
+\method{gradientDist}{cca}(object, na.rm = TRUE, axis = 1L,
+ scaling = 0, \dots)
+
+\method{gradientDist}{prcurve}(object, na.rm = TRUE, \dots)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{object}{an R object of an appropriate type. For the default
+ method, any R object that can be coerced to a vector.}
+ \item{order}{numeric vector indicating the ordering of points along
+ the gradient.}
+ \item{na.rm}{logical; should missing values be removed?}
+ \item{axis}{numeric, length 1; the ordination axis to take as the
+ gradient.}
+ \item{scaling}{Scaling to apply to the site scores. Default is to do
+ no scaling. See \code{\link{scores.cca}} for details.}
+ \item{\dots}{additional arguments passed to other methods. In the
+ \code{"cca"} method, these are also passed to
+ \code{\link{scores.cca}}.}
+}
+%\details{
+%
+%}
+\value{
+ A numeric vector of positions along the gradient, scaled to the range
+ 0, \ldots, 1.
+}
+%\references{
+%
+%}
+\author{
+ Gavin L. Simpson
+}
+
+%\note{
+%
+%}
+
+\seealso{
+ See \code{\link{cca}} and \code{\link{prcurve}} for functions that
+ produce objects that \code{gradientDist()} can work with.
+}
+\examples{
+
+data(abernethy)
+
+## Remove the Depth and Age variables
+abernethy2 <- abernethy[, -(37:38)]
+
+## Fit PCA
+aber.pca <- rda(abernethy2)
+
+## Distance along the first PCA axis
+gradientDist(aber.pca)
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{multivariate}
+\keyword{utility}
More information about the Analogue-commits
mailing list