[Vegan-commits] r1781 - in pkg/permute: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Aug 31 22:55:07 CEST 2011
Author: gsimpson
Date: 2011-08-31 22:55:07 +0200 (Wed, 31 Aug 2011)
New Revision: 1781
Modified:
pkg/permute/NAMESPACE
pkg/permute/R/allPerms.R
pkg/permute/R/permCheck.R
pkg/permute/R/permuplot.R
pkg/permute/R/print.permCheck.R
pkg/permute/R/print.summary.permCheck.R
pkg/permute/R/summary.permCheck.R
pkg/permute/man/allPerms.Rd
pkg/permute/man/permCheck.Rd
pkg/permute/man/shuffle-utils.Rd
pkg/permute/man/shuffle.Rd
Log:
deprecate permCheck in favour of check, plus code clean-up of allPerms
Modified: pkg/permute/NAMESPACE
===================================================================
--- pkg/permute/NAMESPACE 2011-08-30 16:13:23 UTC (rev 1780)
+++ pkg/permute/NAMESPACE 2011-08-31 20:55:07 UTC (rev 1781)
@@ -1,5 +1,5 @@
### Visible functions:
-export(`allPerms`, `Blocks`, `numPerms`, `permCheck`,
+export(`allPerms`, `Blocks`, `numPerms`, `check`, `permCheck`,
`permControl`, `permute`, `shuffle`, `Within`,
`shuffleFree`, `shuffleSeries`, `shuffleGrid`, `shuffleStrata`,
`getBlocks`, `getWithin`, `getStrata`,
@@ -16,13 +16,13 @@
### S3 Methods
## print methods
S3method(`print`, `allPerms`)
-S3method(`print`, `permCheck`)
+S3method(`print`, `check`)
S3method(`print`, `permControl`)
S3method(`print`, `summary.allPerms`)
-S3method(`print`, `summary.permCheck`)
+S3method(`print`, `summary.check`)
## summary methods
S3method(`summary`, `allPerms`)
-S3method(`summary`, `permCheck`)
+S3method(`summary`, `check`)
## nobs() methods
S3method(`nobs`, `numeric`)
S3method(`nobs`, `integer`)
Modified: pkg/permute/R/allPerms.R
===================================================================
--- pkg/permute/R/allPerms.R 2011-08-30 16:13:23 UTC (rev 1780)
+++ pkg/permute/R/allPerms.R 2011-08-31 20:55:07 UTC (rev 1781)
@@ -1,14 +1,7 @@
`allPerms` <- function(n, control = permControl(), max = 9999,
observed = FALSE) {
- ## what does this do - used below to generate the
- ## permutations when constant == FALSE
- bar <- function(mat, n) {
- res <- vector(mode = "list", length = n)
- for(i in seq_len(n))
- res[[i]] <- mat
- do.call(rbind, res)
- }
- BAR <- function(mat, n) {
+ ## replicate a matrix by going via a list and bind together
+ repMat <- function(mat, n) {
res <- rep(list(mat), n)
do.call(rbind, res)
}
@@ -20,7 +13,7 @@
## number of observations in data
n <- nobs(v)
## check permutation scheme and update control
- pcheck <- permCheck(v, control = control, make.all = FALSE)
+ pcheck <- check(v, control = control, make.all = FALSE)
ctrl <- pcheck$control
## get max number of permutations
nperms <- pcheck$n
@@ -28,55 +21,56 @@
## esp with type = "free"
if(nperms > max)
stop("Number of possible permutations too large (> 'max')")
- type.wi <- ctrl$within$type
+ WI <- getWithin(ctrl)
+ STRATA <- getStrata(ctrl)
+ type.wi <- WI$type
if(type.wi != "none") {
- if(is.null(ctrl$strata)) {
+ if(is.null(STRATA)) {
res <- switch(type.wi,
free = allFree(n),
- series = allSeries(n, nperms, ctrl$within$mirror),
- grid = allGrid(n, nperms, ctrl$within$nrow,
- ctrl$within$ncol, ctrl$within$mirror,
- ctrl$within$constant))
+ series = allSeries(n, nperms, WI$mirror),
+ grid = allGrid(n, nperms, WI$nrow,
+ WI$ncol, WI$mirror, WI$constant))
} else {
## permuting within blocks
- tab <- table(ctrl$strata)
- if(ctrl$within$constant) {
+ tab <- table(STRATA)
+ if(WI$constant) {
## same permutation in each block
pg <- unique(tab)
- ctrl.wi <- permControl(strata = NULL, within = ctrl$within)
+ ctrl.wi <- permControl(strata = NULL, within = WI)
nperms <- numPerms(pg, ctrl.wi)
ord <- switch(type.wi,
free = allFree(pg),
- series = allSeries(pg, nperms, ctrl$within$mirror),
- grid = allGrid(pg, nperms, ctrl$within$nrow,
- ctrl$within$ncol, ctrl$within$mirror,
- ctrl$within$constant))
+ series = allSeries(pg, nperms, WI$mirror),
+ grid = allGrid(pg, nperms, WI$nrow,
+ WI$ncol, WI$mirror,
+ WI$constant))
perm.wi <- nrow(ord)
- sp <- split(v, ctrl$strata)
+ sp <- split(v, STRATA)
res <- matrix(nrow = nperms, ncol = n)
for(i in seq_len(perm.wi))
#res[i,] <- t(sapply(sp, function(x) x[ord[i,]]))
res[i,] <- sapply(sp, function(x) x[ord[i,]])
} else {
## different permutations within blocks
- tab <- table(ctrl$strata)
+ tab <- table(STRATA)
ng <- length(tab)
pg <- unique(tab)
if(length(pg) > 1) {
## different number of observations per level of strata
if(type.wi == "grid")
## FIXME: this should not be needed once all checks are
- ## in place in permCheck()
+ ## in place in check()
stop("Unbalanced grid designs are not supported")
- ctrl.wi <- permControl(strata = NULL, within = ctrl$within)
- sp <- split(v, ctrl$strata)
+ ctrl.wi <- permControl(strata = NULL, within = WI)
+ sp <- split(v, STRATA)
res <- vector(mode = "list", length = ng)
add <- c(0, cumsum(tab)[1:(ng-1)])
for(j in seq_along(tab)) {
np <- numPerms(tab[j], ctrl.wi)
ord <- switch(type.wi,
free = allFree(tab[j]),
- series = allSeries(tab[j], np, ctrl$within$mirror))
+ series = allSeries(tab[j], np, WI$mirror))
perm.wi <- nrow(ord)
if(j == 1) {
a <- 1
@@ -85,39 +79,40 @@
b <- b/perm.wi
a <- np / (b*perm.wi)
}
- res[[j]] <- matrix(rep(bar(ord+add[j], a),
+ res[[j]] <- matrix(rep(repMat(ord+add[j], a),
each = b),
ncol = tab[j])
}
res <- do.call(cbind, res)
- sp <- split(v, ctrl$strata)
+ sp <- split(v, STRATA)
res <- t(apply(res, 1,
function(x, inds, v) {v[inds] <- inds[x]; v},
unlist(sp), v))
} else {
## same number of observations per level of strata
- ctrl.wi <- permControl(strata = NULL, within = ctrl$within)
+ ctrl.wi <- permControl(strata = NULL, within = WI)
np <- numPerms(pg, ctrl.wi)
ord <-
switch(type.wi,
free = allFree(pg),
- series = allSeries(pg, np, ctrl$within$mirror),
- grid = allGrid(pg, np, ctrl$within$nrow,
- ctrl$within$ncol, ctrl$within$mirror,
- ctrl$within$constant))
+ series = allSeries(pg, np, WI$mirror),
+ grid = allGrid(pg, np, WI$nrow,
+ WI$ncol, WI$mirror,
+ WI$constant))
perm.wi <- nrow(ord)
add <- seq(from = 0, by = pg, length.out = ng)
res <- vector(mode = "list", length = ng)
a <- 1
b <- np / perm.wi
for(i in seq_len(ng)) {
- res[[i]] <- matrix(rep(bar(ord+add[i], a), each = b),
+ res[[i]] <- matrix(rep(repMat(ord+add[i], a),
+ each = b),
ncol = pg)
a <- a*perm.wi
b <- b/perm.wi
}
res <- do.call(cbind, res)
- sp <- split(v, ctrl$strata)
+ sp <- split(v, STRATA)
res <- t(apply(res, 1,
function(x, inds, v) {v[inds] <- inds[x]; v},
unlist(sp), v))
@@ -133,7 +128,7 @@
} else {
## permuting blocks AND within blocks
## need a local CTRL that just permutes blocks
- ctrl.b <- permControl(strata = getStrata(ctrl),
+ ctrl.b <- permControl(strata = STRATA,
within = Within(type = "none"),
blocks = getBlocks(ctrl))
## number of permutations for just the block level
Modified: pkg/permute/R/permCheck.R
===================================================================
--- pkg/permute/R/permCheck.R 2011-08-30 16:13:23 UTC (rev 1780)
+++ pkg/permute/R/permCheck.R 2011-08-31 20:55:07 UTC (rev 1781)
@@ -1,5 +1,5 @@
-`permCheck` <- function(object, control = permControl(),
- make.all = TRUE)
+`check` <- function(object, control = permControl(),
+ make.all = TRUE)
{
## if object is numeric or integer and of length 1,
## extend the object
@@ -49,6 +49,13 @@
observed = FALSE)
}
retval <- list(n = num.pos, control = control)
- class(retval) <- "permCheck"
+ class(retval) <- "check"
retval
}
+
+## depricate check
+`permCheck` <- function(object, control = permControl(),
+ make.all = TRUE) {
+ .Deprecated(new = "check", "permute")
+ check(object = object, control = control, make.all = make.all)
+}
Modified: pkg/permute/R/permuplot.R
===================================================================
--- pkg/permute/R/permuplot.R 2011-08-30 16:13:23 UTC (rev 1780)
+++ pkg/permute/R/permuplot.R 2011-08-31 20:55:07 UTC (rev 1781)
@@ -46,7 +46,7 @@
stop("'n' and length of 'strata' don't match.")
}
## check the control design
- control <- permCheck(n, control = control)$control
+ control <- check(n, control = control)$control
if(use.strata) {
n.grp <- length(tab)
opar <- par(no.readonly=TRUE, mar=c(2,2,2,1)+0.1,
Modified: pkg/permute/R/print.permCheck.R
===================================================================
--- pkg/permute/R/print.permCheck.R 2011-08-30 16:13:23 UTC (rev 1780)
+++ pkg/permute/R/print.permCheck.R 2011-08-31 20:55:07 UTC (rev 1781)
@@ -1,4 +1,4 @@
-`print.permCheck` <- function(x, ...)
+`print.check` <- function(x, ...)
{
print(x$n)
}
Modified: pkg/permute/R/print.summary.permCheck.R
===================================================================
--- pkg/permute/R/print.summary.permCheck.R 2011-08-30 16:13:23 UTC (rev 1780)
+++ pkg/permute/R/print.summary.permCheck.R 2011-08-31 20:55:07 UTC (rev 1781)
@@ -1,4 +1,4 @@
-`print.summary.permCheck` <- function(x, ...)
+`print.summary.check` <- function(x, ...)
{
cat(paste("Number of possible permutations:", x$n, "\n"))
print(x$control)
Modified: pkg/permute/R/summary.permCheck.R
===================================================================
--- pkg/permute/R/summary.permCheck.R 2011-08-30 16:13:23 UTC (rev 1780)
+++ pkg/permute/R/summary.permCheck.R 2011-08-31 20:55:07 UTC (rev 1781)
@@ -1,5 +1,5 @@
-`summary.permCheck` <- function(object, ...)
+`summary.check` <- function(object, ...)
{
- class(object) <- "summary.permCheck"
+ class(object) <- "summary.check"
object
}
Modified: pkg/permute/man/allPerms.Rd
===================================================================
--- pkg/permute/man/allPerms.Rd 2011-08-30 16:13:23 UTC (rev 1780)
+++ pkg/permute/man/allPerms.Rd 2011-08-31 20:55:07 UTC (rev 1781)
@@ -53,7 +53,7 @@
number of observations and permutation scheme selected. The matrix has
two additional attributes \code{control} and
\code{observed}. Attribute \code{control} contains the argument
- \code{control} (possibly updated via \code{permCheck}). Attribute
+ \code{control} (possibly updated via \code{check}). Attribute
\code{observed} contains argument \code{observed}.
}
\author{Gavin Simpson}
Modified: pkg/permute/man/permCheck.Rd
===================================================================
--- pkg/permute/man/permCheck.Rd 2011-08-30 16:13:23 UTC (rev 1780)
+++ pkg/permute/man/permCheck.Rd 2011-08-31 20:55:07 UTC (rev 1781)
@@ -1,23 +1,21 @@
-\name{permCheck}
-\alias{permCheck}
-\alias{print.permCheck}
-\alias{print.summary.permCheck}
-\alias{summary.permCheck}
+\name{check}
+\alias{check}
+\alias{permCheck} % for the deprecated function
+\alias{print.check}
+\alias{print.summary.check}
+\alias{summary.check}
\alias{permuplot}
\title{Utility functions for permutation schemes}
\description{
- \code{permCheck} provides checking of permutation schemes for
- validity. \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. \code{permuplot} produces a graphical representation of the
+ \code{check} provides checking of permutation schemes for
+ validity. \code{permuplot} produces a graphical representation of the
selected permutation design.
}
\usage{
-permCheck(object, control = permControl(), make.all = TRUE)
+check(object, control = permControl(), make.all = TRUE)
-\method{summary}{permCheck}(object, \dots)
+\method{summary}{check}(object, \dots)
permuplot(n, control = permControl(), col = par("col"),
hcol = "red", shade = "lightgrey", xlim = NULL, ylim = NULL,
@@ -28,13 +26,13 @@
\arguments{
\item{object}{an R object. See Details for a
complete description, especially for \code{numPerms}. For
- \code{\link{summary.permCheck}} an object of class
- \code{"permCheck"}. For \code{\link{summary.allPerms}} an object of
+ \code{\link{summary.check}} an object of class
+ \code{"check"}. For \code{\link{summary.allPerms}} an object of
class \code{"allPerms"}.}
\item{control}{a list of control values describing properties of the
permutation design, as returned by a call to
\code{\link{permControl}}.}
- \item{make.all}{logical; should \code{permCheck} generate all
+ \item{make.all}{logical; should \code{check} generate all
possible permutations? Useful if want to check permutation design
but not produce the matrix of all permutations.}
\item{n}{the number of observations or an 'object' from which the
@@ -53,17 +51,16 @@
moment.}
}
\details{
- \code{permCheck}, \code{allPerms}, \code{numPerms} and
- \code{permuplot} are utility functions for working with the new
- permutation schemes available in \code{\link{shuffle}}.
+ \code{check} and \code{permuplot} are utility functions for working
+ with the new permutation schemes available in \code{\link{shuffle}}.
- \code{permCheck} is used to check the current permutation schemes
+ \code{check} is used to check the current permutation schemes
against the object to which it will be applied. It calculates the
maximum number of possible permutations for the number of observations
in \code{object} and the permutation scheme described by
\code{control}. The returned object contains component \code{control},
an object of class \code{"permControl"} suitably modified if
- \code{permCheck} identifies a problem.
+ \code{check} identifies a problem.
The main problem is requesting more permutations than possible with
the number of observations and the permutation design. In such cases,
@@ -76,11 +73,11 @@
permutations, and as such complete enumeration of all permutations is
turned on (\code{control$complete} is set to \code{TRUE}).
- Function \code{getNumObs} is a simple generic function to return the
- number of observations in a range of R objects. The default method
- will work for any object for which a \code{\link[vegan]{scores}}
- method exists. This includes matrices and data frames, as well as
- specific methods for numeric or integer vectors.
+ % Function \code{getNumObs} is a simple generic function to return the
+ % number of observations in a range of R objects. The default method
+ % will work for any object for which a \code{\link[vegan]{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
@@ -100,7 +97,7 @@
standard ordering for matrices - columns are filled first.
}
\value{
- For \code{permCheck} a list containing the maximum number of
+ For \code{check} a list containing the maximum number of
permutations possible and an object of class
\code{"\link{permControl}"}.
@@ -122,59 +119,59 @@
## no restrictions - lots of perms
CONTROL <- permControl(within = Within(type = "free"))
-(check1 <- permCheck(pyrifos, CONTROL))
+(check1 <- check(pyrifos, CONTROL))
summary(check1)
## no strata but data are series with no mirroring, so 132 permutations
CONTROL <- permControl(within = Within(type = "series",
mirror = FALSE))
-permCheck(pyrifos, CONTROL)
+check(pyrifos, CONTROL)
## no strata but data are series with mirroring, so 264 permutations
CONTROL <- permControl(within = Within(type = "series",
mirror = TRUE))
-permCheck(pyrifos, control = CONTROL)
+check(pyrifos, control = CONTROL)
## unrestricted within strata
-permCheck(pyrifos, control = permControl(strata = ditch,
+check(pyrifos, control = permControl(strata = ditch,
within = Within(type = "free")))
## time series within strata, no mirroring
-permCheck(pyrifos, control = permControl(strata = ditch,
+check(pyrifos, control = permControl(strata = ditch,
within = Within(type = "series",
mirror = FALSE)))
## time series within strata, with mirroring
-permCheck(pyrifos, control = permControl(strata = ditch,
+check(pyrifos, control = permControl(strata = ditch,
within = Within(type = "series",
mirror = TRUE)))
## time series within strata, no mirroring, same permutation
## within strata
-permCheck(pyrifos, control = permControl(strata = ditch,
+check(pyrifos, control = permControl(strata = ditch,
within = Within(type = "series",
constant = TRUE)))
## time series within strata, with mirroring, same permutation
## within strata
-permCheck(pyrifos, control = permControl(strata = ditch,
+check(pyrifos, control = permControl(strata = ditch,
within = Within(type = "series",
mirror = TRUE,
constant = TRUE)))
## permute strata
-permCheck(pyrifos, permControl(strata = ditch,
+check(pyrifos, permControl(strata = ditch,
within = Within(type = "none"),
blocks = Blocks(type = "free")))
%}
## this should also also for arbitrary vectors
-vec1 <- permCheck(1:100)
-vec2 <- permCheck(1:100, permControl())
+vec1 <- check(1:100)
+vec2 <- check(1:100, permControl())
all.equal(vec1, vec2)
-vec3 <- permCheck(1:100, permControl(within = Within(type = "series")))
+vec3 <- check(1:100, permControl(within = Within(type = "series")))
all.equal(100, vec3$n)
-vec4 <- permCheck(1:100, permControl(within =
+vec4 <- check(1:100, permControl(within =
Within(type= "series",
mirror = TRUE)))
all.equal(vec4$n, 200)
@@ -185,7 +182,7 @@
within = Within(type = "grid", mirror = FALSE,
constant = TRUE, nrow = 3,
ncol = 2))
-permCheck(1:12, ctrl)
+check(1:12, ctrl)
numPerms(1:12, control = ctrl)
(tmp <- allPerms(12, control = ctrl, observed = TRUE))
Modified: pkg/permute/man/shuffle-utils.Rd
===================================================================
--- pkg/permute/man/shuffle-utils.Rd 2011-08-30 16:13:23 UTC (rev 1780)
+++ pkg/permute/man/shuffle-utils.Rd 2011-08-31 20:55:07 UTC (rev 1781)
@@ -69,7 +69,7 @@
%\references{
%}
\author{Gavin Simpson}
-\seealso{\code{\link{permCheck}}, a utility function for checking
+\seealso{\code{\link{check}}, a utility function for checking
permutation scheme described by
\code{\link{permControl}}. \code{\link{shuffle}} as a user-oriented
wrapper to these functions.}
Modified: pkg/permute/man/shuffle.Rd
===================================================================
--- pkg/permute/man/shuffle.Rd 2011-08-30 16:13:23 UTC (rev 1780)
+++ pkg/permute/man/shuffle.Rd 2011-08-31 20:55:07 UTC (rev 1781)
@@ -136,7 +136,7 @@
%\references{
%}
\author{Gavin Simpson}
-\seealso{\code{\link{permCheck}}, a utility function for checking
+\seealso{\code{\link{check}}, a utility function for checking
permutation scheme described by \code{\link{permControl}}.}
\examples{
@@ -239,7 +239,7 @@
(xbar - ybar) / (pooled * sqrt(1/m + 1/n))
}
## check the control object
- control <- permCheck(x, control)$control
+ control <- check(x, control)$control
## number of observations
Nobs <- nobs(x)
## group names
More information about the Vegan-commits
mailing list