[Vegan-commits] r440 - in pkg: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Jul 5 16:52:49 CEST 2008
Author: gsimpson
Date: 2008-07-05 16:52:49 +0200 (Sat, 05 Jul 2008)
New Revision: 440
Modified:
pkg/DESCRIPTION
pkg/R/allPerms.R
pkg/R/numPerms.R
pkg/R/permCheck.R
pkg/R/permControl.R
pkg/R/permuplot.R
pkg/R/permuted.index2.R
pkg/inst/ChangeLog
pkg/man/permCheck.Rd
pkg/man/permuted.index2.Rd
Log:
permuted.index2 and associated functions now allow restricted permutations of strata.
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2008-06-28 05:36:08 UTC (rev 439)
+++ pkg/DESCRIPTION 2008-07-05 14:52:49 UTC (rev 440)
@@ -1,7 +1,7 @@
Package: vegan
Title: Community Ecology Package
-Version: 1.14-6
-Date: June 23, 2008
+Version: 1.14-7
+Date: July 5, 2008
Author: Jari Oksanen, Roeland Kindt, Pierre Legendre, Bob O'Hara, Gavin L. Simpson,
Peter Solymos, M. Henry H. Stevens, Helene Wagner
Maintainer: Jari Oksanen <jari.oksanen at oulu.fi>
Modified: pkg/R/allPerms.R
===================================================================
--- pkg/R/allPerms.R 2008-06-28 05:36:08 UTC (rev 439)
+++ pkg/R/allPerms.R 2008-07-05 14:52:49 UTC (rev 440)
@@ -71,7 +71,13 @@
nperms <- numPerms(v, control)
lev <- length(levels(control$strata))
X <- matrix(nrow = nperms, ncol = length(control$strata))
- perms <- all.free(lev)
+ perms <- if(control$type == "free") {
+ all.free(lev)
+ } else if(control$type == "series") {
+ all.series(lev, control = control)
+ } else {
+ all.grid(lev, control = control)
+ }
sp <- split(v, control$strata)
for(i in seq_len(nrow(perms)))
X[i,] <- unname(do.call(c, sp[perms[i,]]))
@@ -104,7 +110,8 @@
if(nperms > max)
stop("Number of possible permutations too big (> 'max')")
type <- control$type
- if(type != "strata" && !is.null(control$strata)) {
+ ##if(type != "strata" && !is.null(control$strata)) {
+ if(!control$permute.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
@@ -188,7 +195,7 @@
}
}
} else {
- ## no blocks
+ ## not permuting within blocks or are permuting strata
res <- switch(type,
free = all.free(n),
series = all.series(n, control=control),
Modified: pkg/R/numPerms.R
===================================================================
--- pkg/R/numPerms.R 2008-06-28 05:36:08 UTC (rev 439)
+++ pkg/R/numPerms.R 2008-07-05 14:52:49 UTC (rev 440)
@@ -12,61 +12,80 @@
if(use.strata) {
tab.strata <- table(control$strata)
same.n <- length(unique(tab.strata))
- if((control$type == "strata" && same.n > 1) ||
+ if((control$permute.strata && same.n > 1) ||
(control$constant == TRUE && same.n > 1))
stop("All levels of strata must have same number of samples for chosen scheme")
if(control$type == "grid" && same.n > 1)
stop("Unbalanced grid designs are not supported")
}
- ## calculate number of possible permutations
- num.pos <- if(control$type == "free") {
- if(use.strata)
- prod(factorial(tab.strata))
- else
- exp(lfactorial(nobs))
- } else if(control$type %in% c("series","grid")) {
+ ## generate multiplier for restricted permutations
+ if(control$type %in% c("series","grid")) {
multi <- 2
- if(control$type == "grid") {
- if(control$ncol == 2)
- multi <- 2
- else
- multi <- 4
+ if(control$type == "grid" && control$ncol > 2) {
+ multi <- 4
} else {
if(nobs == 2)
multi <- 1
}
- if(use.strata) {
- if(same.n > 1) {
- multi <- rep(2, length = length(tab.strata))
- multi[which(tab.strata == 2)] <- 1
- if(control$mirror) {
- prod(multi * tab.strata)
+ }
+ ## calculate number of possible permutations
+ num.pos <- if(control$permute.strata) {
+ if(control$type == "free")
+ exp(lfactorial(length(levels(control$strata))))
+ else if(control$type %in% c("series","grid")) {
+ if(control$mirror)
+ multi * nobs
+ else
+ nobs
+ }
+ } else {
+ if(control$type == "free") {
+ if(use.strata)
+ prod(factorial(tab.strata))
+ else
+ exp(lfactorial(nobs))
+ } else if(control$type %in% c("series","grid")) {
+ ##multi <- 2
+ ##if(control$type == "grid") {
+ ## if(control$ncol == 2)
+ ## multi <- 2
+ ## else
+ ## multi <- 4
+ ##} else {
+ ## if(nobs == 2)
+ ## multi <- 1
+ ##}
+ if(use.strata) {
+ if(same.n > 1) {
+ multi <- rep(2, length = length(tab.strata))
+ multi[which(tab.strata == 2)] <- 1
+ if(control$mirror) {
+ prod(multi * tab.strata)
+ } else {
+ prod(tab.strata)
+ }
} else {
- prod(tab.strata)
+ if(control$mirror) {
+ if(control$constant)
+ multi * unique(tab.strata)
+ else
+ prod(multi * tab.strata)
+ } else {
+ if(control$constant)
+ unique(tab.strata)
+ else
+ prod(tab.strata)
+ }
}
} else {
- if(control$mirror) {
- if(control$constant)
- multi * unique(tab.strata)
- else
- prod(multi * tab.strata)
- } else {
- if(control$constant)
- unique(tab.strata)
- else
- prod(tab.strata)
- }
+ if(control$mirror)
+ multi * nobs
+ else
+ nobs
}
} else {
- if(control$mirror)
- multi * nobs
- else
- nobs
+ stop("Ambiguous permutation type in 'control$type'")
}
- } else if(control$type == "strata") {
- exp(lfactorial(length(levels(control$strata))))
- } else {
- stop("Ambiguous permutation type in 'control$type'")
}
num.pos
}
Modified: pkg/R/permCheck.R
===================================================================
--- pkg/R/permCheck.R 2008-06-28 05:36:08 UTC (rev 439)
+++ pkg/R/permCheck.R 2008-07-05 14:52:49 UTC (rev 440)
@@ -21,12 +21,12 @@
## if grid design, check nrow*ncol is multiple of nobs
if(type == "grid" &&
!identical(nobs %% (control$ncol * control$nrow), 0))
- stop("'nrow' * 'ncol' not a multilpe of number of observations.")
+ stop("'nrow' * 'ncol' not a multiple of number of observations.")
## if constant, check design balanced?
if(control$constant && bal > 1)
stop("Unbalanced designs not allowed with 'constant = TRUE'.")
## if permuting strata, must be balanced
- if(type == "strata" && bal > 1)
+ if(control$permute.strata && bal > 1)
stop("Design must be balanced if permuting 'strata'.")
}
##
Modified: pkg/R/permControl.R
===================================================================
--- pkg/R/permControl.R 2008-06-28 05:36:08 UTC (rev 439)
+++ pkg/R/permControl.R 2008-07-05 14:52:49 UTC (rev 440)
@@ -1,5 +1,7 @@
`permControl` <- function(strata = NULL, nperm = 199, complete = FALSE,
- type = c("free", "series", "grid", "strata"),
+ #type = c("free", "series", "grid", "strata"),
+ type = c("free","series","grid"),
+ permute.strata = FALSE,
maxperm = 9999, minperm = 99,
mirror = FALSE, constant = FALSE,
ncol = NULL, nrow = NULL,
@@ -10,7 +12,7 @@
else
type <- match.arg(type)
out <- list(strata = strata, nperm = nperm, complete = complete,
- type = type,
+ type = type, permute.strata = permute.strata,
maxperm = maxperm, minperm = minperm,
mirror = mirror, constant = constant,
ncol = ncol, nrow = nrow, all.perms = all.perms,
Modified: pkg/R/permuplot.R
===================================================================
--- pkg/R/permuplot.R 2008-06-28 05:36:08 UTC (rev 439)
+++ pkg/R/permuplot.R 2008-07-05 14:52:49 UTC (rev 440)
@@ -34,6 +34,9 @@
lim[2] + (lim.range * inset))
return(res)
}
+ ## currently doesn't support restricted permutations of strata themselves
+ if(control$permute.strata && control$type != "free")
+ stop("Restricted permutations of strata currently not supported")
## check that n and length of strata are equal
if( use.strata <- !is.null(control$strata) ) {
tab <- table(control$strata)
@@ -50,7 +53,7 @@
on.exit(par(opar))
## if permuting strata, only need to draw the sub-plots
## in a different order
- if(control$type == "strata") {
+ if(control$permute.strata) {
## expand shade, col
if(identical(length(col), 1))
col <- rep(col, n.grp)
Modified: pkg/R/permuted.index2.R
===================================================================
--- pkg/R/permuted.index2.R 2008-06-28 05:36:08 UTC (rev 439)
+++ pkg/R/permuted.index2.R 2008-07-05 14:52:49 UTC (rev 440)
@@ -2,12 +2,28 @@
function (n, control = permControl())
{
`permuted.strata` <-
- function(strata)
+ function(strata, type, mirror = FALSE, start = NULL, flip = NULL,
+ nrow, ncol, start.row = NULL, start.col = NULL)
{
lev <- length(levels(strata))
ngr <- length(strata) / lev
sp <- split(seq(along = strata), strata)
- unname(do.call(c, sp[.Internal(sample(lev, lev, FALSE, NULL))]))
+ if(type == "free") {
+ unname(do.call(c, sp[.Internal(sample(lev, lev, FALSE, NULL))]))
+ } else if(type == "series") {
+ unname(do.call(c, sp[permuted.series(seq_len(lev),
+ mirror = mirror,
+ start = start,
+ flip = flip)]))
+ } else if(type == "grid") {
+ unname(do.call(c, sp[permuted.grid(nrow = nrow, ncol = ncol,
+ mirror = mirror,
+ start.row = start.row,
+ start.col = start.col,
+ flip = flip)]))
+ } else {
+ stop("Invalid permutation type.")
+ }
}
`permuted.grid` <-
function(nrow, ncol, mirror = FALSE,
@@ -60,8 +76,25 @@
"grid" = permuted.grid(nrow = control$nrow,
ncol = control$ncol, mirror = control$mirror)
)
- } else if(control$type == "strata") {
- out <- permuted.strata(control$strata)
+ } else if(control$permute.strata) {
+ if(control$constant) {
+ if(control$type == "series") {
+ n.lev <- length(levels(control$strata))
+ start <- .Internal(sample(n.lev, 1, FALSE, NULL))
+ flip <- runif(1) < 0.5
+ } else if(control$type == "grid") {
+ start.row <- .Internal(sample(control$nrow, 1, FALSE, NULL))
+ start.col <- .Internal(sample(control$ncol, 1, FALSE, NULL))
+ flip <- runif(2) < 0.5
+ }
+ } else {
+ start <- start.row <- start.col <- flip <- NULL
+ }
+ out <- permuted.strata(control$strata, type = control$type,
+ mirror = control$mirror,
+ start = start, flip = flip,
+ nrow = control$nrow, ncol = control$ncol,
+ start.row = start.row, start.col = start.col)
} else {
out <- 1:n
inds <- names(table(control$strata))
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2008-06-28 05:36:08 UTC (rev 439)
+++ pkg/inst/ChangeLog 2008-07-05 14:52:49 UTC (rev 440)
@@ -2,8 +2,16 @@
VEGAN DEVEL VERSIONS at http://r-forge.r-project.org/
-Version 1.14-6 (opened June 23, 2008)
+Version 1.14-7 (opened July 5, 2008)
+ * permutations: permuted.index2 and associated functions now allow
+ for restricted permutations of strata (i.e. restricted shuffling
+ of the blocks). This changes the acceptable 'type' options and adds
+ a new argument 'permute.strata' to permControl(), to control how
+ and what is permuted.
+
+Version 1.14-6 (closed July 5, 2008)
+
* permatswap (nestedness.c): translated Peter Solymos's
swapcount.R to C. This is still experimental code, and the user
interface is undocumented, except here: use method = "Cswap" in
Modified: pkg/man/permCheck.Rd
===================================================================
--- pkg/man/permCheck.Rd 2008-06-28 05:36:08 UTC (rev 439)
+++ pkg/man/permCheck.Rd 2008-07-05 14:52:49 UTC (rev 440)
@@ -253,7 +253,8 @@
type = "series", mirror = TRUE, constant = TRUE))
## permute strata
-permCheck(pyrifos, permControl(strata = ditch, type = "strata"))
+permCheck(pyrifos, permControl(strata = ditch, type = "free",
+ permute.strata = TRUE))
## this should also also for arbitrary vectors
vec1 <- permCheck(1:100)
@@ -351,9 +352,6 @@
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 }
Modified: pkg/man/permuted.index2.Rd
===================================================================
--- pkg/man/permuted.index2.Rd 2008-06-28 05:36:08 UTC (rev 439)
+++ pkg/man/permuted.index2.Rd 2008-07-05 14:52:49 UTC (rev 440)
@@ -13,7 +13,8 @@
permuted.index2(n, control = permControl())
permControl(strata = NULL, nperm = 199, complete = FALSE,
- type = c("free", "series", "grid", "strata"),
+ type = c("free", "series", "grid"),
+ permute.strata = FALSE,
maxperm = 9999, minperm = 99,
mirror = FALSE, constant = FALSE,
ncol = NULL, nrow = NULL,
@@ -34,7 +35,9 @@
\item{complete}{logical; should complete enumeration of all
permutations be performed?}
\item{type}{the type of permutations required. One of \code{"free"},
- \code{"series"}, \code{"grid"} or \code{"strata"}. See Details.}
+ \code{"series"}, or \code{"grid"}. See Details.}
+ \item{permute.strata}{logical; should strata be permuted? See
+ Details.}
\item{maxperm}{the maximum number of permutations to
perform. Currently unused.}
\item{minperm}{the lower limit to the number of possible permutations
@@ -66,7 +69,7 @@
\code{permControl}.
To permute \code{strata} rather than the observations within the
- levels of \code{strata}, use \code{type = "strata"}. However, note
+ levels of \code{strata}, use \code{permute.strata = TRUE}. However, note
that the number of observations within each level of strata
\strong{must} be equal!
@@ -143,7 +146,8 @@
ncol = 5, nrow = 5, constant = TRUE))
## permuting levels of block instead of observations
-permuted.index2(20, permControl(strata = block, type = "strata"))
+permuted.index2(20, permControl(strata = block, type = "free",
+ permute.strata = TRUE))
## Simple function using permute() to assess significance
## of a t.test
More information about the Vegan-commits
mailing list