[Vegan-commits] r310 - in branches/1.11-0: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Apr 9 15:03:06 CEST 2008
Author: jarioksa
Date: 2008-04-09 15:03:06 +0200 (Wed, 09 Apr 2008)
New Revision: 310
Modified:
branches/1.11-0/R/allPerms.R
branches/1.11-0/man/permCheck.Rd
Log:
upgraded allPerms.R and permCheck.Rd to latest versions in branches/
Modified: branches/1.11-0/R/allPerms.R
===================================================================
--- branches/1.11-0/R/allPerms.R 2008-04-09 09:16:52 UTC (rev 309)
+++ branches/1.11-0/R/allPerms.R 2008-04-09 13:03:06 UTC (rev 310)
@@ -20,7 +20,8 @@
X[i,] <- seq(i, length = n)%%n + 1
}
## if mirroring, rev the cols of X[v,]
- if(control$mirror)
+ ## but only if n > 2
+ if(control$mirror && (nperms > 2))
X[(n+1):(2*n),] <- X[v, rev(v)]
X
}
@@ -65,7 +66,7 @@
}
X
}
- `all.strata` <- function(n, control) {#, nperms) {
+ `all.strata` <- function(n, control) {
v <- seq_len(n)
nperms <- numPerms(v, control)
lev <- length(levels(control$strata))
@@ -76,14 +77,6 @@
X[i,] <- unname(do.call(c, sp[perms[i,]]))
X
}
- ## recursive fun for perms within strata
- ##bar <- function(mat, n) {
- ## if(n == 1)
- ## mat
- ## else
- ## mat <- rbind(mat, Recall(mat, n-1))
- ## mat
- ##}
## replacement for recursive function above
bar <- function(mat, n) {
res <- vector(mode = "list", length = n)
@@ -113,6 +106,10 @@
type <- control$type
if(type != "strata" && !is.null(control$strata)) {
## permuting within blocks
+ ## FIXME: allperms expects samples to be arranged
+ ## in order of fac, i.e. all level 1, followed by
+ ## all level 2 - fix to allow them to be in any order:
+ ## see permuted.index2 for how to do this
if(control$constant) {
## same permutation in each block
#v <- seq_len(n)
@@ -121,41 +118,74 @@
mirror = control$mirror,
nrow = control$nrow,
ncol = control$ncol)
- nperm <- numPerms(v, control)
+ nperms <- numPerms(v, control)
ord <- switch(control$type,
free = all.free(pg),
series = all.series(pg, control = control.wi),
grid = all.grid(pg, control = control.wi))
perm.wi <- nrow(ord)
sp <- split(v, control$strata)
- res <- matrix(nrow = nperm, ncol = n)
+ res <- matrix(nrow = nperms, ncol = n)
for(i in seq_len(perm.wi))
res[i,] <- sapply(sp, function(x) x[ord[i,]])
} else {
## different permutations within blocks
- ng <- length(levels(control$strata))
- pg <- length(control$strata) / ng
- control.wi <- permControl(type = control$type,
- mirror = control$mirror,
- nrow = control$nrow,
- ncol = control$ncol)
- ord <- switch(control$type,
- free = all.free(pg),
- series = all.series(pg, control = control.wi),
- grid = all.grid(pg, control = control.wi)
- )
- perm.wi <- nrow(ord)
- add <- seq(from = 0, by = pg, length.out = ng)
- res <- vector(mode = "list", length = ng)
- a <- 1
- b <- nperms / perm.wi
- for(i in seq_len(ng)) {
- res[[i]] <- matrix(rep(bar(ord+add[i], a), each = b),
- ncol = pg)
- a <- a*perm.wi
- b <- b/perm.wi
+ tab <- table(control$strata)
+ ng <- length(tab)
+ pg <- unique(tab)
+ if(length(pg) > 1) {
+ ## different number of observations per level of strata
+ if(control$type == "grid")
+ ## FIXME: this should not be needed once all checks are
+ ## in place in permCheck()
+ stop("Unbalanced grid designs are not supported")
+ control.wi <- permControl(type = control$type,
+ mirror = control$mirror)
+ sp <- split(v, control$strata)
+ res <- vector(mode = "list", length = ng)
+ add <- c(0, cumsum(tab)[1:(ng-1)])
+ for(j in seq(along = tab)) {
+ ord <- switch(control.wi$type,
+ free = all.free(tab[j]),
+ series = all.series(tab[j],
+ control=control.wi))
+ perm.wi <- nrow(ord)
+ if(j == 1) {
+ a <- 1
+ b <- nperms / perm.wi
+ } else {
+ b <- b/perm.wi
+ a <- nperms / (b*perm.wi)
+ }
+ res[[j]] <- matrix(rep(bar(ord+add[j], a),
+ each = b),
+ ncol = tab[j])
+ }
+ res <- do.call(cbind, res)
+ } else {
+ ## same number of observations per level of strata
+ control.wi <- permControl(type = control$type,
+ mirror = control$mirror,
+ nrow = control$nrow,
+ ncol = control$ncol)
+ ord <- switch(control$type,
+ free = all.free(pg),
+ series = all.series(pg, control = control.wi),
+ grid = all.grid(pg, control = control.wi)
+ )
+ perm.wi <- nrow(ord)
+ add <- seq(from = 0, by = pg, length.out = ng)
+ res <- vector(mode = "list", length = ng)
+ a <- 1
+ b <- nperms / perm.wi
+ for(i in seq_len(ng)) {
+ res[[i]] <- matrix(rep(bar(ord+add[i], a), each = b),
+ ncol = pg)
+ a <- a*perm.wi
+ b <- b/perm.wi
+ }
+ res <- do.call(cbind, res)
}
- res <- do.call(cbind, res)
}
} else {
## no blocks
Modified: branches/1.11-0/man/permCheck.Rd
===================================================================
--- branches/1.11-0/man/permCheck.Rd 2008-04-09 09:16:52 UTC (rev 309)
+++ branches/1.11-0/man/permCheck.Rd 2008-04-09 13:03:06 UTC (rev 310)
@@ -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{
@@ -64,14 +65,18 @@
\item{make.all}{logical; should \code{permCheck} 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.}
+ \item{n}{the number of observations or an 'object' from which the
+ number of observations can be determined via \code{getNumObs}.}
\item{max}{the maximum number of permutations, below which complete
enumeration will be attempted. See Details.}
\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.}
@@ -285,6 +290,10 @@
numPerms(7, permControl(type = "series", strata = fac))
allPerms(7, permControl(type = "series", strata = fac))
+## allPerms can work with a vector
+vec <- c(3,4,5)
+allPerms(vec)
+
## Tests for permuplot
n <- 25
## standard permutation designs
@@ -341,6 +350,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