[Vegan-commits] r297 - in pkg: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Mar 30 17:01:42 CEST 2008
Author: gsimpson
Date: 2008-03-30 17:01:42 +0200 (Sun, 30 Mar 2008)
New Revision: 297
Modified:
pkg/R/permuplot.R
pkg/man/permCheck.Rd
Log:
permuplot now copes with 'type = "strata"'
Modified: pkg/R/permuplot.R
===================================================================
--- pkg/R/permuplot.R 2008-03-30 13:20:46 UTC (rev 296)
+++ pkg/R/permuplot.R 2008-03-30 15:01:42 UTC (rev 297)
@@ -1,10 +1,12 @@
`permuplot` <- function(n, control = permControl(),
col = par("col"),
hcol = "red",
+ shade = "lightgrey",
xlim=NULL, ylim=NULL,
inset = 0.1,
main=NULL, sub=NULL,
ann = par("ann"),
+ cex = par("cex"),
...) {
xy.series <- function(n) {
angle <- seq(0, 2*pi, length = n+1)[-(n+1)]
@@ -46,50 +48,85 @@
mfrow = n2mfrow(n.grp),
oma=c(2.1,0,3.1,0))
on.exit(par(opar))
- ## if free and constant, only need one set of random coords
- xy <- if(control$constant && control$type == "free") {
- ## needs to be a list for the main loop below
- xy <- xy.free(unique(tab))
- res <- vector("list", length = length(tab))
- for(i in seq_along(res)) {
- res[[i]] <- xy
- }
- res
- } else {
- switch(control$type,
- free = lapply(tab, xy.free),
- series = lapply(tab, xy.series),
- grid = lapply(tab, function(x) {
- xy.grid(control$ncol, control$nrow)
- }),
- stop("Unsupport permutation 'type'"))
- }
- perms <- permuted.index2(n, control = control)
- perms <- tapply(perms, control$strata, function(x) x)
- if(is.null(main))
- main <- paste("Stratum:", names(tab))
- for(i in seq_along(xy)) {
+ ## if permuting strata, only need to draw the sub-plots
+ ## in a different order
+ if(control$type == "strata") {
+ ## expand shade, col
+ if(identical(length(col), 1))
+ col <- rep(col, n.gr)
+ if(identical(length(shade), 1))
+ shade <- rep(shade, n.gr)
+ ord <- sample(names(tab))
if(is.null(xlim))
- xlim <- axis.limits(xy[[i]]$x, inset)
+ xlim <- c(0,1)
if(is.null(ylim))
- ylim <- axis.limits(xy[[i]]$y, inset)
- plot.new()
- plot.window(xlim, ylim, asp = 1, ...)
- cols <- switch(control$type,
- free = rep(col, tab[i]),
- series = c(hcol, rep(col, tab[i]-1)),
- grid = {cols <- rep(col, tab[i])
- cols[which.min(perms[[i]])] <-
- hcol
- cols})
- text(xy[[i]]$x, xy[[i]]$y, labels = perms[[i]],
- col = cols, ...)
- if(ann) {
- title(main = main[i], ...)
- title(sub = paste("n in stratum:", tab[i]),
- line = 0.5, ...)
+ ylim <- c(0,1)
+ xy <- xy.coords(0.5, 0.5)
+ string <- paste("Stratum:\n", ord)
+ names(string) <- ord
+ strh <- max(strheight(string, cex = cex))
+ strw <- max(strwidth(string, cex = cex))
+ box.coords <- xy.coords(rep(c(0.5-strw, 0.5+strw), each = 2),
+ c(0.5-strh, 0.5+strh,
+ 0.5+strh, 0.5-strh))
+ for(i in ord) {
+ plot.new()
+ plot.window(xlim, ylim, asp = 1, ...)
+ polygon(box.coords, col = shade, border = hcol, ...)
+ text(xy$x, xy$y, labels = string[i],
+ col = col, cex = cex, ...)
+ box()
+ #if(ann) {
+ # title(main = paste("Original order:",
+ # which(ord == i)))
+ #}
}
- box()
+ } else {
+ ## if free and constant, only need one set of random coords
+ xy <- if(control$constant && control$type == "free") {
+ ## needs to be a list for the main loop below
+ xy <- xy.free(unique(tab))
+ res <- vector("list", length = length(tab))
+ for(i in seq_along(res)) {
+ res[[i]] <- xy
+ }
+ res
+ } else {
+ switch(control$type,
+ free = lapply(tab, xy.free),
+ series = lapply(tab, xy.series),
+ grid = lapply(tab, function(x) {
+ xy.grid(control$ncol, control$nrow)
+ }),
+ stop("Unsupport permutation 'type'"))
+ }
+ perms <- permuted.index2(n, control = control)
+ perms <- tapply(perms, control$strata, function(x) x)
+ if(is.null(main))
+ main <- paste("Stratum:", names(tab))
+ for(i in seq_along(xy)) {
+ if(is.null(xlim))
+ xlim <- axis.limits(xy[[i]]$x, inset)
+ if(is.null(ylim))
+ ylim <- axis.limits(xy[[i]]$y, inset)
+ plot.new()
+ plot.window(xlim, ylim, asp = 1, ...)
+ cols <- switch(control$type,
+ free = rep(col, tab[i]),
+ series = c(hcol, rep(col, tab[i]-1)),
+ grid = {cols <- rep(col, tab[i])
+ cols[which.min(perms[[i]])] <-
+ hcol
+ cols})
+ text(xy[[i]]$x, xy[[i]]$y, labels = perms[[i]],
+ col = cols, ...)
+ if(ann) {
+ title(main = main[i], ...)
+ title(sub = paste("n in stratum:", tab[i]),
+ line = 0.5, ...)
+ }
+ box()
+ }
}
if(ann) {
sub <- paste(paste("n: ", n, ";", sep = ""),
Modified: pkg/man/permCheck.Rd
===================================================================
--- pkg/man/permCheck.Rd 2008-03-30 13:20:46 UTC (rev 296)
+++ pkg/man/permCheck.Rd 2008-03-30 15:01:42 UTC (rev 297)
@@ -46,8 +46,9 @@
\method{getNumObs}{integer}(object, \dots)
permuplot(n, control = permControl(), col = par("col"),
- hcol = "red", xlim = NULL, ylim = NULL, inset = 0.1,
- main = NULL, sub = NULL, ann = par("ann"), \dots)
+ hcol = "red", shade = "lightgrey", xlim = NULL, ylim = NULL,
+ inset = 0.1, main = NULL, sub = NULL, ann = par("ann"),
+ cex = par("cex"), \dots)
}
\arguments{
@@ -70,8 +71,11 @@
\item{observed}{logical, should the observed ordering of samples be
returned as part of the complete enumeration? Default is
\code{FALSE} to facilitate usage in higher level functions.}
- \item{col, xlim, ylim, main, sub, ann}{Graphical parameters.}
- \item{hcol}{Colour to use for highlighting observations.}
+ \item{col, xlim, ylim, main, sub, ann, cex}{Graphical parameters.}
+ \item{hcol}{Colour to use for highlighting observations and the border
+ colour of the polygons drawn when \code{type = "strata"}.}
+ \item{shade}{The polygon shading colour (passed to argument \code{col}
+ of function \code{\link{polygon}}) when \code{type = "strata"}.}
\item{inset}{Proportion of range of x and y coordinates to add to the
plot x and y limits. Used to create a bit of extra space around the
margin of each plot.}
@@ -341,6 +345,10 @@
nrow = 5, ncol = 5, mirror = TRUE,
constant = TRUE)
permuplot(150, control = control, cex = 0.8)
+
+## permute strata
+fac <- factor(rep(1:6, each = 20), labels = paste("Ditch", 1:6))
+permuplot(length(fac), permControl(strata = fac, type = "strata"))
}
\keyword{ utilities }
\keyword{ design }
More information about the Vegan-commits
mailing list