[Vegan-commits] r2255 - in branches/2.0: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Aug 20 18:23:52 CEST 2012
Author: jarioksa
Date: 2012-08-20 18:23:51 +0200 (Mon, 20 Aug 2012)
New Revision: 2255
Added:
branches/2.0/R/labels.envfit.R
Modified:
branches/2.0/NAMESPACE
branches/2.0/R/biplot.rda.R
branches/2.0/R/cIndexKM.R
branches/2.0/R/plot.envfit.R
branches/2.0/inst/ChangeLog
branches/2.0/man/clamtest.Rd
branches/2.0/man/envfit.Rd
branches/2.0/man/mantel.correlog.Rd
Log:
Merge safe fixes in range r2225:2254
* merge r2254: stylistic in examples of Rd files.
* merge r2250: do not use paste0 in envift.Rd (fails in R 2.14).
* merge r2246: remove dead code from cIndexKM() and R-devel CMD
check warning.
* merge r2237 thru 2240: add labels.envfit() and "labels" arg to
plot.envfit().
* merge r2225: biplot.rda 'type' fix.
Modified: branches/2.0/NAMESPACE
===================================================================
--- branches/2.0/NAMESPACE 2012-08-20 13:14:12 UTC (rev 2254)
+++ branches/2.0/NAMESPACE 2012-08-20 16:23:51 UTC (rev 2255)
@@ -176,6 +176,8 @@
S3method(hiersimu, formula)
# identify: graphics
S3method(identify, ordiplot)
+# labels: base
+S3method(labels, envfit)
# lines: graphics
S3method(lines, humpfit)
S3method(lines, permat)
Modified: branches/2.0/R/biplot.rda.R
===================================================================
--- branches/2.0/R/biplot.rda.R 2012-08-20 13:14:12 UTC (rev 2254)
+++ branches/2.0/R/biplot.rda.R 2012-08-20 16:23:51 UTC (rev 2255)
@@ -23,18 +23,18 @@
if (missing(type)) {
nitlimit <- 80
nit <- max(nrow(g$species), nrow(g$sites))
- if (nit > nitlimit)
- type <- "points"
- else type <- "text"
+ if (nit > nitlimit)
+ type <- rep("points", 2)
+ else type <- rep("text", 2)
}
else type <- match.arg(type, TYPES, several.ok = TRUE)
if(length(type) < 2)
type <- rep(type, 2)
- if (missing(xlim))
+ if (missing(xlim))
xlim <- range(g$species[, 1], g$sites[, 1])
- if (missing(ylim))
+ if (missing(ylim))
ylim <- range(g$species[, 2], g$sites[, 2])
- plot(g[[1]], xlim = xlim, ylim = ylim, type = "n", asp = 1,
+ plot(g[[1]], xlim = xlim, ylim = ylim, type = "n", asp = 1,
...)
abline(h = 0, lty = 3)
abline(v = 0, lty = 3)
@@ -51,9 +51,9 @@
col = col[2], cex = 0.7)
}
if (!is.null(g$sites)) {
- if (type[2] == "text")
+ if (type[2] == "text")
text(g$sites, rownames(g$sites), cex = 0.7, col = col[1])
- else if (type[2] == "points")
+ else if (type[2] == "points")
points(g$sites, pch = 1, cex = 0.7, col = col[1])
}
class(g) <- "ordiplot"
Modified: branches/2.0/R/cIndexKM.R
===================================================================
--- branches/2.0/R/cIndexKM.R 2012-08-20 13:14:12 UTC (rev 2254)
+++ branches/2.0/R/cIndexKM.R 2012-08-20 16:23:51 UTC (rev 2255)
@@ -1,75 +1,7 @@
-"cIndexKM" <- function (y, x, index = "all")
+`cIndexKM` <-
+ function (y, x, index = "all")
{
kmeans_res <- y
-#########################################
- withinss <- function(kmeans_res, x)
- {
- retval <- rep(0, nrow(kmeans_res$centers))
- x <- (x - kmeans_res$centers[kmeans_res$cluster, ])^2
- for (k in 1:nrow(kmeans_res$centers))
- {
- retval[k] <- sum(x[kmeans_res$cluster == k, ])
- }
- retval
- }
-##########################################
- varwithinss <- function(x, centers, cluster)
- {
- nrow <- dim(centers)[1]
- nvar <- dim(x)[2]
- varwithins <- matrix(0, nrow, nvar)
- x <- (x - centers[cluster, ])^2
- for (l in 1:nvar)
- {
- for (k in 1:nrow)
- {
- varwithins[k, l] <- sum(x[cluster == k, l])
- }
- }
- varwithins
- }
-##########################################
- maxmindist <- function(clsize, distscen)
- {
- ncl <- length(clsize)
- npairs <- 0
- for (i in 1:ncl) npairs <- npairs + clsize[i] * (clsize[i] - 1)/2
- mindw <- 0
- nfound <- distscen[1]
- i <- 1
- while (nfound < npairs)
- {
- if ((nfound + distscen[i + 1]) < npairs)
- {
- mindw <- mindw + i * distscen[i + 1]
- nfound <- nfound + distscen[i + 1]
- }
- else
- {
- mindw <- mindw + i * (npairs - nfound)
- nfound <- nfound + distscen[i + 1]
- }
- i <- i + 1
- }
- maxdw <- 0
- nfound <- 0
- i <- length(distscen) - 1
- while (nfound < npairs)
- {
- if ((nfound + distscen[i + 1]) < npairs)
- {
- maxdw <- maxdw + i * distscen[i + 1]
- nfound <- nfound + distscen[i + 1]
- }
- else
- {
- maxdw <- maxdw + i * (npairs - nfound)
- nfound <- nfound + distscen[i + 1]
- }
- i <- i - 1
- }
- list(mindw = mindw, maxdw = maxdw)
- }
#############################################
gss <- function(x, clsize, withins)
{
@@ -83,39 +15,7 @@
list(wgss = wgss, bgss = bgss)
}
#############################################
- vargss <- function(x, clsize, varwithins)
- {
- nvar <- dim(x)[2]
- n <- sum(clsize)
- k <- length(clsize)
- varallmean <- rep(0, nvar)
- varallmeandist <- rep(0, nvar)
- varwgss <- rep(0, nvar)
- for (l in 1:nvar) varallmean[l] <- mean(x[, l])
- vardmean <- sweep(x, 2, varallmean, "-")
- for (l in 1:nvar)
- {
- varallmeandist[l] <- sum((vardmean[, l])^2)
- varwgss[l] <- sum(varwithins[, l])
- }
- varbgss <- varallmeandist - varwgss
- vartss <- varbgss + varwgss
- list(vartss = vartss, varbgss = varbgss)
- }
-
-#################################################
- count <- function(x)
- {
- nr <- nrow(x)
- nc <- ncol(x)
- d <- integer(nc + 1)
- retval <- .C("count", xrows = nr, xcols = nc, x = as.integer(x),
- d = d, PACKAGE = "cclust")
- d <- retval$d
- names(d) <- 0:nc
- d
- }
-################################################
+
### Function modified by SD and PL from the original "cIndexKM" in "cclust"
### to accommodate a single response variable as well as singleton groups
### and remove unwanted index.
Copied: branches/2.0/R/labels.envfit.R (from rev 2237, pkg/vegan/R/labels.envfit.R)
===================================================================
--- branches/2.0/R/labels.envfit.R (rev 0)
+++ branches/2.0/R/labels.envfit.R 2012-08-20 16:23:51 UTC (rev 2255)
@@ -0,0 +1,9 @@
+`labels.envfit` <-
+ function(object, ...)
+{
+ out <- list("vectors" = rownames(object$vectors$arrows),
+ "factors" = rownames(object$factors$centroids))
+ if (is.null(out$vectors) || is.null(out$factors))
+ out <- unlist(out, use.names = FALSE)
+ out
+}
Modified: branches/2.0/R/plot.envfit.R
===================================================================
--- branches/2.0/R/plot.envfit.R 2012-08-20 13:14:12 UTC (rev 2254)
+++ branches/2.0/R/plot.envfit.R 2012-08-20 16:23:51 UTC (rev 2255)
@@ -1,13 +1,36 @@
`plot.envfit` <-
- function (x, choices = c(1, 2), arrow.mul, at = c(0, 0),
+ function (x, choices = c(1, 2), labels, arrow.mul, at = c(0, 0),
axis = FALSE, p.max = NULL, col = "blue", bg, add = TRUE, ...)
{
formals(arrows) <- c(formals(arrows), alist(... = ))
+ ## get labels
+ labs <- list("v" = rownames(x$vectors$arrows),
+ "f" = rownames(x$factors$centroids))
+ ## Change labels if user so wishes
+ if (!missing(labels)) {
+ ## input list of "vectors" and/or "factors"
+ if (is.list(labels)) {
+ if (!is.null(labs$v) && !is.null(labels$vectors))
+ labs$v <- labels$vectors
+ if (!is.null(labs$f) && !is.null(labels$factors))
+ labs$f <- labels$factors
+ } else {
+ ## input vector: either vectors or factors must be NULL,
+ ## and the existing set of labels is replaced
+ if (!is.null(labs$v) && !is.null(labs$f))
+ stop("needs a list with both 'vectors' and 'factors' labels")
+ if (!is.null(labs$v))
+ labs$v <- labels
+ else
+ labs$f <- labels
+ }
+ }
vect <- NULL
if (!is.null(p.max)) {
if (!is.null(x$vectors)) {
take <- x$vectors$pvals <= p.max
x$vectors$arrows <- x$vectors$arrows[take, , drop = FALSE]
+ labs$v <- labs$v[take]
x$vectors$r <- x$vectors$r[take]
if (nrow(x$vectors$arrows) == 0)
x$vectors <- vect <- NULL
@@ -18,6 +41,7 @@
take <- x$factors$var.id %in% nam
x$factors$centroids <- x$factors$centroids[take,
, drop = FALSE]
+ labs$f <- labs$f[take]
if (nrow(x$factors$centroids) == 0)
x$factors <- NULL
}
@@ -42,16 +66,14 @@
plot.new() ## needed for string widths and heights
if(!is.null(vect)) {
## compute axis limits allowing space for labels
- labs <- rownames(x$vectors$arrows)
- sw <- strwidth(labs, ...)
- sh <- strheight(labs, ...)
+ sw <- strwidth(labs$v, ...)
+ sh <- strheight(labs$v, ...)
xlim <- range(at[1], vtext[,1] + sw, vtext[,1] - sw)
ylim <- range(at[2], vtext[,2] + sh, vtext[,2] - sh)
if(!is.null(x$factors)) {
## if factors, also need to consider them
- labs <- rownames(x$factors$centroids)
- sw <- strwidth(labs, ...)
- sh <- strheight(labs, ...)
+ sw <- strwidth(labs$f, ...)
+ sh <- strheight(labs$f, ...)
xlim <- range(xlim, x$factors$centroids[, choices[1]] + sw,
x$factors$centroids[, choices[1]] - sw)
ylim <- range(ylim, x$factors$centroids[, choices[2]] + sh,
@@ -66,9 +88,8 @@
alabs <- colnames(vect)
title(..., ylab = alabs[2], xlab = alabs[1])
} else if (!is.null(x$factors)) {
- labs <- rownames(x$factors$centroids)
- sw <- strwidth(labs, ...)
- sh <- strheight(labs, ...)
+ sw <- strwidth(labs$f, ...)
+ sh <- strheight(labs$f, ...)
xlim <- range(at[1], x$factors$centroids[, choices[1]] + sw,
x$factors$centroids[, choices[1]] - sw)
ylim <- range(at[2], x$factors$centroids[, choices[2]] + sh,
@@ -87,19 +108,17 @@
arrows(at[1], at[2], vect[, 1], vect[, 2], len = 0.05,
col = col)
if (missing(bg))
- text(vtext, rownames(x$vectors$arrows), col = col, ...)
+ text(vtext, labs$v, col = col, ...)
else
- ordilabel(vtext, labels = rownames(x$vectors$arrows),
- col = col, fill = bg, ...)
+ ordilabel(vtext, labels = labs$v, col = col, fill = bg, ...)
}
if (!is.null(x$factors)) {
if (missing(bg))
text(x$factors$centroids[, choices, drop = FALSE],
- rownames(x$factors$centroids), col = col, ...)
+ labs$f, col = col, ...)
else
ordilabel(x$factors$centroids[, choices, drop = FALSE],
- labels = rownames(x$factors$centroids),
- col = col, fill = bg, ...)
+ labels = labs$f, col = col, fill = bg, ...)
}
if (axis && !is.null(vect)) {
axis(3, at = ax + at[1], labels = c(maxarr, 0, maxarr),
Modified: branches/2.0/inst/ChangeLog
===================================================================
--- branches/2.0/inst/ChangeLog 2012-08-20 13:14:12 UTC (rev 2254)
+++ branches/2.0/inst/ChangeLog 2012-08-20 16:23:51 UTC (rev 2255)
@@ -4,6 +4,14 @@
Version 2.0-5 (opened June 18, 2012)
+ * merge r2254: stylistic in examples of Rd files.
+ * merge r2250: do not use paste0 in envift.Rd (fails in R 2.14).
+ * merge r2246: remove dead code from cIndexKM() and R-devel CMD
+ check warning.
+ * merge r2237 thru 2240: add labels.envfit() and "labels" arg to
+ plot.envfit().
+ * merge r2225: biplot.rda 'type' fix.
+
Version 2.0-4 (released June 18, 2012)
* merge r2215: plot.envfit() gains args 'bg' for background colour
Modified: branches/2.0/man/clamtest.Rd
===================================================================
--- branches/2.0/man/clamtest.Rd 2012-08-20 13:14:12 UTC (rev 2254)
+++ branches/2.0/man/clamtest.Rd 2012-08-20 16:23:51 UTC (rev 2255)
@@ -141,9 +141,9 @@
\examples{
data(mite)
data(mite.env)
-x <- clamtest(mite, mite.env$Shrub=="None", alpha=0.005)
-summary(x)
-head(x)
-plot(x)
+sol <- clamtest(mite, mite.env$Shrub=="None", alpha=0.005)
+summary(sol)
+head(sol)
+plot(sol)
}
\keyword{ htest }
Modified: branches/2.0/man/envfit.Rd
===================================================================
--- branches/2.0/man/envfit.Rd 2012-08-20 13:14:12 UTC (rev 2254)
+++ branches/2.0/man/envfit.Rd 2012-08-20 16:23:51 UTC (rev 2255)
@@ -6,6 +6,7 @@
\alias{factorfit}
\alias{plot.envfit}
\alias{scores.envfit}
+\alias{labels.envfit}
\title{Fits an Environmental Vector or Factor onto an Ordination }
\description{
@@ -18,8 +19,8 @@
\method{envfit}{default}(ord, env, permutations = 999, strata, choices=c(1,2),
display = "sites", w = weights(ord), na.rm = FALSE, ...)
\method{envfit}{formula}(formula, data, ...)
-\method{plot}{envfit}(x, choices = c(1,2), arrow.mul, at = c(0,0), axis = FALSE,
- p.max = NULL, col = "blue", bg, add = TRUE, ...)
+\method{plot}{envfit}(x, choices = c(1,2), labels, arrow.mul, at = c(0,0),
+ axis = FALSE, p.max = NULL, col = "blue", bg, add = TRUE, ...)
\method{scores}{envfit}(x, display, choices, ...)
vectorfit(X, P, permutations = 0, strata, w, ...)
factorfit(X, P, permutations = 0, strata, w, ...)
@@ -45,6 +46,13 @@
\code{na.rm = TRUE}.}
\item{x}{A result object from \code{envfit}.}
\item{choices}{Axes to plotted.}
+ \item{labels}{Change plotting labels. The argument should be a list
+ with elements \code{vectors} and \code{factors} which give the new
+ plotting labels. If either of these elements is omitted, the
+ default labels will be used. If there is only one type of elements
+ (only \code{vectors} or only \code{factors}), the labels can be
+ given as vector. The default labels can be displayed with
+ \code{labels} command.}
\item{arrow.mul}{Multiplier for vector lengths. The arrows are
automatically scaled similarly as in \code{\link{plot.cca}} if this
is not given and \code{add = TRUE}.}
@@ -210,6 +218,11 @@
ordispider(ord, Moisture, col="skyblue")
points(ord, display = "sites", col = as.numeric(Moisture), pch=16)
plot(fit, cex=1.2, axis=TRUE, bg = rgb(1, 1, 1, 0.5))
+## Use shorter labels for factor centroids
+labels(fit)
+plot(ord)
+plot(fit, labels=list(factors = paste("M", c(1,2,4,5), sep = "")),
+ bg = rgb(1,1,0,0.5))
}
\keyword{multivariate }
\keyword{aplot}
Modified: branches/2.0/man/mantel.correlog.Rd
===================================================================
--- branches/2.0/man/mantel.correlog.Rd 2012-08-20 13:14:12 UTC (rev 2254)
+++ branches/2.0/man/mantel.correlog.Rd 2012-08-20 16:23:51 UTC (rev 2255)
@@ -146,10 +146,10 @@
mite.hel.resid <- resid(lm(as.matrix(mite.hel) ~ ., data=mite.xy))
# Compute the detrended species distance matrix
-mite.hel.D = dist(mite.hel.resid)
+mite.hel.D <- dist(mite.hel.resid)
# Compute Mantel correlogram with cutoff, Pearson statistic
-mite.correlog = mantel.correlog(mite.hel.D, XY=mite.xy, nperm=49)
+mite.correlog <- mantel.correlog(mite.hel.D, XY=mite.xy, nperm=49)
summary(mite.correlog)
mite.correlog
# or: print(mite.correlog)
@@ -157,8 +157,8 @@
plot(mite.correlog)
# Compute Mantel correlogram without cutoff, Spearman statistic
-mite.correlog2 = mantel.correlog(mite.hel.D, XY=mite.xy, cutoff=FALSE,
-r.type="spearman", nperm=49)
+mite.correlog2 <- mantel.correlog(mite.hel.D, XY=mite.xy, cutoff=FALSE,
+ r.type="spearman", nperm=49)
summary(mite.correlog2)
mite.correlog2
plot(mite.correlog2)
More information about the Vegan-commits
mailing list