[Vegan-commits] r2946 - in pkg/vegan: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon May 11 12:58:49 CEST 2015
Author: jarioksa
Date: 2015-05-11 12:58:49 +0200 (Mon, 11 May 2015)
New Revision: 2946
Added:
pkg/vegan/man/ordiArrowTextXY.Rd
Modified:
pkg/vegan/R/ordiArrowMul.R
pkg/vegan/R/ordiArrowTextXY.R
pkg/vegan/R/pcnm.R
pkg/vegan/R/rarefy.R
pkg/vegan/man/diversity.Rd
pkg/vegan/man/envfit.Rd
Log:
Merge branch 'cran-2.2' into r-forge-svn-local
Modified: pkg/vegan/R/ordiArrowMul.R
===================================================================
--- pkg/vegan/R/ordiArrowMul.R 2015-04-20 06:46:45 UTC (rev 2945)
+++ pkg/vegan/R/ordiArrowMul.R 2015-05-11 10:58:49 UTC (rev 2946)
@@ -1,19 +1,33 @@
### Scaling of arrows to 'fill' a plot with vectors centred at 'at'.
### Plot dims from 'par("usr")' and arrow heads are in 'x'.
-`ordiArrowMul` <-
- function (x, at = c(0,0), fill=0.75)
-{
+`ordiArrowMul` <- function (x, at = c(0,0), fill = 0.75,
+ display, choices = c(1,2), ...) {
+ ## handle x, which we try with scores, but also retain past usage of
+ ## a two column matrix
+ X <- if (is.matrix(x)) {
+ nc <- NCOL(x)
+ if (nc != 2L) {
+ stop("A 2-column matrix of coordinates is required & not supplied.")
+ }
+ x
+ } else {
+ if (inherits(x, "envfit")) {
+ scores(x, display = "vectors", ...)[, 1:2]
+ } else {
+ scores(x, display = display, choices = choices, ...)
+ }
+ }
+
u <- par("usr")
u <- u - rep(at, each = 2)
- r <- c(range(x[,1], na.rm = TRUE), range(x[,2], na.rm = TRUE))
+ r <- c(range(X[,1], na.rm = TRUE), range(X[,2], na.rm = TRUE))
## 'rev' takes care of reversed axes like xlim(1,-1)
rev <- sign(diff(u))[-2]
if (rev[1] < 0)
u[1:2] <- u[2:1]
if (rev[2] < 0)
u[3:4] <- u[4:3]
- u <- u/r
+ u <- u/r
u <- u[is.finite(u) & u > 0]
fill * min(u)
}
-
Modified: pkg/vegan/R/ordiArrowTextXY.R
===================================================================
--- pkg/vegan/R/ordiArrowTextXY.R 2015-04-20 06:46:45 UTC (rev 2945)
+++ pkg/vegan/R/ordiArrowTextXY.R 2015-05-11 10:58:49 UTC (rev 2946)
@@ -2,17 +2,53 @@
### coordinates of the arrow heads, and 'labels' are the text used to
### label these heads, '...' passes arguments (such as 'cex') to
### strwidth() and strheight().
-`ordiArrowTextXY` <-
- function (x, labels, ...)
-{
+`ordiArrowTextXY` <- function (x, labels, display, choices = c(1,2),
+ rescale = TRUE, fill = 0.75, ...) {
+ ## handle x, which we try with scores, but also retain past usage of
+ ## a two column matrix
+ X <- if (is.matrix(x)) {
+ nc <- NCOL(x)
+ if (nc != 2L) {
+ stop("A 2-column matrix of coordinates is required & not supplied.")
+ }
+ x
+ } else {
+ if (inherits(x, "envfit")) {
+ scores(x, display = "vectors", ...)[, 1:2]
+ } else {
+ scores(x, display = display, choices = choices, ...)
+ }
+ if (!rescale) {
+ warning("Extracted scores usually need rescaling but you set 'rescale = FALSE'.\nConsider using 'rescale = TRUE', the default.")
+ }
+ }
+
+ ## find multiplier to fill if rescaling
+ if (rescale) {
+ mul <- ordiArrowMul(X, fill = fill)
+ X <- X * mul
+ }
+
+ if (missing(labels)) {
+ rnames <- rownames(X)
+ labels <- if (is.null(rnames)) {
+ paste("V", seq_len(NROW(X)))
+ } else {
+ rnames
+ }
+ }
+
w <- strwidth(labels, ...)
h <- strheight(labels, ...)
+
## slope of arrows
- b <- x[,2]/x[,1]
+ b <- X[,2] / X[,1]
+
## offset based on string dimensions
- off <- cbind(sign(x[,1]) * (w/2 + h/4), 0.75 * h * sign(x[,2]))
+ off <- cbind(sign(X[,1]) * (w/2 + h/4), 0.75 * h * sign(X[,2]))
+
## move the centre of the string to the continuation of the arrow
- for(i in seq_len(nrow(x))) {
+ for(i in seq_len(nrow(X))) {
move <- off[i,2] / b[i]
## arrow points to the top/bottom of the text box
if (is.finite(move) && abs(move) <= abs(off[i, 1]))
@@ -23,5 +59,5 @@
off[i, 2] <- move
}
}
- off + x
+ off + X
}
Modified: pkg/vegan/R/pcnm.R
===================================================================
--- pkg/vegan/R/pcnm.R 2015-04-20 06:46:45 UTC (rev 2945)
+++ pkg/vegan/R/pcnm.R 2015-05-11 10:58:49 UTC (rev 2946)
@@ -1,6 +1,11 @@
-`pcnm` <-
- function(dis, threshold, w, dist.ret = FALSE)
-{
+`pcnm` <- function(dis, threshold, w, dist.ret = FALSE) {
+ if (!inherits(dis, "dist")) {
+ dims <- dim(dis)
+ if (length(unique(dims)) >1) {
+ stop("'dis' does not appear to be a square distance matrix.")
+ }
+ dis <- as.dist(dis)
+ }
EPS <- sqrt(.Machine$double.eps)
wa.old <- options(warn = -1)
on.exit(options(wa.old))
@@ -16,7 +21,7 @@
res <- list(vectors = mypcnm$points, values = mypcnm$eig,
weights = mypcnm$weig)
k <- ncol(mypcnm$points)
- res$vectors <- sweep(res$vectors, 2, sqrt(res$values[1:k]), "/")
+ res$vectors <- sweep(res$vectors, 2, sqrt(res$values[seq_len(k)]), "/")
colnames(res$vectors) <- paste("PCNM", 1:k, sep="")
res$threshold <- threshold
if (dist.ret) {
Modified: pkg/vegan/R/rarefy.R
===================================================================
--- pkg/vegan/R/rarefy.R 2015-04-20 06:46:45 UTC (rev 2945)
+++ pkg/vegan/R/rarefy.R 2015-05-11 10:58:49 UTC (rev 2946)
@@ -2,6 +2,11 @@
function (x, sample, se = FALSE, MARGIN = 1)
{
x <- as.matrix(x)
+ minsample <- min(apply(x, MARGIN, sum))
+ if (any(sample > minsample))
+ warning(
+ gettextf("Requested 'sample' was larger than smallest site maximum (%d)",
+ minsample))
## as.matrix changes an n-vector to a n x 1 matrix
if (ncol(x) == 1 && MARGIN == 1)
x <- t(x)
Modified: pkg/vegan/man/diversity.Rd
===================================================================
--- pkg/vegan/man/diversity.Rd 2015-04-20 06:46:45 UTC (rev 2945)
+++ pkg/vegan/man/diversity.Rd 2015-05-11 10:58:49 UTC (rev 2946)
@@ -60,9 +60,9 @@
Function \code{rarefy} gives the expected species richness in random
subsamples of size \code{sample} from the community. The size of
\code{sample} should be smaller than total community size, but the
- function will silently work for larger \code{sample} as well and
- return non-rarefied species richness (and standard error = 0). If
- \code{sample} is a vector, rarefaction of all observations is
+ function will work for larger \code{sample} as well (with a warning)
+ and return non-rarefied species richness (and standard error =
+ 0). If \code{sample} is a vector, rarefaction of all observations is
performed for each sample size separately. Rarefaction can be
performed only with genuine counts of individuals. The function
\code{rarefy} is based on Hurlbert's (1971) formulation, and the
Modified: pkg/vegan/man/envfit.Rd
===================================================================
--- pkg/vegan/man/envfit.Rd 2015-04-20 06:46:45 UTC (rev 2945)
+++ pkg/vegan/man/envfit.Rd 2015-05-11 10:58:49 UTC (rev 2946)
@@ -7,8 +7,6 @@
\alias{plot.envfit}
\alias{scores.envfit}
\alias{labels.envfit}
-\alias{ordiArrowMul}
-\alias{ordiArrowTextXY}
\title{Fits an Environmental Vector or Factor onto an Ordination }
\description{
@@ -26,9 +24,6 @@
\method{scores}{envfit}(x, display, choices, ...)
vectorfit(X, P, permutations = 0, strata = NULL, w, ...)
factorfit(X, P, permutations = 0, strata = NULL, w, ...)
-## support functions
-ordiArrowMul(x, at = c(0,0), fill = 0.75)
-ordiArrowTextXY(x, labels, ...)
}
\arguments{
@@ -95,9 +90,6 @@
\item{w}{Weights used in fitting (concerns mainly \code{\link{cca}}
and \code{\link{decorana}} results which have nonconstant weights).}
- \item{fill}{numeric; the proportion of the plot to fill by the span of
- the arrows.}
-
\item{...}{Parameters passed to \code{\link{scores}}.}
}
\details{
@@ -162,13 +154,9 @@
for the physical size of the plot, and the arrow lengths cannot be
compared across plots. For similar scaling of arrows, you must
explicitly set the \code{arrow.mul} argument in the \code{plot}
- command. \code{ordiArrowMul} finds a multiplier to scale a bunch of
- arrows to fill an ordination plot, and \code{ordiArrowTextXY} finds
- the coordinates for labels of these arrows. NB.,
- \code{ordiArrowTextXY} does not draw labels; it simply returns
- coordinates at which the labels should be drawn for use with another
- function, such as \code{\link{text}}.
-
+ command; see \code{\link{ordiArrowMul}} and
+ \code{\link{ordiArrowTextXY}}.
+
The results can be accessed with \code{scores.envfit} function which
returns either the fitted vectors scaled by correlation coefficient or
the centroids of the fitted environmental variables.
@@ -231,22 +219,7 @@
plot(ord, type="p")
fit <- envfit(ord, varechem, perm = 999, display = "lc")
plot(fit, p.max = 0.05, col = "red")
-## Scale arrows by hand to fill 80% of the plot
-## Biplot arrows by hand
-data(varespec, varechem)
-ord <- cca(varespec ~ Al + P + K, varechem)
-plot(ord, display = c("species","sites"))
-## biplot scores
-bip <- scores(ord, choices = 1:2, display = "bp")
-## scaling factor for arrows to fill 80% of plot
-(mul <- ordiArrowMul(bip, fill = 0.8))
-bip.scl <- bip * mul # Scale the biplot scores
-labs <- c("Al","P","K") # Arrow labels
-## calculate coordinate of labels for arrows
-(bip.lab <- ordiArrowTextXY(bip.scl, labels = labs))
-## draw arrows and text labels
-arrows(0, 0, bip.scl[,1], bip.scl[,2], length = 0.1)
-text(bip.lab, labels = labs)
+
## Class variables, formula interface, and displaying the
## inter-class variability with `ordispider', and semitransparent
## white background for labels (semitransparent colours are not
@@ -265,6 +238,7 @@
plot(ord)
plot(fit, labels=list(factors = paste("M", c(1,2,4,5), sep = "")),
bg = rgb(1,1,0,0.5))
+detach(dune.env)
}
\keyword{multivariate }
\keyword{aplot}
Added: pkg/vegan/man/ordiArrowTextXY.Rd
===================================================================
--- pkg/vegan/man/ordiArrowTextXY.Rd (rev 0)
+++ pkg/vegan/man/ordiArrowTextXY.Rd 2015-05-11 10:58:49 UTC (rev 2946)
@@ -0,0 +1,109 @@
+\name{ordiArrowTextXY}
+\alias{ordiArrowMul}
+\alias{ordiArrowTextXY}
+
+\title{Support Functions for Drawing Vectors}
+\description{
+ Support functions to assist with drawing of vectors (arrows) on
+ ordination plots. \code{ordiArrowMul} finds the multiplier for the
+ coordinates of the head of the vector such that they accupy
+ \code{fill} proportion of the plot region. \code{ordiArrowTextXY}
+ finds coordinates for the locations of \code{labels} to be drawn just
+ beyond the head of the vector.
+}
+\usage{
+ordiArrowTextXY(x, labels, display, choices = c(1,2),
+ rescale = TRUE, fill = 0.75, \ldots)
+ordiArrowMul(x, at = c(0,0), fill = 0.75,
+ display, choices = c(1,2), \ldots)
+}
+
+\arguments{
+ \item{x}{An R object, from which \code{\link{scores}} can determine
+ suitable ordination scores or an object created by
+ \code{\link{envfit}}, or a two-column matrix of coordinates of arrow
+ heads on the two plot axes.}
+
+ \item{labels}{Change plotting labels. A character vector of labels for
+ which label coordinates are sought. If not supplied, these will be
+ determined from the row names of \code{x}, or \code{scores(x, ...)}
+ if required. If either of these are not defined, suitable labels
+ will be generated.}
+
+ \item{display}{a character string known to \code{\link{scores}} or one
+ of its methods which indicates the type of scores to extract. In
+ fitting functions these are ordinary site scores or linear
+ combination scores (\code{"lc"}) in constrained ordination
+ (\code{\link{cca}}, \code{\link{rda}}, \code{\link{capscale}}). If
+ \code{x} was created by \code{envfit} then \code{display} can not be
+ set by the user and takes the value \code{"vectors"}. Ignored if
+ \code{x} is a matrix.}
+
+ \item{choices}{Axes to be plotted.}
+
+ \item{rescale}{logical; should the coordinates in or extracted from
+ \code{x} be rescaled to fill \code{fill} proportion of the plot
+ region? The default is to always rescale the coordinates as this is
+ usually desired for objects \code{x} from which coordinates are
+ retrieved. If supplying \code{x} a 2-column matrix that has already
+ been rescaled, then set this to \code{FALSE}.}
+
+ \item{fill}{numeric; the proportion of the plot to fill by the span of
+ the arrows.}
+
+ \item{at}{The origin of fitted arrows in the plot. If you plot arrows
+ in other places than origin, you probably have to specify
+ \code{arrrow.mul}.}
+
+ \item{...}{Parameters passed to \code{\link{scores}}, and
+ \code{\link{strwidth}} and \code{\link{strheight}}.}
+}
+
+\details{
+ \code{ordiArrowMul} finds a multiplier to scale a bunch of
+ arrows to fill an ordination plot, and \code{ordiArrowTextXY} finds
+ the coordinates for labels of these arrows. NB.,
+ \code{ordiArrowTextXY} does not draw labels; it simply returns
+ coordinates at which the labels should be drawn for use with another
+ function, such as \code{\link{text}}.
+}
+
+\value{
+ For \code{ordiArrowTextXY}, a 2-column matrix of coordinates for the
+ label centres in the coordinate system of the currently active
+ plotting device.
+
+ For \code{ordiArrowMul}, a length-1 vector containing the scaling
+ factor.
+}
+
+\author{Jari Oksanen, with modifications by Gavin L. Simpson}
+
+\examples{
+ ## Scale arrows by hand to fill 80% of the plot
+ ## Biplot arrows by hand
+ data(varespec, varechem)
+ ord <- cca(varespec ~ Al + P + K, varechem)
+ plot(ord, display = c("species","sites"))
+
+ ## biplot scores
+ bip <- scores(ord, choices = 1:2, display = "bp")
+
+ ## scaling factor for arrows to fill 80% of plot
+ (mul <- ordiArrowMul(bip, fill = 0.8))
+ bip.scl <- bip * mul # Scale the biplot scores
+ labs <- rownames(bip) # Arrow labels
+
+ ## calculate coordinate of labels for arrows
+ (bip.lab <- ordiArrowTextXY(bip.scl, rescale = FALSE, labels = labs))
+
+ ## draw arrows and text labels
+ arrows(0, 0, bip.scl[,1], bip.scl[,2], length = 0.1)
+ text(bip.lab, labels = labs)
+
+ ## Handling of ordination objects directly
+ mul2 <- ordiArrowMul(ord, display = "bp", fill = 0.8)
+ stopifnot(all.equal(mul, mul2))
+}
+
+\keyword{utilities}
\ No newline at end of file
More information about the Vegan-commits
mailing list