[Vegan-commits] r293 - in pkg: R inst man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Mar 29 21:15:35 CET 2008


Author: gsimpson
Date: 2008-03-29 21:15:35 +0100 (Sat, 29 Mar 2008)
New Revision: 293

Added:
   pkg/R/permuplot.R
Modified:
   pkg/inst/ChangeLog
   pkg/man/permCheck.Rd
Log:
New function permuplot() for graphical representation of permutation designs

Added: pkg/R/permuplot.R
===================================================================
--- pkg/R/permuplot.R	                        (rev 0)
+++ pkg/R/permuplot.R	2008-03-29 20:15:35 UTC (rev 293)
@@ -0,0 +1,135 @@
+`permuplot` <- function(n, control = permControl(),
+                        col = par("col"),
+                        hcol = "red",
+                        xlim=NULL, ylim=NULL,
+                        inset = 0.1,
+                        main=NULL, sub=NULL,
+                        ann = par("ann"),
+                        ...) {
+    xy.series <- function(n) {
+        angle <- seq(0, 2*pi, length = n+1)[-(n+1)]
+        x <- rev(cos(angle))
+        y <- rev(sin(angle))
+        xy <- xy.coords(x, y)
+        return(xy)
+    }
+    xy.free <- function(n) {
+        x <- runif(n)
+        y <- runif(n)
+        xy <- xy.coords(x, y)
+        return(xy)
+    }
+    xy.grid <- function(ncol, nrow) {
+        x <- rep(seq_len(ncol), each = nrow)
+        y <- rev(rep(seq_len(nrow), times = ncol))
+        xy <- xy.coords(x, y)
+        return(xy)
+    }
+    axis.limits <- function(vals, inset) {
+        lim <- range(vals[is.finite(vals)])
+        lim.range <- lim[2] - lim[1]
+        res <- c(lim[1] - (lim.range * inset),
+                 lim[2] + (lim.range * inset))
+        return(res)
+    }
+    use.strata <- !is.null(control$strata)
+    if(use.strata) {
+        tab <- table(control$strata)
+        n.grp <- length(tab)
+        opar <- par(no.readonly=TRUE, mar=c(2,2,2,1)+0.1,
+                    mfrow = n2mfrow(n.grp),
+                    oma=c(2.1,0,3.1,0))
+        on.exit(par(opar))
+        xy <- 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 = ""),
+                         paste("mirror: ", control$mirror, ";",
+                               sep = ""),
+                         paste("constant: ", control$constant, ";",
+                               sep = ""),
+                         sep = "    ")
+            if(control$type == "grid")
+                sub <- paste(sub, paste("ncol: ",
+                                        control$ncol, ";",
+                                        sep = ""),
+                             paste("nrow: ", control$nrow, ";",
+                                   sep = ""),
+                             sep = "    ")
+            title(main = paste("Permutation type:", control$type),
+                  outer = TRUE, cex.main = 1.75, ...)
+            title(sub = sub, outer = TRUE, line = 0.5,
+                  cex.sub = 1, ...)
+        }
+    } else {
+        xy <- switch(control$type,
+                     free = xy.free(n),
+                     series = xy.series(n),
+                     grid = xy.grid(control$ncol, control$nrow),
+                     stop("Unsupport permutation 'type'"))
+        if(is.null(xlim)) {
+            xlim <- axis.limits(xy$x, inset)
+        }
+        if(is.null(ylim)) {
+            ylim <- axis.limits(xy$y, inset)
+        }
+        opar <- par(no.readonly=TRUE, mar=c(2,1,3,1)+0.1)
+        on.exit(par(opar))
+        if(is.null(main))
+            main <- paste("Permutation type:", control$type)
+        if(is.null(sub))
+            sub <- paste(paste("n: ", n, ";", sep = ""),
+                         paste("mirror: ", control$mirror, ";",
+                               sep = ""),
+                         sep = "      ")
+        plot.new()
+        plot.window(xlim, ylim, asp = 1, ...)
+        labs <- permuted.index2(n, control=control)
+        cols <- switch(control$type,
+                       free = rep(col, n),
+                       series = c(hcol, rep(col, n-1)),
+                       grid = {cols <- rep(col, n)
+                               cols[which.min(labs)] <- hcol
+                               cols})
+        text(xy$x, xy$y, labels = labs,
+             col = cols, ...)
+        if(ann) {
+            title(main = main, ...)
+            title(sub = sub, line = 0.5, ...)
+        }
+        box()
+    }
+    invisible()
+}

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2008-03-29 16:14:56 UTC (rev 292)
+++ pkg/inst/ChangeLog	2008-03-29 20:15:35 UTC (rev 293)
@@ -4,6 +4,11 @@
 
 Version 1.12-7 (opened Mar 25, 2008)
 
+	* permuplot: New function, produces a graphical representation
+	of a permutation design given a number of observations and a
+	object returned by permControl(). The function handles all the
+	permutation designs currently handled by permuted.index2().
+
 	* permuted.index2: was not returning correct sample indices
 	for grid designs within strata. Also,was not consitently 
 	mirroring series and grid designs when 'constant = TRUE' (i.e. 

Modified: pkg/man/permCheck.Rd
===================================================================
--- pkg/man/permCheck.Rd	2008-03-29 16:14:56 UTC (rev 292)
+++ pkg/man/permCheck.Rd	2008-03-29 20:15:35 UTC (rev 293)
@@ -12,6 +12,7 @@
 \alias{print.allPerms}
 \alias{summary.allPerms}
 \alias{print.summary.allPerms}
+\alias{permuplot}
 
 \title{Utility functions for permutation schemes}
 \description{
@@ -20,7 +21,9 @@
   permutations possible under the current permutation
   scheme. \code{allPerms} enumerates all possible permutations for the
   given scheme. \code{getNumObs} is a utility function to return the
-  number of observations for a range of R and ordination objects.
+  number of observations for a range of R and ordination
+  objects. \code{permuplot} produces a graphical representation of the
+  selected permutation design.
 }
 \usage{
 permCheck(object, control = permControl())
@@ -41,6 +44,10 @@
 \method{getNumObs}{numeric}(object, \dots)
 
 \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)
 }
 
 \arguments{
@@ -60,12 +67,20 @@
   \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{\dots}{arguments to other methods.}
+  \item{col, xlim, ylim, main, sub, ann}{Graphical parameters.}
+  \item{hcol}{Colour to use for highlighting observations.}
+  \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.}
+  \item{\dots}{arguments to other methods. For \code{permuplot}
+    graphical parameters can be passed to plotting functions, though
+    note that not all parameters will be accepted gracefully at the
+    moment.}
 }
 \details{
-  \code{permCheck}, \code{allPerms} and \code{numPerms} are utility
-  functions for working with the new permutation schemes available in
-  \code{\link{permuted.index2}}.
+  \code{permCheck}, \code{allPerms}, \code{numPerms} and
+  \code{permuplot} are utility functions for working with the new
+  permutation schemes available in \code{\link{permuted.index2}}.
 
   \code{permCheck} is used to check the current permutation schemes
   against the object to which it will be applied. It calculates the
@@ -118,6 +133,23 @@
   will work for any object for which a \code{\link{scores}} method
   exists. This includes matrices and data frames, as well as specific
   methods for numeric or integer vectors.
+
+  \code{permuplot} is a graphical utility function, which produces a
+  graphical representation of a permutation design. It takes the number
+  of observations and an object returned by \code{\link{permControl}} as
+  arguments and produces a plot on the currently active device. If
+  strata are present in the design, the plotting region is split into
+  sufficient plotting regions (one for each stratum), and the design in
+  each stratum plotted.
+
+  Free permutation designs are represented by plotting the observation
+  number at random x and y coordinates. Series designs (time series or
+  line transects) are represented by plotting the observation numbers
+  comprising the series in a circle and the start of the permuted series
+  is highlighted using colour \code{hcol}. Grid designs are drawn on a
+  regular grid and the top left observation in the original grid is
+  highlighted using colour \code{hcol}. Note the ordering used is R's
+  standard ordering for matrices - columns are filled first.
 }
 \value{
   For \code{permCheck} a list containing the maximum number of
@@ -136,6 +168,8 @@
 
   For \code{getNumObs}, the (numeric) number of observations in
   \code{object}.
+
+  For \code{permuplot}, a plot on the currently active device.
 }
 %\references{
 %}
@@ -166,7 +200,7 @@
   without mirroring (if one reorders the rows). A similar situation
   arises in \code{"grid"} designs where the number of \strong{columns}
   per \emph{grid} is equal to 2. Note that the number of rows per
-  \emph{grid} is not a factor.
+  \emph{grid} is not an issue here.
 }
 \author{Gavin Simpson}
 \seealso{\code{\link{permuted.index2}} and \code{\link{permControl}}.}
@@ -247,7 +281,64 @@
 ## series permutations in levels of strata
 numPerms(7, permControl(type = "series", strata = fac))
 allPerms(7, permControl(type = "series", strata = fac))
+
+## Tests for permuplot
+n <- 25
+## standard permutation designs
+permuplot(n, permControl(type = "free"))
+permuplot(n, permControl(type = "series"))
+permuplot(n, permControl(type = "grid", nrow = 5, ncol = 5))
+
+## restricted perms with mirroring
+permuplot(n, permControl(type = "series", mirror = TRUE))
+permuplot(n, permControl(type = "grid", nrow = 5, ncol = 5,
+                             mirror = TRUE))
+
+## perms within strata
+fac <- gl(6, 20)
+control <- permControl(type = "free", strata = fac)
+permuplot(120, control = control, cex = 0.8)
+control <- permControl(type = "series", strata = fac)
+permuplot(120, control = control, cex = 0.8)
+fac <- gl(6, 25)
+control <- permControl(type = "grid", strata = fac,
+                       nrow = 5, ncol = 5)
+permuplot(150, control = control, cex = 0.8)
+
+## perms within strata with mirroring
+fac <- gl(6, 20)
+control <- permControl(type = "series", strata = fac,
+                       mirror = TRUE)
+permuplot(120, control = control, cex = 0.8)
+fac <- gl(6, 25)
+control <- permControl(type = "grid", strata = fac,
+                       nrow = 5, ncol = 5, mirror = TRUE)
+permuplot(150, control = control, cex = 0.8)
+
+## same perms within strata
+fac <- gl(6, 20)
+control <- permControl(type = "free", strata = fac,
+                       constant = TRUE)
+permuplot(120, control = control, cex = 0.8)
+control <- permControl(type = "series", strata = fac,
+                       constant = TRUE)
+permuplot(120, control = control, cex = 0.8)
+fac <- gl(6, 25)
+control <- permControl(type = "grid", strata = fac,
+                       nrow = 5, ncol = 5, constant = TRUE)
+permuplot(150, control = control, cex = 0.8)
+
+## same perms within strata with mirroring
+fac <- gl(6, 20)
+control <- permControl(type = "series", strata = fac,
+                       mirror = TRUE, constant = TRUE)
+permuplot(120, control = control, cex = 0.8)
+fac <- gl(6, 25)
+control <- permControl(type = "grid", strata = fac,
+                       nrow = 5, ncol = 5, mirror = TRUE,
+                       constant = TRUE)
+permuplot(150, control = control, cex = 0.8)
 }
 \keyword{ utilities }
 \keyword{ design }
-
+\keyword{ methods }



More information about the Vegan-commits mailing list