[med-svn] [permute] 01/06: Imported Upstream version 0.8-0
Andreas Tille
tille at debian.org
Tue Jan 21 10:10:01 UTC 2014
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository permute.
commit bbc1a7e1fe079177cd94dd6b9de869cd726b1d86
Author: Andreas Tille <tille at debian.org>
Date: Tue Jan 21 11:06:13 2014 +0100
Imported Upstream version 0.8-0
---
DESCRIPTION | 35 +-
MD5 | 95 +-
NAMESPACE | 202 +++-
R/Blocks.R | 13 +-
R/Plots.R | 27 +
R/Within.R | 24 +-
R/allFree.R | 17 +-
R/allPerms.R | 268 +++--
R/allStrata.R | 27 +-
R/as.matrix.permutationMatrix.R | 10 +
R/check.R | 94 ++
R/fixupCall.R | 12 +
R/getFoo-methods.R | 426 ++++++-
R/how.R | 55 +
R/numPerms.R | 239 ++--
R/permCheck.R | 62 +-
R/permControl.R | 15 -
R/permuplot.R | 6 +-
R/permute-deprecated.R | 43 +
R/permute.R | 2 +-
R/{print.permCheck.R => print.check.R} | 0
R/print.how.R | 89 ++
R/print.permControl.R | 54 -
R/print.permutationMatrix.R | 84 ++
R/print.summary.allPerms.R | 5 +-
...t.summary.permCheck.R => print.summary.check.R} | 0
R/setFoo-methods.R | 408 +++++++
R/shuffle-utils.R | 12 +
R/shuffle.R | 20 +-
R/shuffle2.R | 122 ++
R/shuffleSet.R | 2 +-
R/shuffleSet2.R | 205 ++++
R/{summary.permCheck.R => summary.check.R} | 0
R/update.Plots.R | 62 +
R/update.how.R | 73 ++
build/vignette.rds | Bin 0 -> 230 bytes
inst/COPYRIGHTS | 16 +
inst/ChangeLog | 274 ++++-
inst/NEWS.Rd | 86 ++
inst/TODO.md | 84 ++
inst/doc/permutations.R | 348 ++++++
inst/doc/permutations.Rnw | 368 +++++-
inst/doc/permutations.pdf | Bin 122867 -> 294805 bytes
inst/tests/.Rhistory | 36 -
inst/tests/test-check.R | 25 +
inst/tests/test-shuffle.R | 15 +-
inst/tests/test-shuffleSet.R | 42 +
man/allPerms.Rd | 40 +-
man/{allUtilis.Rd => allUtils.Rd} | 5 +-
man/check.Rd | 153 +++
man/get-methods.Rd | 188 +++
man/how.Rd | 130 +++
man/numPerms.Rd | 31 +-
man/permCheck-deprecated.Rd | 66 ++
man/permCheck.Rd | 280 -----
man/permControl-deprecated.Rd | 82 ++
man/permute-deprecated.Rd | 25 +
man/set-methods.Rd | 147 +++
man/shuffle-utils.Rd | 6 +-
man/shuffle.Rd | 174 +--
man/shuffleSet.Rd | 97 +-
tests/Examples/permute-Ex.Rout.save | 1219 ++++++++++++++++++++
vignettes/Z.cls | 2 +-
vignettes/permutations.Rnw | 368 +++++-
vignettes/permute.bib | 33 +
65 files changed, 6062 insertions(+), 1086 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index ad3d686..e201012 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,21 +1,26 @@
Package: permute
Title: Functions for generating restricted permutations of data
-Version: 0.7-0
-Date: $Date: 2012-02-09 12:46:33 +0000 (Thu, 09 Feb 2012) $
-Author: Gavin L. Simpson
-Maintainer: Gavin L. Simpson <gavin.simpson at ucl.ac.uk>
-Suggests: vegan (>= 2.0-0), testthat (>= 0.5)
-Description: The 'permute' package implements a set of restricted
- permutation designsfor freely exchangeable, line transects
- (time series), and spatial grid designs plus permutation of
- blocks (groups of samples). 'permute' also allows split-plot
- designs, in which the whole-plots or split-plots or both can be
- freely-exchangeble or one of the restricted designs. The
- 'permute' package is modelled after the permutation schemes of
- Canoco 3.1 by Cajo ter Braak.
+Version: 0.8-0
+Date: $Date: 2013-11-30 14:50:04 -0600 (Sat, 30 Nov 2013) $
+Authors at R: c(person(given = "Gavin L.", family = "Simpson",
+ email = "ucfagls at gmail.com",
+ role = c("aut", "cph", "cre")),
+ person(given = "R Core Team", role = "cph"),
+ person(given = "Douglas M.", family = "Bates", role = "ctb"),
+ person(given = "Jari", family = "Oksanen", role = "ctb"))
+Depends: R (>= 2.14.0)
+Suggests: vegan (>= 2.0-0), testthat (>= 0.5), parallel
+Description: The 'permute' package implements a set of restricted permutation designs for freely exchangeable, line transects (time series), and spatial grid designs plus permutation of blocks (groups of samples). 'permute' also allows split-plot designs, in which the whole-plots or split-plots or both can be freely-exchangeable or one of the restricted designs. The 'permute' package is modelled after the permutation schemes of Canoco 3.1 (and later) by Cajo ter Braak.
License: GPL-2
ByteCompile: true
URL: http://vegan.r-forge.r-project.org/
-Packaged: 2012-04-04 20:14:25 UTC; gavin
+Copyright: see file COPYRIGHTS
+Packaged: 2013-12-01 01:35:48 UTC; gavin
+Author: Gavin L. Simpson [aut, cph, cre],
+ R Core Team [cph],
+ Douglas M. Bates [ctb],
+ Jari Oksanen [ctb]
+Maintainer: Gavin L. Simpson <ucfagls at gmail.com>
+NeedsCompilation: no
Repository: CRAN
-Date/Publication: 2012-04-05 05:38:59
+Date/Publication: 2013-12-01 08:05:32
diff --git a/MD5 b/MD5
index 79ef595..1722635 100644
--- a/MD5
+++ b/MD5
@@ -1,44 +1,69 @@
-facf8429e0bb00ce37261a27cf4cc75a *DESCRIPTION
-cab266c7a0ce2f0f2fd1a2849f9c8c82 *NAMESPACE
-6f3ef7162e8bb01155f372d2882a925d *R/Blocks.R
-a4870928908f5141f86af7ac811f2936 *R/Within.R
-bd6397e0983fc62b8b6ea5e9d1bb4649 *R/allFree.R
+d17d280d02b7b8ab6e0d36716c8b96d6 *DESCRIPTION
+df79e949fde5fcf8262c64f61a36f563 *NAMESPACE
+e868a91139fab764feebbf3590eb46e6 *R/Blocks.R
+0d94016b600ddfd39087b8d41228ddb7 *R/Plots.R
+40da812fd0c1530aa117d1677f707023 *R/Within.R
+065086f18b59986e5feb8a6598b78632 *R/allFree.R
af6ec0ff884e97781072c6db2cdeb61b *R/allGrid.R
-c6b27648b3db59400b0cdc45f26d41ae *R/allPerms.R
+78519ea751bd9a68a8f5fe183b28168b *R/allPerms.R
ed8d66f8de2f14fdee5ee0b4d7ca450e *R/allSeries.R
-231ec19c19d40742a2f862e3f262bdc3 *R/allStrata.R
-bb00328b980547e8673bf8734e0e5b82 *R/getFoo-methods.R
+bfa5e00be181d197cab7b720faf825ef *R/allStrata.R
+23435563d36be42bbd71da36581a78af *R/as.matrix.permutationMatrix.R
+0b60312db5f277cc855239bfdf7ca3e1 *R/check.R
+ab185e9fba9867b4e39969b331a7fcbc *R/fixupCall.R
+ea0fed2f27a9ad36ffc707ede2837a00 *R/getFoo-methods.R
+70987c298dc5bd539345d854cff06c71 *R/how.R
5c0164d1116a52ccac18237646906012 *R/nobs-methods.R
-f22617176425caf92242857c28f9cfbe *R/numPerms.R
-2744d39c2d33847a0983ab37fd4e3811 *R/permCheck.R
-216d3a30090219a3798ec77cf11f4653 *R/permControl.R
-20bd3870ac99afd80968a79171581436 *R/permuplot.R
-df44a3b58a993ff94f2b0826cacfab7d *R/permute.R
+1bd99a763d1860c56049b1a9dc7100d2 *R/numPerms.R
+ec731b7d6b7ff91448b57b4d82f14237 *R/permCheck.R
+2e888232c4b979f8e69de7ebd971a44f *R/permuplot.R
+49523a7b7e624d90cf2a14eb5db24697 *R/permute-deprecated.R
+1748de64355e7f946768c92431e730d1 *R/permute.R
21a2adbee470ca86648b7ac0e9fd5d51 *R/print.allPerms.R
-4b69356047dd015dd5f7f1018b76bdfb *R/print.permCheck.R
-a1a326e5df33a1ad21f4a602a59d1b99 *R/print.permControl.R
-348b6e9694e51fa5884cf3ef83d138bd *R/print.summary.allPerms.R
-eb6d20a84325371ed25f56333a1286f0 *R/print.summary.permCheck.R
-126c8b7ba3ee0d4cf0d3f8ce4c361b32 *R/shuffle-utils.R
-be73da79acc3fc326e7c01e303019b4c *R/shuffle.R
-e657e8a6caf2419cdd9ef97405f82dc4 *R/shuffleSet.R
+4b69356047dd015dd5f7f1018b76bdfb *R/print.check.R
+5c7503adad7720bf6270e9c767b3919d *R/print.how.R
+04a88532586e8f7b20dfca3697444184 *R/print.permutationMatrix.R
+ad976cbddacaaaebd1e3b5a6f4eba771 *R/print.summary.allPerms.R
+eb6d20a84325371ed25f56333a1286f0 *R/print.summary.check.R
+9e4ebf15084c8b312302e50cf75822ed *R/setFoo-methods.R
+270abfbd5c6dd686dcd7153c7b8a7233 *R/shuffle-utils.R
+5af7a108e95967ff093997c5e526f15c *R/shuffle.R
+39c8c45fd10de34925fd3ba1c72c5b3f *R/shuffle2.R
+7a40e3b032ea5b583ebe28db8f450bc1 *R/shuffleSet.R
+be4f5fe71b76835e41ef76ce3c08cb26 *R/shuffleSet2.R
6c98b1afeb08eef934cc6d25557c8812 *R/summary.allPerms.R
-1452820ef3677a4cc68fc27837f67ee3 *R/summary.permCheck.R
+1452820ef3677a4cc68fc27837f67ee3 *R/summary.check.R
+33064923b08d1e65469449f32b0f2797 *R/update.Plots.R
+3a2a885a7705cee2fd97ecc1a7238b12 *R/update.how.R
+caa68989ef55fad314f0a42b5404b8ba *build/vignette.rds
4d966dbdda958c863064462aeb589708 *data/jackal.rda
-e848d2c0bedae8f69c1f5a56ec5e3186 *inst/ChangeLog
-68d2089163c81a93115bbc8992e31236 *inst/doc/permutations.Rnw
-8768b47b587b442c9a83a52437311ea2 *inst/doc/permutations.pdf
-b87f99cdfacc9f1f1715dbbc87db157b *inst/tests/test-shuffle.R
-18ed0d9a096fe30868c57c62aa46bee1 *man/allPerms.Rd
-20283d85a6edef61c4f5d055c50e315b *man/allUtilis.Rd
+aa947360198890f9a747920d52cf52c2 *inst/COPYRIGHTS
+fd065b9d310a6fcb0eaff8a4c3616508 *inst/ChangeLog
+f18d13fa109c9f1313a2164ee057d358 *inst/NEWS.Rd
+bbb242b30032dba5f5a775dc43e91bf7 *inst/TODO.md
+37b4278adbb6c6106e2cfe5be5de0840 *inst/doc/permutations.R
+82da16c514a05f417eb5a67d36270221 *inst/doc/permutations.Rnw
+6ece0d36edc8254b7e9f42716263f7ca *inst/doc/permutations.pdf
+712bed4b9184a5857cb8633574a70a87 *inst/tests/test-check.R
+8714401ccd2ba7fff8f5d423fdb700be *inst/tests/test-shuffle.R
+d0c240b14dca251488275ea5f84e5110 *inst/tests/test-shuffleSet.R
+b18d0e616c9d323942bec8f7fbd63250 *man/allPerms.Rd
+ae17a2363ef92ad5cfb7c9704b4fc130 *man/allUtils.Rd
+9aed0a0fe3de6e2c9845a70a853e4126 *man/check.Rd
+1abaaa3ab73cf3f4e3e88eb596a7c57c *man/get-methods.Rd
+18230c2b006cbfa973f4bd825efaff4c *man/how.Rd
66c4ad89b8c8035bbc74ed3558e961bb *man/jackal.Rd
e54c2a3be916e7fa0813b0a5f93f6dc3 *man/nobs.Rd
-1907d83dc0a2e35d93f1c407eb065c0a *man/numPerms.Rd
-9b42e99d4374dc1e7a2013be1db71b9f *man/permCheck.Rd
-371384734931df5ff040aa32d5092184 *man/shuffle-utils.Rd
-fecb66eec3413646c13d87753c492aa7 *man/shuffle.Rd
-2c38f1230457b333584d85b0ef598bdc *man/shuffleSet.Rd
+3101a045f667b06e45ce829b099d0ec8 *man/numPerms.Rd
+ca27e2de82c2f1a948276aaec6f8cefc *man/permCheck-deprecated.Rd
+3447748563162573a1ef246245d07ec3 *man/permControl-deprecated.Rd
+8c276fc9781e7700ad90826883d8d56b *man/permute-deprecated.Rd
+e69cb80138b5b21371a7a3719b610949 *man/set-methods.Rd
+74e0599d75011a519bd917481f0df308 *man/shuffle-utils.Rd
+eb210047aa7f8feb8bda0d1afc191111 *man/shuffle.Rd
+f3ec8abb06c4f2ced18dfa7944db8846 *man/shuffleSet.Rd
+a605ebe1bb996bfc81e14b5b97a63d09 *tests/Examples/permute-Ex.Rout.save
8f3e383676a96e96a4f5e56e93c6e131 *tests/test-all.R
-42f8a654a53515271920f03727a8d3ab *vignettes/Z.cls
-68d2089163c81a93115bbc8992e31236 *vignettes/permutations.Rnw
-d674f05f818bc80790ef5c49c174ed71 *vignettes/permute.bib
+51dfb25079d9f14d40896092d96e277d *vignettes/Z.cls
+82da16c514a05f417eb5a67d36270221 *vignettes/permutations.Rnw
+04ffc25b51d75204407f0852dd597bf8 *vignettes/permute.bib
diff --git a/NAMESPACE b/NAMESPACE
index b4d3d91..d80b953 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,37 +1,193 @@
### Visible functions:
-export(`allPerms`, `Blocks`, `numPerms`, `check`, `permCheck`,
- `permControl`, `permute`, `shuffle`, `Within`,
- `shuffleFree`, `shuffleSeries`, `shuffleGrid`, `shuffleStrata`,
- `getBlocks`, `getWithin`, `getStrata`,
- `shuffleSet`, `permuplot`)
+export("allPerms",
+ "Blocks",
+ "check",
+ "getBlocks",
+ "getWithin",
+ "getStrata",
+ "getType",
+ "getMirror",
+ "getConstant",
+ "getPlots",
+ "getRow",
+ "getCol",
+ "getDim",
+ "getNperm",
+ "getMaxperm",
+ "getMinperm",
+ "getComplete",
+ "getMake",
+ "getObserved",
+ "getAllperms",
+ "how",
+ "numPerms",
+ "permCheck",
+ "permControl",
+ "permute",
+ "Plots",
+ "setBlocks<-",
+ "setWithin<-",
+ "setStrata<-",
+ "setType<-",
+ "setMirror<-",
+ "setConstant<-",
+ "setPlots<-",
+ "setRow<-",
+ "setCol<-",
+ "setDim<-",
+ "setNperm<-",
+ "setMaxperm<-",
+ "setMinperm<-",
+ "setComplete<-",
+ "setMake<-",
+ "setObserved<-",
+ "setAllperms<-",
+ "shuffle",
+ "shuffleFree",
+ "shuffleGrid",
+ "shuffleSeries",
+ "shuffleSet",
+ "shuffleStrata",
+ "Within"
+ )
### Imports: nobs() only exists in R 2.13.0 for import. We define the
### same nobs() generic in permute for export in older R.
if (getRversion() >= "2.13.0") {
- importFrom(`stats`, `nobs`)
+ importFrom("stats", "nobs")
} else {
export(nobs)
}
### S3 Methods
+S3method("as.matrix", "permutationMatrix")
+S3method("update", "how")
+S3method("update", "Plots")
## print methods
-S3method(`print`, `allPerms`)
-S3method(`print`, `check`)
-S3method(`print`, `permControl`)
-S3method(`print`, `summary.allPerms`)
-S3method(`print`, `summary.check`)
+S3method("print", "allPerms")
+S3method("print", "check")
+S3method("print", "how")
+S3method("print", "permControl")
+S3method("print", "permutationMatrix")
+S3method("print", "summary.allPerms")
+S3method("print", "summary.check")
## summary methods
-S3method(`summary`, `allPerms`)
-S3method(`summary`, `check`)
+S3method("summary", "allPerms")
+S3method("summary", "check")
## nobs() methods
-S3method(`nobs`, `numeric`)
-S3method(`nobs`, `integer`)
-S3method(`nobs`, `matrix`)
-S3method(`nobs`, `data.frame`)
+S3method("nobs", "numeric")
+S3method("nobs", "integer")
+S3method("nobs", "matrix")
+S3method("nobs", "data.frame")
## getFoo methods
-S3method(`getBlocks`, `default`)
-S3method(`getBlocks`, `permControl`)
-S3method(`getWithin`, `default`)
-S3method(`getWithin`, `permControl`)
-S3method(`getStrata`, `default`)
-S3method(`getStrata`, `permControl`)
+S3method("getBlocks", "default")
+S3method("getBlocks", "how")
+S3method("getBlocks", "permControl")
+S3method("getPlots", "default")
+S3method("getPlots", "how")
+S3method("getPlots", "permControl")
+S3method("getWithin", "default")
+S3method("getWithin", "how")
+S3method("getWithin", "permControl")
+S3method("getStrata", "default")
+S3method("getStrata", "how")
+S3method("getStrata", "permControl")
+S3method("getStrata", "Plots")
+S3method("getType", "default")
+S3method("getType", "how")
+S3method("getType", "permControl")
+S3method("getType", "Plots")
+S3method("getType", "Within")
+S3method("getMirror", "default")
+S3method("getMirror", "how")
+S3method("getMirror", "permControl")
+S3method("getMirror", "Plots")
+S3method("getMirror", "Within")
+S3method("getConstant", "default")
+S3method("getConstant", "how")
+S3method("getConstant", "permControl")
+S3method("getConstant", "Within")
+S3method("getNperm", "default")
+S3method("getNperm", "how")
+S3method("getNperm", "permControl")
+S3method("getMaxperm", "default")
+S3method("getMaxperm", "how")
+S3method("getMaxperm", "permControl")
+S3method("getMinperm", "default")
+S3method("getMinperm", "how")
+S3method("getMinperm", "permControl")
+S3method("getComplete", "default")
+S3method("getComplete", "how")
+S3method("getComplete", "permControl")
+S3method("getRow", "default")
+S3method("getRow", "how")
+S3method("getRow", "permControl")
+S3method("getRow", "Plots")
+S3method("getRow", "Within")
+S3method("getCol", "default")
+S3method("getCol", "how")
+S3method("getCol", "permControl")
+S3method("getCol", "Plots")
+S3method("getCol", "Within")
+S3method("getDim", "default")
+S3method("getDim", "how")
+S3method("getDim", "permControl")
+S3method("getDim", "Plots")
+S3method("getDim", "Within")
+S3method("getMake", "default")
+S3method("getMake", "how")
+S3method("getObserved", "default")
+S3method("getObserved", "how")
+S3method("getAllperms", "default")
+S3method("getAllperms", "how")
+
+## setFoo methods
+S3method("setBlocks<-", "default")
+S3method("setBlocks<-", "how")
+S3method("setBlocks<-", "permControl")
+S3method("setPlots<-", "default")
+S3method("setPlots<-", "how")
+S3method("setWithin<-", "default")
+S3method("setWithin<-", "how")
+S3method("setStrata<-", "default")
+S3method("setStrata<-", "how")
+S3method("setStrata<-", "Plots")
+S3method("setType<-", "default")
+S3method("setType<-", "how")
+S3method("setType<-", "Within")
+S3method("setType<-", "Plots")
+S3method("setMirror<-", "default")
+S3method("setMirror<-", "how")
+S3method("setMirror<-", "Within")
+S3method("setMirror<-", "Plots")
+S3method("setConstant<-", "default")
+S3method("setConstant<-", "how")
+S3method("setConstant<-", "Within")
+S3method("setConstant<-", "Plots")
+S3method("setNperm<-", "default")
+S3method("setNperm<-", "how")
+S3method("setNperm<-", "permControl")
+S3method("setMaxperm<-", "default")
+S3method("setMaxperm<-", "how")
+S3method("setMaxperm<-", "permControl")
+S3method("setMinperm<-", "default")
+S3method("setMinperm<-", "how")
+S3method("setMinperm<-", "permControl")
+S3method("setComplete<-", "default")
+S3method("setComplete<-", "how")
+S3method("setComplete<-", "permControl")
+S3method("setRow<-", "default")
+S3method("setRow<-", "how")
+S3method("setCol<-", "default")
+S3method("setCol<-", "how")
+S3method("setDim<-", "default")
+S3method("setDim<-", "how")
+S3method("setMake<-", "default")
+S3method("setMake<-", "how")
+S3method("setMake<-", "permControl")
+S3method("setObserved<-", "default")
+S3method("setObserved<-", "how")
+S3method("setObserved<-", "permControl")
+S3method("setAllperms<-", "default")
+S3method("setAllperms<-", "how")
+S3method("setAllperms<-", "permControl")
diff --git a/R/Blocks.R b/R/Blocks.R
index e66b21c..3bc442e 100644
--- a/R/Blocks.R
+++ b/R/Blocks.R
@@ -1,13 +1,6 @@
-`Blocks` <- function(type = c("free","series","grid","none"),
- mirror = FALSE, ncol = NULL, nrow = NULL)
-{
- if(missing(type))
- type <- "none"
- else
- type <- match.arg(type)
- out <- list(type = type, mirror = mirror,
- ncol = ncol, nrow = nrow)
+`Blocks` <- function(strata = NULL) {
+ out <- list(strata = strata)
## keep as list for now
##class(out) <- "Blocks"
- return(out)
+ out
}
diff --git a/R/Plots.R b/R/Plots.R
new file mode 100644
index 0000000..8a78e8c
--- /dev/null
+++ b/R/Plots.R
@@ -0,0 +1,27 @@
+`Plots` <- function(strata = NULL, type = c("none","free","series","grid"),
+ mirror = FALSE, ncol = NULL, nrow = NULL) {
+
+ plots.name <- deparse(substitute(strata))
+ ## strata should also be a factor - coerce
+ if(!is.null(strata))
+ strata <- as.factor(strata)
+
+ type <- match.arg(type)
+
+ ## process the call to make it standalone
+ .call <- match.call()
+ if (length(.call) > 1L) {
+ .ll <- as.list(.call[-1])
+ for (i in seq_along(.ll))
+ .ll[[i]] <- eval(.ll[[i]], parent.frame())
+ .ll <- c(as.list(.call[[1]]), .ll)
+ names(.ll) <- names(.call)
+ .call <- as.call(.ll)
+ }
+
+ out <- list(strata = strata, type = type, mirror = mirror,
+ ncol = ncol, nrow = nrow,
+ plots.name = plots.name, call = .call)
+ class(out) <- "Plots"
+ out
+}
diff --git a/R/Within.R b/R/Within.R
index 6576927..9d7b012 100644
--- a/R/Within.R
+++ b/R/Within.R
@@ -2,13 +2,21 @@
constant = FALSE, mirror = FALSE,
ncol = NULL, nrow = NULL)
{
- if(missing(type))
- type <- "free"
- else
- type <- match.arg(type)
+ type <- match.arg(type)
+
+ ## process the call to make it standalone
+ .call <- match.call()
+ if (length(.call) > 1L) {
+ .ll <- as.list(.call[-1])
+ for (i in seq_along(.ll))
+ .ll[[i]] <- eval(.ll[[i]], parent.frame())
+ .ll <- c(as.list(.call[[1]]), .ll)
+ names(.ll) <- names(.call)
+ .call <- as.call(.ll)
+ }
+
out <- list(type = type, constant = constant, mirror = mirror,
- ncol = ncol, nrow = nrow)
- ## keep as default list for now
- ##class(out) <- "Within"
- return(out)
+ ncol = ncol, nrow = nrow, call = .call)
+ class(out) <- "Within"
+ out
}
diff --git a/R/allFree.R b/R/allFree.R
index 3dee006..b63c7ab 100644
--- a/R/allFree.R
+++ b/R/allFree.R
@@ -1,11 +1,8 @@
-`allFree` <- function(n, v = 1:n)
-{
- if( n == 1 ) {
- matrix(v, 1, 1)
- } else {
- X <- NULL
- for(i in 1:n)
- X <- rbind(X, cbind(v[i], Recall(n-1, v[-i])))
- X
- }
+## Modified version of allFree() provided by Doug Bates
+## via personal email on 19 Jan 2012
+`allFree` <- function(n, v = seq_len(n)) {
+ if(n == 1L) return(array(v, c(1L, 1L)))
+ do.call(rbind,
+ lapply(seq_len(n),
+ function(i) cbind(v[i], allFree(n - 1L, v[-i]))))
}
diff --git a/R/allPerms.R b/R/allPerms.R
index 96bb42d..3227b54 100644
--- a/R/allPerms.R
+++ b/R/allPerms.R
@@ -1,10 +1,4 @@
-`allPerms` <- function(n, control = permControl(), max = 9999,
- observed = FALSE) {
- ## replicate a matrix by going via a list and bind together
- repMat <- function(mat, n) {
- res <- rep(list(mat), n)
- do.call(rbind, res)
- }
+`allPerms` <- function(n, control = how(), check = TRUE) {
## start
v <- n
## expand n if a numeric or integer vector of length 1
@@ -13,167 +7,245 @@
## number of observations in data
n <- nobs(v)
## check permutation scheme and update control
- pcheck <- check(v, control = control, make.all = FALSE)
- ctrl <- pcheck$control
+ make <- getMake(control)
+ if (check) {
+ control2 <- control
+ setMake(control2) <- FALSE
+ pcheck <- check(v, control = control2, quietly = TRUE)
+ }
+ ## ctrl <- pcheck$control
+ ## if we do copy the new updated control, we need to update to
+ ## reset make
+ ## ctrl <- update(ctrl, make = make)
+
## get max number of permutations
- nperms <- pcheck$n
+ nperms <- numPerms(v, control = control)
+
## sanity check - don't let this run away to infinity
## esp with type = "free"
- if(nperms > max)
- stop("Number of possible permutations too large (> 'max')")
- WI <- getWithin(ctrl)
- STRATA <- getStrata(ctrl)
- type.wi <- WI$type
- if(type.wi != "none") {
- if(is.null(STRATA)) {
- res <- switch(type.wi,
+ if(nperms > getMaxperm(control))
+ stop("Number of possible permutations too large (> 'maxperm')")
+
+ WI <- getWithin(control)
+ strataP <- getStrata(control, which = "plots")
+ typeW <- getType(control, which = "within")
+ typeP <- getType(control, which = "plot")
+ BLOCKS <- getBlocks(control)
+ dimW <- getDim(control, which = "within")
+ dimP <- getDim(control, which = "plots")
+ mirrorW <- getMirror(control, which = "within")
+ mirrorP <- getMirror(control, which = "plots")
+ constantW <- getConstant(control)
+
+ ## give a BLOCKS if non supplied - i.e. one block
+ if(is.null(BLOCKS))
+ BLOCKS <- factor(rep(1, n))
+
+ ## split v by blocks
+ spl <- split(seq_len(n), BLOCKS)
+ nb <- length(spl) # number of blocks
+
+ ## result object
+ out <- vector(mode = "list", length = nb)
+
+ ## null-out Blocks in control
+ control2 <- control
+ setBlocks(control2) <- NULL
+
+ ## loop over blocks and return allPerms on each block
+ for (i in seq_along(spl)) {
+ out[[i]] <-
+ doAllPerms(spl[[i]], strataP, typeW, typeP, mirrorW,
+ mirrorP, constantW, dimW, dimP, control2,
+ nperms = nperms)
+ }
+
+ ## bind all the blocks together
+ out <- do.call(cbind, out) ## hmm are any of these the same shape?
+ out[, unlist(spl)] <- out
+
+ if(!(observed <- getObserved(control))) {
+ obs.v <- seq_len(n)
+ obs.row <- apply(out, 1, function(x, obs.v) all(x == obs.v), obs.v)
+ out <- out[!obs.row, ]
+ ## reduce the number of permutations to get rid of the
+ ## observed ordering
+ setNperm(control) <- getNperm(control) - 1
+ }
+ class(out) <- "allPerms"
+ attr(out, "control") <- control
+ attr(out, "observed") <- observed
+ out
+}
+
+
+`doAllPerms` <- function(obs, strataP, typeW, typeP, mirrorW, mirrorP,
+ constantW, dimW, dimP, control, nperms) {
+ ## replicate a matrix by going via a list and bind together
+ repMat <- function(mat, n) {
+ res <- rep(list(mat), n)
+ do.call(rbind, res)
+ }
+
+ n <- length(obs)
+
+ ## subset strataP to take only the obs indices and drop the unused
+ ## levels
+ if (!is.null(strataP)) {
+ strataP <- droplevels(strataP[obs])
+ }
+
+ ## also need to update the $strata component of control
+ ## FIXME: this really should have a toplevel function to set/update
+ ## sub-components of control
+ control$plots$strata <- strataP
+
+ ## permuting within?
+ if (typeW != "none") {
+ if(is.null(strataP)) {
+ ## no plot-level permutations
+ res <- switch(typeW,
free = allFree(n),
- series = allSeries(n, nperms, WI$mirror),
- grid = allGrid(n, nperms, WI$nrow,
- WI$ncol, WI$mirror, WI$constant))
+ series = allSeries(n, nperms, mirrorW),
+ grid = allGrid(n, nperms, dimW[1],
+ dimW[2], mirrorW, constantW))
} else {
- ## permuting within blocks
- tab <- table(STRATA)
- if(WI$constant) {
- ## same permutation in each block
- pg <- unique(tab)
- ctrl.wi <- permControl(strata = NULL, within = WI)
- nperms <- numPerms(pg, ctrl.wi)
- ord <- switch(type.wi,
+ ## permuting within plots
+ tab <- table(strataP)
+ pg <- unique(tab)
+ if(constantW) {
+ ## same permutation in each plot
+ ##pg <- unique(tab)
+ controlW <- how(within = getWithin(control))
+ nperms <- numPerms(pg, controlW)
+ ord <- switch(typeW,
free = allFree(pg),
- 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, STRATA)
+ series = allSeries(pg, nperms, mirrorW),
+ grid = allGrid(pg, nperms, dimW[1],
+ dimW[2], mirrorW, constantW))
+ permW <- nrow(ord)
+ sp <- split(obs, strataP)
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,]])
+ for(i in seq_len(permW)) {
+ res[i,] <- sapply(sp,
+ function(x, ord) x[ord[i,]], ord = ord)
+ }
} else {
- ## different permutations within blocks
- tab <- table(STRATA)
+ ## different permutations within plots
+ nperms <- numPerms(sum(tab), control)
+
ng <- length(tab)
- pg <- unique(tab)
+ ##pg <- unique(tab)
if(length(pg) > 1) {
## different number of observations per level of strata
- if(type.wi == "grid")
+ if(typeW == "grid")
## FIXME: this should not be needed once all checks are
## in place in check()
stop("Unbalanced grid designs are not supported")
- ctrl.wi <- permControl(strata = NULL, within = WI)
- sp <- split(v, STRATA)
+ controlW <- how(within = getWithin(control))
+ sp <- split(obs, strataP)
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,
+ np <- numPerms(tab[j], controlW)
+ ord <- switch(typeW,
free = allFree(tab[j]),
- series = allSeries(tab[j], np, WI$mirror))
- perm.wi <- nrow(ord)
+ series = allSeries(tab[j], np, mirrorW))
+ permW <- nrow(ord)
if(j == 1) {
a <- 1
- b <- np / perm.wi
+ b <- nperms / np
} else {
- b <- b/perm.wi
- a <- np / (b*perm.wi)
+ b <- b / np
+ a <- nperms / (b * np)
}
res[[j]] <- matrix(rep(repMat(ord+add[j], a),
each = b),
ncol = tab[j])
}
res <- do.call(cbind, res)
- sp <- split(v, STRATA)
+ sp <- split(obs, strataP)
res <- t(apply(res, 1,
- function(x, inds, v) {v[inds] <- inds[x]; v},
- unlist(sp), v))
+ function(x, inds, o) {o[inds] <- inds[x]; o},
+ unlist(sp), obs))
} else {
## same number of observations per level of strata
- ctrl.wi <- permControl(strata = NULL, within = WI)
- np <- numPerms(pg, ctrl.wi)
+ controlW <- how(within = getWithin(control))
+ np <- numPerms(pg, controlW)
ord <-
- switch(type.wi,
+ switch(typeW,
free = allFree(pg),
- series = allSeries(pg, np, WI$mirror),
- grid = allGrid(pg, np, WI$nrow,
- WI$ncol, WI$mirror,
- WI$constant))
- perm.wi <- nrow(ord)
+ series = allSeries(pg, np, mirrorW),
+ grid = allGrid(pg, np, dimW[1],
+ dimW[2], mirrorW, constantW))
+ permW <- nrow(ord)
add <- seq(from = 0, by = pg, length.out = ng)
res <- vector(mode = "list", length = ng)
a <- 1
- b <- np / perm.wi
+ b <- np / permW
for(i in seq_len(ng)) {
res[[i]] <- matrix(rep(repMat(ord+add[i], a),
each = b),
ncol = pg)
- a <- a*perm.wi
- b <- b/perm.wi
+ a <- a*permW
+ b <- b/permW
}
res <- do.call(cbind, res)
- sp <- split(v, STRATA)
+ sp <- split(obs, strataP)
res <- t(apply(res, 1,
- function(x, inds, v) {v[inds] <- inds[x]; v},
- unlist(sp), v))
+ function(x, inds, o) {o[inds] <- inds[x]; o},
+ unlist(sp), obs))
}
}
}
}
- ## Do we need to permute blocks?
- if ((type.b <- control$blocks$type) != "none") {
- ## permuting blocks ONLY
- if(type.wi == "none") {
+ ## Do we need to permute plots?
+ if (!is.null(strataP) && !isTRUE(all.equal(typeP, "none"))) {
+ ## permuting plots ONLY
+ if(typeW == "none") {
res <- allStrata(n, control = control)
} else {
+ ## FIXME - this need updating to work with the new code
## permuting blocks AND within blocks
- ## need a local CTRL that just permutes blocks
- ctrl.b <- permControl(strata = STRATA,
- within = Within(type = "none"),
- blocks = getBlocks(ctrl))
+ ## need a local CONTROL that just permutes blocks
+ controlP <- how(plots = Plots(strata = strataP, type = typeP),
+ within = Within(type = "none"))
+ ## FIXME - the above should really only need to update
+ ## within as shown, not fiddle with Plots
+
## number of permutations for just the block level
- perm.b <- numPerms(n, control = ctrl.b)
+ permP <- numPerms(n, control = controlP)
## get all permutations for the block level
- shuff.b <- allStrata(n, control = ctrl.b)
+ shuffP <- allStrata(n, control = controlP)
## copy the set of permutations for within blocks
- ## perm.b times - results is a list
- res.b <- rep(list(res), perm.b)
- res.b <- lapply(seq_along(res.b),
+ ## permP times - results is a list
+ resP <- rep(list(res), permP)
+ resP <- lapply(seq_along(resP),
function(i, wi, bl) {
t(apply(wi[[i]], 1,
function(x, bl, i) {
x[bl[i,]]
}, bl = bl, i = i))
},
- wi = res.b, bl = shuff.b)
- res <- do.call(rbind, res.b)
+ wi = resP, bl = shuffP)
+ res <- do.call(rbind, resP)
}
}
## some times storage.mode of res is numeric, sometimes
## it is integer, set to "integer" for comparisons using
## identical to match the observed ordering
storage.mode(res) <- "integer"
- if(!observed) {
- obs.v <- seq_len(n)
- ##obs.row <- apply(res, 1, function(x, v) {identical(x, v)}, obs.v)
- obs.row <- apply(res, 1, function(x, obs.v) all(x == obs.v), obs.v)
- res <- res[!obs.row, ]
- ## reduce the number of permutations to get rid of the
- ## observed ordering
- control$nperm <- control$nperm - 1
- }
- class(res) <- "allPerms"
- ##attr(res, "control") <- control
- attr(res, "observed") <- observed
- return(res)
+
+ ## return
+ res
}
## enumerate all possible permutations for a more complicated
## design
## fac <- gl(2,6)
-##ctrl <- permControl(type = "grid", mirror = FALSE, strata = fac,
+##ctrl <- how(type = "grid", mirror = FALSE, strata = fac,
## constant = TRUE, nrow = 3, ncol = 2)
-## ctrl <- permControl(strata = fac,
+## ctrl <- how(strata = fac,
## within = Within(type = "grid", mirror = FALSE,
## constant = TRUE, nrow = 3, ncol = 2),
## blocks = Blocks(type = "free"))
diff --git a/R/allStrata.R b/R/allStrata.R
index 3306dda..89fd89a 100644
--- a/R/allStrata.R
+++ b/R/allStrata.R
@@ -3,23 +3,26 @@
## seq vector of observation indices
v <- seq_len(n)
## number of groups
- lev <- length(levels(control$strata))
- ## compute nperms on number of levels
- nperms <- numPerms(lev, control)
+ strata <- getStrata(control, which = "plots")
+ lev <- length(levels(strata))
+ ## compute nperms on number of levels - for this need Within()
+ ## and type == typeP
+ type <- getType(control, which = "plots")
+ newControl <- how(within = Within(type = type))
+ nperms <- numPerms(lev, newControl)
## result object
- X <- matrix(nrow = nperms, ncol = length(control$strata))
+ X <- matrix(nrow = nperms, ncol = length(strata))
## store the type
- type <- control$blocks$type
+ type <- getType(control, which = "plots")
+ mirror <- getMirror(control, which = "plots")
perms <- if(type == "free") {
allFree(lev)
} else if(type == "series") {
- mirror <- control$blocks$mirror
allSeries(lev, nperms = nperms, mirror = mirror)
} else if(type == "grid") {
- nr <- control$blocks$nrow
- nc <- control$blocks$ncol
- mirror <- control$blocks$mirror
- constant <- control$blocks$constant
+ nr <- getRow(control, which = "plots")
+ nc <- getCol(control, which = "plots")
+ constant <- getConstant(control)
allGrid(lev, nperms = nperms, nr = nr, nc = nc,
mirror = mirror, constant = constant)
} else {
@@ -28,10 +31,10 @@
## is possible given calling function...
return(v)
}
- sp <- split(v, control$strata)
+ sp <- split(v, strata)
## build permutations by concatenating components of sp
## for each row of level permutations
for(i in seq_len(nrow(perms)))
X[i,] <- unname(do.call(c, sp[perms[i,]]))
- return(X)
+ X
}
diff --git a/R/as.matrix.permutationMatrix.R b/R/as.matrix.permutationMatrix.R
new file mode 100644
index 0000000..420902d
--- /dev/null
+++ b/R/as.matrix.permutationMatrix.R
@@ -0,0 +1,10 @@
+## as.matrix.permutationMatrix - an S3 method to convert to the S3
+## matrix class. Essentially this just strips attributes and updates
+## the class to only "matrix"
+
+`as.matrix.permutationMatrix` <- function(x, ...) {
+ attr(x, "seed") <- NULL
+ attr(x, "control") <- NULL
+ class(x) <- "matrix"
+ x
+}
diff --git a/R/check.R b/R/check.R
new file mode 100644
index 0000000..41c28a5
--- /dev/null
+++ b/R/check.R
@@ -0,0 +1,94 @@
+`check` <- function(object, control = how(), quietly = FALSE)
+{
+ ## if object is numeric or integer and of length 1,
+ ## extend the object
+ if(length(object) == 1 &&
+ (is.integer(object) || is.numeric(object)))
+ object <- seq_len(object)
+
+ ## check the number of observations in object
+ N <- nobs(object)
+
+ ## sample permutation type
+ typeW <- getType(control, which = "within")
+ typeP <- getType(control, which = "plots")
+
+ ## strata at plot & block levels
+ plots <- getStrata(control, which = "plots")
+ blocks <- getStrata(control, which = "blocks")
+
+ ## if strata, check N == length of strata but beware empty levels
+ if(!is.null(plots)) {
+ tab <- table(plots)
+ if(!identical(as.integer(N), as.integer(sum(tab))))
+ stop("Number of observations and length of Plot 'strata' do not match.")
+
+ ## if "grid", check design balanced?
+ if((bal <- length(unique(tab))) > 1 && typeW == "grid")
+ stop("Unbalanced 'grid' designs are not supported.")
+
+ ## if grid design, check nrow*ncol is multiple of N
+ if(typeW == "grid" &&
+ !identical(N %% prod(getDim(control, which = "within")), 0))
+ stop("Within 'nrow' * 'ncol' not a multiple of number of observations.")
+
+ ## if constant, check design balanced?
+ if(getConstant(control) && bal > 1)
+ stop("Unbalanced designs not allowed with 'constant = TRUE'.")
+
+ ## if permuting strata, must be balanced
+ if(typeP != "none" && bal > 1)
+ stop("Design must be balanced if permuting 'strata'.")
+
+ ## if permuting Plots as a grid check dimensions match levels of
+ ## Plot-level strata
+ if(isTRUE(all.equal(typeP, "grid"))) {
+ levP <- levels(Plots)
+ dimP <- getDim(control, which = "plots")
+ if(!identical(levP, prod(dimP))) {
+ stop("Plot 'nrow' * 'ncol' not a multiple of number of Plots.")
+ }
+ }
+ }
+
+ ## check length of Blocks is equal to N
+ if(!is.null(blocks)) {
+ if(!isTRUE(all.equal(length(blocks), N)))
+ stop("Number of observations and length of Block 'strata' do not match.")
+ }
+
+ ## check allPerms is of correct form
+ if(!is.null(control$all.perms) &&
+ !inherits(control$all.perms, "allPerms"))
+ stop("'control$all.perms' must be of class 'allPerms'.")
+
+ ## get number of possible permutations
+ num.pos <- numPerms(object, control)
+
+ ## check if number requested permutations exceeds max possible
+ if(getNperm(control) > num.pos) {
+ setComplete(control) <- TRUE
+ setNperm(control) <- num.pos
+ setMaxperm(control) <- num.pos
+ if(!quietly)
+ message("'nperm' > set of all permutations; Resetting 'nperm'.")
+ }
+
+ ## if number of possible perms < minperm turn on complete enumeration
+ if((num.pos < getMinperm(control))) {
+ setComplete(control) <- TRUE
+ setNperm(control) <- num.pos
+ setMaxperm(control) <- num.pos
+ if(!quietly)
+ message("Set of permutations < 'minperm'. Generating entire set.")
+ }
+
+ ## if complete enumeration, generate all permutations
+ if(getComplete(control) && getMake(control)) {
+ ap <- allPerms(N, control = control, check = FALSE)
+ setAllperms(control) <- ap
+ }
+ retval <- list(n = num.pos, control = control)
+ class(retval) <- "check"
+ retval
+}
diff --git a/R/fixupCall.R b/R/fixupCall.R
new file mode 100644
index 0000000..f3a9752
--- /dev/null
+++ b/R/fixupCall.R
@@ -0,0 +1,12 @@
+## Non-exported function that can be used to fix up elements of a call
+`fixupCall` <- function(object, element, value) {
+ ## element must be character! Try to coerce
+ element <- as.character(element) ## Fails if not coercible
+ .call <- getElement(object, "call") ## get call from object
+ .ll <- as.list(.call) ## convert to a list to manipulate
+ names(.ll) <- names(.call) ## set names on the list
+ .ll[[element]] <- value ## set element to value
+ .call <- as.call(.ll) ## convert back to a call
+ object$call <- .call ## push back into object
+ object
+}
diff --git a/R/getFoo-methods.R b/R/getFoo-methods.R
index 1fb36f1..c1e7296 100644
--- a/R/getFoo-methods.R
+++ b/R/getFoo-methods.R
@@ -1,39 +1,443 @@
-## Extractor functions for blocks and within
-getBlocks <- function(object, ...) {
+## Extractor functions for blocks, plots and within, plus strata,
+## etc ...
+
+## Blocks
+`getBlocks` <- function(object, ...) {
UseMethod("getBlocks")
}
-getBlocks.default <- function(object, ...) {
+`getBlocks.default` <- function(object, ...) {
stop("No default method for 'getBlocks()'")
}
-getBlocks.permControl <- function(object, ...) {
+`getBlocks.permControl` <- function(object, ...) {
object$blocks
}
-getWithin <- function(object, ...) {
+`getBlocks.how` <- function(object, ...) {
+ object$blocks
+}
+
+## Plots
+`getPlots` <- function(object, ...) {
+ UseMethod("getPlots")
+}
+
+`getPlots.default` <- function(object, ...) {
+ stop("No default method for 'getPlots()'")
+}
+
+`getPlots.permControl` <- function(object, ...) {
+ object$plots
+}
+
+`getPlots.how` <- function(object, ...) {
+ object$plots
+}
+
+## Within plots
+`getWithin` <- function(object, ...) {
UseMethod("getWithin")
}
-getWithin.default <- function(object, ...) {
+`getWithin.default` <- function(object, ...) {
stop("No default method for 'getWithin()'")
}
-getWithin.permControl <- function(object, ...) {
+`getWithin.permControl` <- function(object, ...) {
object$within
}
-getStrata <- function(object, ...) {
+`getWithin.how` <- function(object, ...) {
+ object$within
+}
+
+## Strata
+`getStrata` <- function(object, ...) {
UseMethod("getStrata")
}
-getStrata.default <- function(object, ...) {
+`getStrata.default` <- function(object, ...) {
stop("No default method for 'getStrata()'")
}
-getStrata.permControl <- function(object, ...) {
- object$strata
+`getStrata.permControl` <- function(object,
+ which = c("plots", "blocks"),
+ drop = TRUE, ...) {
+ which <- match.arg(which)
+ if(isTRUE(all.equal(which, "plots")))
+ strata <- object$plots$strata
+ else if(isTRUE(all.equal(which, "blocks")))
+ strata <- object$blocks
+ stop("Ambiguous `which`")
+ if(isTRUE(drop) && !is.null(strata))
+ strata <- droplevels(strata)
+ strata
+}
+
+`getStrata.how` <- function(object,
+ which = c("plots","blocks"),
+ drop = TRUE, ...) {
+ which <- match.arg(which)
+ if(isTRUE(all.equal(which, "plots")))
+ strata <- object$plots$strata
+ else if(isTRUE(all.equal(which, "blocks")))
+ strata <- object$blocks #object$blocks$strata
+ else
+ stop("Ambiguous `which`")
+ if(isTRUE(drop) && !is.null(strata))
+ strata <- droplevels(strata)
+ strata
+}
+
+`getStrata.Plots` <- function(object, drop = TRUE, ... ) {
+ strata <- object$strata
+ if(isTRUE(drop) && !is.null(strata))
+ strata <- droplevels(strata)
+ strata
+}
+
+## Get type of permutation
+`getType` <- function(object, ...) {
+ UseMethod("getType")
+}
+
+`getType.default` <- function(object, ...) {
+ stop("No default method for 'getType()'")
+}
+
+`getType.permControl` <- function(object,
+ which = c("plots","within"), ...) {
+ which <- match.arg(which)
+ if(isTRUE(all.equal(which, "plots")))
+ type <- getPlots(object)$type
+ else if(isTRUE(all.equal(which, "within")))
+ type <- getWithin(object)$type
+ else
+ stop("Ambiguous `which`")
+ type
+}
+
+`getType.how` <- function(object,
+ which = c("plots","within"), ...) {
+ which <- match.arg(which)
+ if(isTRUE(all.equal(which, "plots")))
+ type <- getPlots(object)$type
+ else if(isTRUE(all.equal(which, "within")))
+ type <- getWithin(object)$type
+ else
+ stop("Ambiguous `which`")
+ type
+}
+
+`getType.Within` <- function(object, ...) {
+ object$within$type
+}
+
+`getType.Plots` <- function(object, ...) {
+ object$plots$type
}
## suppose we can also have setBlocks() etc...
## to update the control object in place....
+
+## Get mirroring status
+`getMirror` <- function(object, ...) {
+ UseMethod("getMirror")
+}
+
+`getMirror.default` <- function(object, ...) {
+ stop("No default method for 'getMirror()'")
+}
+
+`getMirror.permControl` <- function(object,
+ which = c("plots","within"), ...) {
+ which <- match.arg(which)
+ if(isTRUE(all.equal(which, "plots")))
+ mirror <- getPlots(object)$mirror
+ else if(isTRUE(all.equal(which, "within")))
+ mirror <- getWithin(object)$mirror
+ else
+ stop("Ambiguous `which`")
+ mirror
+}
+
+`getMirror.how` <- function(object,
+ which = c("plots","within"), ...) {
+ which <- match.arg(which)
+ if(isTRUE(all.equal(which, "plots")))
+ mirror <- getPlots(object)$mirror
+ else if(isTRUE(all.equal(which, "within")))
+ mirror <- getWithin(object)$mirror
+ else
+ stop("Ambiguous `which`")
+ mirror
+}
+
+`getMirror.Within` <- function(object, ...) {
+ object$within$mirror
+}
+
+`getMirror.Plots` <- function(object, ...) {
+ object$plots$mirror
+}
+
+## Get constant status - i.e. same permutation in each Plot
+`getConstant` <- function(object, ...) {
+ UseMethod("getConstant")
+}
+
+`getConstant.default` <- function(object, ...) {
+ stop("No default method for 'getConstant()'")
+}
+
+`getConstant.permControl` <- function(object, ...) {
+ getWithin(object)$constant
+}
+
+`getConstant.how` <- function(object, ...) {
+ getWithin(object)$constant
+}
+
+`getConstant.Within` <- function(object, ...) {
+ object$within$constant
+}
+
+## Get the number of rows and colums from grid designs
+`getRow` <- function(object, ...) {
+ UseMethod("getRow")
+}
+
+`getRow.default` <- function(object, ...) {
+ NROW(object)
+}
+
+`getRow.permControl` <- function(object, which = c("plots","within"),
+ ...) {
+ which <- match.arg(which)
+ if(isTRUE(all.equal(which, "plots")))
+ nrow <- getPlots(object)$nrow
+ else if(isTRUE(all.equal(which, "within")))
+ nrow <- getWithin(object)$nrow
+ else
+ stop("Ambiguous `which`")
+ nrow
+}
+
+`getRow.how` <- function(object, which = c("plots","within"),
+ ...) {
+ which <- match.arg(which)
+ if(isTRUE(all.equal(which, "plots")))
+ nrow <- getPlots(object)$nrow
+ else if(isTRUE(all.equal(which, "within")))
+ nrow <- getWithin(object)$nrow
+ else
+ stop("Ambiguous `which`")
+ nrow
+}
+
+`getRow.Within` <- function(object, ...) {
+ object$within$nrow
+}
+
+`getRow.Plots` <- function(object, ...) {
+ object$plots$nrow
+}
+
+`getCol` <- function(object, ...) {
+ UseMethod("getCol")
+}
+
+`getCol.default` <- function(object, ...) {
+ NCOL(object)
+}
+
+`getCol.permControl` <- function(object, which = c("plots","within"),
+ ...) {
+ which <- match.arg(which)
+ if(isTRUE(all.equal(which, "plots")))
+ ncol <- getPlots(object)$ncol
+ else if(isTRUE(all.equal(which, "within")))
+ ncol <- getWithin(object)$ncol
+ else
+ stop("Ambiguous `which`")
+ ncol
+}
+
+`getCol.how` <- function(object, which = c("plots","within"),
+ ...) {
+ which <- match.arg(which)
+ if(isTRUE(all.equal(which, "plots")))
+ ncol <- getPlots(object)$ncol
+ else if(isTRUE(all.equal(which, "within")))
+ ncol <- getWithin(object)$ncol
+ else
+ stop("Ambiguous `which`")
+ ncol
+}
+
+`getCol.Within` <- function(object, ...) {
+ object$within$ncol
+}
+
+`getCol.Plots` <- function(object, ...) {
+ object$plots$ncol
+}
+
+`getDim` <- function(object, ...) {
+ UseMethod("getDim")
+}
+
+`getDim.default` <- function(object, ...) {
+ dim(object)
+}
+
+`getDim.permControl` <- function(object, which = c("plots","within"),
+ ...) {
+ which <- match.arg(which)
+ if(isTRUE(all.equal(which, "plots"))) {
+ PL <- getPlots(object)
+ nc <- PL$ncol
+ nr <- PL$nrow
+ } else if(isTRUE(all.equal(which, "within"))) {
+ WI <- getWithin(object)
+ nc <- WI$ncol
+ nr <- WI$nrow
+ } else {
+ stop("Ambiguous `which`")
+ }
+ c(nr, nc)
+}
+
+`getDim.how` <- function(object, which = c("plots","within"),
+ ...) {
+ which <- match.arg(which)
+ if(isTRUE(all.equal(which, "plots"))) {
+ PL <- getPlots(object)
+ nc <- PL$ncol
+ nr <- PL$nrow
+ } else if(isTRUE(all.equal(which, "within"))) {
+ WI <- getWithin(object)
+ nc <- WI$ncol
+ nr <- WI$nrow
+ } else {
+ stop("Ambiguous `which`")
+ }
+ c(nr, nc)
+}
+
+`getDim.Within` <- function(object, ...) {
+ c(object$nrow, object$ncol)
+}
+
+`getDim.Plots` <- function(object, ...) {
+ c(object$nrow, object$ncol)
+}
+
+## return the requested number of permutations
+`getNperm` <- function(object, ...) {
+ UseMethod("getNperm")
+}
+
+`getNperm.default` <- function(object, ...) {
+ stop("No default method for `getNperm`")
+}
+
+`getNperm.permControl` <- function(object, ...) {
+ object$nperm
+}
+
+`getNperm.how` <- function(object, ...) {
+ object$nperm
+}
+
+## Returns maximum permutation threshold
+`getMaxperm` <- function(object, ...) {
+ UseMethod("getMaxperm")
+}
+
+`getMaxperm.default` <- function(object, ...) {
+ stop("No default method for `getMaxperm`")
+}
+
+`getMaxperm.permControl` <- function(object, ...) {
+ object$maxperm
+}
+
+`getMaxperm.how` <- function(object, ...) {
+ object$maxperm
+}
+
+## Returns minimum permutation threshold
+`getMinperm` <- function(object, ...) {
+ UseMethod("getMinperm")
+}
+
+`getMinperm.default` <- function(object, ...) {
+ stop("No default method for `getMinperm`")
+}
+
+`getMinperm.permControl` <- function(object, ...) {
+ object$minperm
+}
+
+`getMinperm.how` <- function(object, ...) {
+ object$minperm
+}
+
+## Returns status of complete enumeration
+`getComplete` <- function(object, ...) {
+ UseMethod("getComplete")
+}
+
+`getComplete.default` <- function(object, ...) {
+ stop("No default method for `getComplete`")
+}
+
+`getComplete.permControl` <- function(object, ...) {
+ object$complete
+}
+
+`getComplete.how` <- function(object, ...) {
+ object$complete
+}
+
+## Returns whether all permutation should/should not be made
+`getMake` <- function(object, ...) {
+ UseMethod("getMake")
+}
+
+`getMake.default` <- function(object, ...) {
+ stop("No default method for `getMake`")
+}
+
+`getMake.how` <- function(object, ...) {
+ object$make
+}
+
+## Returns whether the observed permutation should be in
+## the set of permutations
+`getObserved` <- function(object, ...) {
+ UseMethod("getObserved")
+}
+
+`getObserved.default` <- function(object, ...) {
+ stop("No default method for `getObserved`")
+}
+
+`getObserved.how` <- function(object, ...) {
+ object$observed
+}
+
+## Extractor for all.perms component
+`getAllperms` <- function(object, ...) {
+ UseMethod("getAllperms")
+}
+
+`getAllperms.how` <- function(object, ...) {
+ object$all.perms
+}
+
+`getAllperms.default` <- function(object, ...) {
+ stop("No default method for `getAllperms`")
+}
diff --git a/R/how.R b/R/how.R
new file mode 100644
index 0000000..1e9f299
--- /dev/null
+++ b/R/how.R
@@ -0,0 +1,55 @@
+`how` <- function(within = Within(),
+ plots = Plots(),
+ blocks = NULL,
+ nperm = 199,
+ complete = FALSE,
+ maxperm = 9999,
+ minperm = 99,
+ all.perms = NULL,
+ make = TRUE,
+ observed = FALSE) {
+
+ blocks.name <- deparse(substitute(blocks))
+ ## blocks should also be a factor - coerce
+ if(!is.null(blocks))
+ blocks <- as.factor(blocks)
+
+ ## process the call to make it standalone
+ .call <- match.call()
+ if (length(.call) > 1L) {
+ .ll <- as.list(.call[-1])
+ args <- names(.call)[-1]
+ ## evaluate arguments other than within and plots
+ ## those handled in their respective functions
+ for (i in args[!args %in% c("within","plots")]) {
+ .ll[[i]] <- eval(.ll[[i]], parent.frame())
+ }
+ }
+
+ out <- list(within = within, plots = plots, blocks = blocks,
+ nperm = nperm, complete = complete,
+ maxperm = maxperm, minperm = minperm,
+ all.perms = all.perms, make = make,
+ observed = observed,
+ blocks.name = blocks.name)
+
+ ## process within and plots separately
+ if (length(.call) > 1L && "within" %in% args) {
+ .ll[["within"]] <- getCall(within)
+ }
+ if (length(.call) > 1L && "plots" %in% args) {
+ .ll[["plots"]] <- getCall(plots)
+ }
+
+ ## finsh off
+ if (length(.call) > 1L) {
+ .ll <- c(as.list(.call[[1]]), .ll)
+ names(.ll) <- names(.call)
+ .call <- as.call(.ll)
+ }
+
+ out$call <- .call
+
+ class(out) <- "how"
+ out
+}
diff --git a/R/numPerms.R b/R/numPerms.R
index 668d132..58e9a11 100644
--- a/R/numPerms.R
+++ b/R/numPerms.R
@@ -1,108 +1,175 @@
-`numPerms` <- function(object, control = permControl())
-{
- ## constant holding types where something is permuted
- PTYPES <- c("free","grid","series","none")
- ## expand object if a numeric or integer vector of length 1
- if((is.numeric(object) || is.integer(object)) &&
- (length(object) == 1))
- object <- seq_len(object)
- ## number of observations in data
- nobs <- nobs(object)
- ## within perms object
- WITHIN <- control$within
- ## strata perms object
- BLOCKS <- control$blocks
- ## are strata present?
- STRATA <- !is.null(control$strata)
- ## check that when permuting strata or constant within strata,
- ## strata have same number of samples
- if(STRATA) {
- tab.strata <- table(control$strata)
- same.n <- length(unique(tab.strata))
- if((BLOCKS$type %in% PTYPES || isTRUE(WITHIN$constant)) &&
- same.n > 1)
- stop("All levels of strata must have same number of samples for chosen scheme")
- if(BLOCKS$type == "grid" && same.n > 1)
- stop("Unbalanced grid designs are not supported")
+`numPerms` <- function(object, control = how()) {
+ ## constant holding types where something is permuted
+ TYPES <- c("free","grid","series","none")
+
+ ## expand object if a numeric or integer vector of length 1
+ if((is.numeric(object) || is.integer(object)) &&
+ (length(object) == 1))
+ object <- seq_len(object)
+ ## number of observations in data
+ n <- nobs(object)
+
+ ## get the permutation levels from control
+ WI <- getWithin(control)
+ PL <- getPlots(control)
+ BL <- getBlocks(control)
+
+ ## any strata to permute within / blocking?
+ BLOCKS <- getStrata(control, which = "blocks")
+ PSTRATA <- getStrata(control, which = "plots")
+ typeP <- getType(control, which = "plots")
+ typeW <- getType(control, which = "within")
+
+ ## mirroring?
+ mirrorP <- getMirror(control, which = "plots")
+ mirrorW <- getMirror(control, which = "within")
+
+ ## constant - i.e. same perm within each plot?
+ constantW <- getConstant(control)
+
+ ## grid dimensions
+ colW <- getCol(control, which = "within")
+ colP <- getRow(control, which = "plots")
+
+ ## Some checks; i) Plot strata must be of same size when permuting strata
+ ## or having the same constant permutation within strata
+ ## ii) In grid designs, grids must be of the same size for all
+ ## strata
+ ##
+ ## FIXME - this probably should be in check()!
+ if(!is.null(PSTRATA)) {
+ tab <- table(PSTRATA)
+ same.n <- length(unique(tab))
+ if((typeP != "none" || isTRUE(constantW)) && same.n > 1) {
+ stop("All levels of strata must have same number of samples for chosen scheme")
}
- ## generate multiplier for restricted permutations
- if(WITHIN$type %in% c("series","grid")) {
- within.multi <- 2
- if(WITHIN$type == "grid" && WITHIN$ncol > 2) {
- within.multi <- 4
- } else {
- if(nobs == 2)
- within.multi <- 1
- }
+ if(typeP == "grid" && same.n > 1) {
+ stop("Unbalanced grid designs are not supported")
}
- if(BLOCKS$type %in% c("series","grid")) {
- blocks.multi <- 2
- if(BLOCKS$type == "grid" && BLOCKS$ncol > 2) {
- blocks.multi <- 4
- } else {
- if(nobs == 2)
- blocks.multi <- 1
- }
+ }
+
+ ## the various designs allowed imply multipliers to number of samples
+ ## for the restricted permutations
+
+ mult.p <- mult.wi <- 1
+
+ ## within types
+ if(typeW %in% c("series","grid")) {
+ mult.wi <- 2
+ if(isTRUE(all.equal(typeW, "grid")) && !is.null(colW) && colW > 2) {
+ mult.wi <- 4
+ } else {
+ if(isTRUE(all.equal(n, 2)))
+ mult.wi <- 1
}
- ## calculate number of possible permutations
- ## blocks
- num.blocks <- 1
- if(BLOCKS$type %in% PTYPES) {
- num.blocks <- if(BLOCKS$type == "free")
- exp(lfactorial(length(levels(control$strata))))
- else if(BLOCKS$type %in% c("series","grid")) {
- if(BLOCKS$mirror)
- blocks.multi * nobs
- else
- nobs
+ }
+ ## plot-level types
+ if(typeP %in% c("series","grid")) {
+ mult.p <- 2
+ if(isTRUE(all.equal(typeP, "grid")) && !is.null(colP) && colP > 2) {
+ mult.p <- 4
+ } else {
+ if(isTRUE(all.equal(n, 2)))
+ mult.p <- 1
+ }
+ }
+
+ ## within
+ ## another check - shouldn't this be moved? FIXME
+ if(!typeW %in% TYPES) {
+ stop("Ambiguous permutation type in 'control$within$type'")
+ }
+
+ ## calculate the number of possible permutations
+
+ ## Compute number of permutations for each block
+ if(is.null(BLOCKS))
+ BLOCKS <- factor(rep(1, n))
+
+ ## split an index vector
+ indv <- seq_len(n)
+ spl <- split(indv, BLOCKS)
+
+ ## loop over the components of spl & apply doNumPerms
+ np <- sapply(spl, doNumPerms, mult.p, mult.wi, typeP, typeW, PSTRATA,
+ mirrorP, mirrorW, constantW)
+
+ ## multiply up n perms per block
+ prod(np)
+}
+
+`doNumPerms` <- function(obs, mult.p, mult.wi, typeP, typeW, PSTRATA,
+ mirrorP, mirrorW, constantW) {
+ n <- nobs(obs) ## obs is index vector for object, split by blocks
+
+ if(!is.null(PSTRATA)) {
+ ## take only the PSTRATA needed for this block, drop unused levels
+ PSTRATA <- droplevels(PSTRATA[obs])
+
+ ## need only those strata for the current block. As obs is the index
+ ## vector, split by block, this now gives nobs per plot strata
+ tab <- table(PSTRATA)
+ same.n <- length(unitab <- unique(tab))
+ }
+
+ ## plots
+ num.p <- if(isTRUE(all.equal(typeP, "free"))) {
+ exp(lfactorial(length(levels(PSTRATA))))
+ } else if(typeP %in% c("series", "grid")) {
+ if(isTRUE(mirrorP)) {
+ mult.p * n
} else {
- 1
+ n
}
+ } else {
+ 1
}
- ## within
- if(!(WITHIN$type %in% PTYPES))
- stop("Ambiguous permutation type in 'control$within$type'")
-
- num.within <- if(WITHIN$type == "none") {
- ## no within permutations
- ## recall this is what we multiply num.blocks
- ## by hence not 0
+
+ num.wi <- if(isTRUE(all.equal(typeW, "none"))) {
+ ## no within permutations. note we multiply num.p by this
+ ## values so it is 1 not 0!!
1
- } else if(WITHIN$type == "free") {
- if(STRATA)
- prod(factorial(tab.strata))
- else
- exp(lfactorial(nobs))
+ } else if(isTRUE(all.equal(typeW, "free"))) {
+ if(!is.null(PSTRATA)) {
+ if(constantW) {
+ factorial(tab[1])
+ } else {
+ prod(factorial(tab))
+ }
+ } else {
+ exp(lfactorial(n))
+ }
} else {
- ##} else if(WITHIN$type %in% c("series","grid")) {
- if(STRATA) {
+ if(!is.null(PSTRATA)) {
if(same.n > 1) {
- multi <- rep(2, length = length(tab.strata))
- multi[which(tab.strata == 2)] <- 1
- if(WITHIN$mirror) {
- prod(multi * tab.strata)
+ multi <- rep(2, length = length(tab))
+ multi[which(tab == 2)] <- 1
+ if(mirrorW) {
+ prod(multi * tab)
} else {
- prod(tab.strata)
+ prod(tab)
}
} else {
- if(WITHIN$mirror) {
- if(WITHIN$constant)
- within.multi * unique(tab.strata)
+ if(mirrorW) {
+ if(constantW)
+ mult.wi * unitab
else
- prod(within.multi * tab.strata)
+ prod(mult.wi * tab)
} else {
- if(WITHIN$constant)
- unique(tab.strata)
+ if(constantW)
+ unitab ## FIXME: unitab[1]?? (unique(tab)[1])
else
- prod(tab.strata)
+ prod(tab)
}
}
} else {
- if(WITHIN$mirror)
- within.multi * nobs
+ if(mirrorW)
+ mult.wi * n
else
- nobs
+ n
}
}
- return(num.blocks * num.within)
+
+ ## return
+ num.p * num.wi
}
diff --git a/R/permCheck.R b/R/permCheck.R
index 0bf8333..673d8f9 100644
--- a/R/permCheck.R
+++ b/R/permCheck.R
@@ -1,61 +1,5 @@
-`check` <- function(object, control = permControl(),
- make.all = TRUE)
-{
- ## if object is numeric or integer and of length 1,
- ## extend the object
- if(length(object) == 1 &&
- (is.integer(object) || is.numeric(object)))
- object <- seq_len(object)
- ## check the number of observations in object
- nobs <- nobs(object)
- ## sample permutation type
- type <- control$within$type
- ## if strata, check nobs == length of strata
- ## but beware empty levels
- if(!is.null(control$strata)) {
- tab <- table(control$strata)
- if(!identical(as.integer(nobs), as.integer(sum(tab))))
- stop("Number of observations and length of 'strata' do not match.")
- ## if "grid", check design balanced?
- if((bal <- length(unique(tab))) > 1 && type == "grid")
- stop("Unbalanced 'grid' designs are not supported.")
- ## if grid design, check nrow*ncol is multiple of nobs
- if(type == "grid" &&
- !identical(nobs %% (control$within$ncol *
- control$within$nrow), 0))
- stop("'nrow' * 'ncol' not a multiple of number of observations.")
- ## if constant, check design balanced?
- if(control$within$constant && bal > 1)
- stop("Unbalanced designs not allowed with 'constant = TRUE'.")
- ## if permuting strata, must be balanced
- if(control$blocks$type != "none" && bal > 1)
- stop("Design must be balanced if permuting 'strata'.")
- }
- ## check allPerms is of correct form
- if(!is.null(control$all.perms) &&
- !identical(class(control$all.perms), "allPerms"))
- stop("'control$all.perms' must be of class 'allPerms'.")
- ## get number of possible permutations
- num.pos <- numPerms(object, control)
- ## if number of possible perms < minperm turn on complete enumeration
- if(num.pos < control$minperm) {
- control$nperm <- control$maxperm <- num.pos
- control$complete <- TRUE
- }
- ## if complete enumeration, generate all permutations
- if(control$complete && make.all) {
- control$all.perms <- allPerms(nobs, control = control,
- max = control$maxperm,
- observed = FALSE)
- }
- retval <- list(n = num.pos, control = control)
- class(retval) <- "check"
- retval
-}
-
-## depricate check
-`permCheck` <- function(object, control = permControl(),
- make.all = TRUE) {
+## deprecate check
+`permCheck` <- function(object, control = how()) {
.Deprecated(new = "check", "permute")
- check(object = object, control = control, make.all = make.all)
+ check(object = object, control = control)
}
diff --git a/R/permControl.R b/R/permControl.R
deleted file mode 100644
index 08d143a..0000000
--- a/R/permControl.R
+++ /dev/null
@@ -1,15 +0,0 @@
-`permControl` <- function(strata = NULL, nperm = 199, complete = FALSE,
- within = Within(),
- blocks = Blocks(),
- maxperm = 9999, minperm = 99,
- all.perms = NULL,
- observed = FALSE)
-{
- out <- list(strata = strata, nperm = nperm, complete = complete,
- within = within, blocks = blocks,
- maxperm = maxperm, minperm = minperm,
- all.perms = all.perms, observed = observed,
- name.strata = deparse(substitute(strata)))
- class(out) <- "permControl"
- return(out)
-}
diff --git a/R/permuplot.R b/R/permuplot.R
index 0a69690..de0a119 100644
--- a/R/permuplot.R
+++ b/R/permuplot.R
@@ -1,6 +1,6 @@
## This is totally wrong and needs updating to match the new
## code in permute...
-`permuplot` <- function(n, control = permControl(),
+`permuplot` <- function(n, control = how(),
col = par("col"),
hcol = "red",
shade = "lightgrey",
@@ -10,6 +10,10 @@
ann = par("ann"),
cex = par("cex"),
...) {
+ ## This should just bail with an message
+ message("permuplot does not work with the new permutation designs.\nNo plot will be generated!")
+ invisible()
+
xy.series <- function(n) {
angle <- seq(0, 2*pi, length = n+1)[-(n+1)]
x <- rev(cos(angle))
diff --git a/R/permute-deprecated.R b/R/permute-deprecated.R
new file mode 100644
index 0000000..3346def
--- /dev/null
+++ b/R/permute-deprecated.R
@@ -0,0 +1,43 @@
+`permControl` <- function(within = Within(),
+ plots = Plots(),
+ blocks = NULL,
+ nperm = 199, complete = FALSE,
+ maxperm = 9999, minperm = 99,
+ all.perms = NULL,
+ observed = FALSE)
+{
+ .Deprecated("how", package = "permute")
+ out <- list(within = within, plots = plots, blocks = blocks,
+ nperm = nperm, complete = complete,
+ maxperm = maxperm, minperm = minperm,
+ all.perms = all.perms, observed = observed,
+ blocks.name = deparse(substitute(blocks)))
+ class(out) <- "how"
+ out
+}
+
+`print.permControl` <- function(x, ...)
+{
+ .Deprecated("print.how", package = "permute")
+ class(x) <- "how"
+ print(x)
+}
+
+
+`print.permCheck` <- function(x, ...)
+{
+ print(x$n)
+}
+
+`print.summary.permCheck` <- function(x, ...)
+{
+ cat(paste("Number of possible permutations:", x$n, "\n"))
+ print(x$control)
+ invisible(x)
+}
+
+`summary.permCheck` <- function(object, ...)
+{
+ class(object) <- "summary.permCheck"
+ object
+}
diff --git a/R/permute.R b/R/permute.R
index 2887a3a..516b740 100644
--- a/R/permute.R
+++ b/R/permute.R
@@ -6,5 +6,5 @@ permute <- function(i, n, control) {
warning("'$all.perms' is NULL, yet '$complete = TRUE'.\nReturning a random permutation.")
perm <- shuffle(n, control)
}
- return(perm)
+ perm
}
diff --git a/R/print.permCheck.R b/R/print.check.R
similarity index 100%
rename from R/print.permCheck.R
rename to R/print.check.R
diff --git a/R/print.how.R b/R/print.how.R
new file mode 100644
index 0000000..f78c791
--- /dev/null
+++ b/R/print.how.R
@@ -0,0 +1,89 @@
+`print.how` <- function(x, ...) {
+
+ ## only for objects of correct class
+ stopifnot(class(x) == "how")
+
+ ## prefix to add to sub-elements
+ pfix <- " "
+
+ cat("\n")
+ writeLines(strwrap("Permutation Design:"))
+ cat("\n")
+
+ ## Blocks
+ writeLines("Blocks:")
+ blocks <- getBlocks(x)
+ if (is.null(blocks)) {
+ writeLines(strwrap("Defined by: none", prefix = pfix))
+ } else {
+ writeLines(strwrap(paste("Blocks:", x$blocks.name),
+ prefix = pfix))
+ }
+
+ cat("\n")
+
+ ## Plots
+ writeLines("Plots:")
+ plotStr <- getStrata(x, which = "plots")
+ plots <- getPlots(x)
+ ptype <- getType(x, which = "plots")
+ if (is.null(plotStr)) {
+ writeLines(strwrap("Defined by: none", prefix = pfix))
+ } else {
+ writeLines(strwrap(paste("Plots:", plots$plots.name),
+ prefix = pfix))
+ writeLines(strwrap(paste("Permutation type:", ptype),
+ prefix = pfix))
+ mirrorP <- getMirror(x, which = "plots")
+ writeLines(strwrap(paste("Mirrored?:", if(mirrorP) "Yes" else "No"),
+ prefix = pfix))
+ if(isTRUE(all.equal(ptype, "grid"))) {
+ nr <- getRow(x, which = "plots")
+ nr.t <- if(nr > 1) "rows" else "row"
+ nc <- getCol(x, which = "plots")
+ nc.t <- if(nc > 1) "cols" else "col"
+ writeLines(strwrap(paste("Grid dimensions:", nr, nr.t, " ",
+ nc, nc.t),
+ prefix = pfix))
+ }
+ }
+
+ cat("\n")
+
+ ## Within plots
+ writeLines("Within Plots:")
+ wtype <- getType(x, which = "within")
+ writeLines(strwrap(paste("Permutation type:", wtype), prefix = pfix))
+ mirrorW <- getMirror(x, which = "within")
+ constantW <- getConstant(x)
+ txt <- "Different permutation within each Plot?:"
+ if(isTRUE(wtype %in% c("series", "grid"))) {
+ writeLines(strwrap(paste("Mirrored?:", if(mirrorW) "Yes" else "No"),
+ prefix = pfix))
+ writeLines(strwrap(paste(txt, if(constantW) "No" else "Yes"),
+ prefix = pfix))
+ }
+ if(isTRUE(all.equal(wtype, "grid"))) {
+ nr <- getRow(x, which = "within")
+ nr.t <- if(nr > 1) "rows" else "row"
+ nc <- getCol(x, which = "within")
+ nc.t <- if(nc > 1) "cols" else "col"
+ writeLines(strwrap(paste("Grid dimensions:", nr, nr.t, " ",
+ nc, nc.t),
+ prefix = pfix))
+ }
+
+ cat("\n")
+
+ ## Meta data
+ writeLines("Permutation details:")
+ writeLines(strwrap(paste("Number of permutations requested:",
+ getNperm(x)), prefix = pfix))
+ writeLines(strwrap(paste("Max. number of permutations allowed:",
+ getMaxperm(x)), prefix = pfix))
+ txt <- paste("Evaluate all permutations?:",
+ if(getComplete(x)) "Yes." else "No.",
+ " Activation limit:", getMinperm(x))
+ writeLines(strwrap(txt, prefix = pfix))
+
+}
diff --git a/R/print.permControl.R b/R/print.permControl.R
deleted file mode 100644
index a77482e..0000000
--- a/R/print.permControl.R
+++ /dev/null
@@ -1,54 +0,0 @@
-`print.permControl` <- function(x, ...)
-{
- ## only for objects of correct class
- stopifnot(class(x) == "permControl")
- ## set-up the messages we wish to print
- if (!is.null(x$strata)) {
- if(x$blocks$type == "none") {
- msg.perm.strata <- "Strata unpermuted\n"
- } else {
- if(x$blocks$type == "grid") {
- msg.grid.strata <- paste("Strata are a spatial grid of dimension",
- x$blocks$nrow, "*",
- x$blocks$ncol, "\n")
- }
- msg.perm.strata <- paste("Permutation type:", x$blocks$type, "\n")
- msg.mirror.strata <- paste("Mirrored permutations for Strata?:",
- ifelse(x$blocks$mirror, "Yes", "No"), "\n")
- }
- msg.strata <- paste("Permutations are stratified within:", x$name.strata, "\n")
- } else {
- msg.strata <- "Permutations are unstratified\n"
- }
- msg.perm.sample <- paste("Permutation type:", x$within$type, "\n")
- if(x$within$type == "grid")
- msg.grid.sample <- paste("Data are spatial grid(s) of dimension",
- x$within$nrow, "*", x$within$ncol, "\n")
- msg.nperm <- paste("No. of permutations:", x$nperm,
- ifelse(x$complete, "(complete enumeration)", ""),
- "\n")
- msg.mirror.sample <- paste("Mirrored permutations for Samples?:",
- ifelse(x$within$mirror, "Yes", "No"), "\n")
- msg.constant <- paste("Use same permutation within strata?:",
- ifelse(x$within$constant, "Yes", "No"), "\n")
- ## print out the messages
- cat("\n")
- cat(msg.nperm)
- cat("\n**** STRATA ****\n")
- if(exists("msg.strata"))
- cat(msg.strata)
- if(exists("msg.perm.strata"))
- cat(msg.perm.strata)
- if(exists("msg.mirror.strata"))
- cat(msg.mirror.strata)
- if(exists("msg.grid.strata"))
- cat(msg.grid.strata)
- cat("\n**** SAMPLES ****\n")
- cat(msg.perm.sample)
- if(exists("msg.grid.sample"))
- cat(msg.grid.sample)
- cat(msg.mirror.sample)
- if(exists("msg.perm.strata"))
- cat(msg.constant)
- cat("\n")
-}
diff --git a/R/print.permutationMatrix.R b/R/print.permutationMatrix.R
new file mode 100644
index 0000000..97aaa20
--- /dev/null
+++ b/R/print.permutationMatrix.R
@@ -0,0 +1,84 @@
+## Simple print method for objects of class "permutationMatrix"
+## - at the moment, don't print the attributes
+
+`print.permutationMatrix` <- function(x, ...) {
+ ## indicators of plot and block strata
+ pl <- bl <- FALSE
+
+ ## grab the permutation design
+ ctrl <- attr(x, "control") ## gives us the list generated by how()
+
+ blocks <- getBlocks(ctrl)
+ plots <- getPlots(ctrl)
+
+ ## print out dimensions of permutation matrix
+ msg <- paste("No. of Permutations: ", nrow(x), sep = "")
+ writeLines(strwrap(msg))
+
+ ## print info on the within level
+ msg <- paste("No. of Samples:", ncol(x), "(")
+ if (any(pl <- !is.null(plots), bl <- !is.null(blocks))) {
+ msg <- paste(msg, "Nested in: ", sep = "")
+ if (pl && !bl) {
+ nmsg <- "plots; "
+ } else if (bl && !pl) {
+ nmsg <- "blocks; "
+ } else {
+ nmsg <- "plots & blocks; "
+ }
+ msg <- paste(msg, nmsg, sep = "")
+ }
+ wmsg <- switch(wt <- getType(ctrl, which = "within"),
+ none = "",
+ free = "Randomised",
+ series = "Sequence",
+ grid = paste("Spatial grid: ",
+ getRow(ctrl, which = "within"), "r, ",
+ getCol(ctrl, which = "within"), "c", sep = ""))
+ msg <- paste(msg, wmsg, sep = "")
+ ## add info on mirroring if series or grid
+ if ((wt %in% c("series", "grid")) && getMirror(ctrl, which = "within")) {
+ msg <- paste(msg, "; mirrored", sep = "")
+ }
+ ## add info on constant
+ if (getConstant(ctrl, which = "within") && pl) {
+ msg <- paste(msg, "; same permutation in each plot", sep = "")
+ }
+ writeLines(strwrap(paste(msg, ")", sep = "")))
+
+ ## print info on blocking, but ONLY if set
+ if (!is.null(blocks <- getBlocks(ctrl))) {
+ ll <- length(levels(blocks))
+ msg <- paste("Restricted by Blocks: ", ctrl$blocks.name,
+ " (", ll, " ", if (ll == 1L) "block" else "blocks",
+ ")", sep = "")
+ writeLines(strwrap(msg))
+ }
+
+ ## print info on plots, but ONLY if set
+ if (!is.null(strata <- getStrata(ctrl, which = "plots"))) {
+ #pl <- TRUE
+ plots <- getPlots(ctrl)
+ pmsg <- switch(pt <- getType(ctrl, which = "plots"),
+ none = "",
+ free = "; Randomised",
+ series = "; Sequence",
+ grid = paste("; Spatial grid: ",
+ getRow(ctrl, which = "plots"), "r, ",
+ getCol(ctrl, which = "plots"), "c", sep = ""))
+ ## add info on mirroring if series or grid
+ if ((pt %in% c("series","grid")) && getMirror(ctrl, which = "plots")) {
+ pmsg <- paste(pmsg, " - mirrored")
+ }
+ ll <- length(levels(strata))
+ msg <- paste("Restricted by Plots: ", plots$plots.name,
+ " (", ll, " ", if (ll == 1L) "plot" else "plots",
+ pmsg, ")", sep = "")
+ writeLines(strwrap(msg))
+ }
+
+
+ cat("\n")
+ x <- as.matrix(x)
+ print(x, ...)
+}
diff --git a/R/print.summary.allPerms.R b/R/print.summary.allPerms.R
index f77807d..a587312 100644
--- a/R/print.summary.allPerms.R
+++ b/R/print.summary.allPerms.R
@@ -7,11 +7,10 @@
cat("\n")
writeLines(strwrap("Complete enumeration of permutations\n",
prefix = "\t"))
- cat("\nPermutation Scheme:\n")
print(control)
- cat(paste("Contains observed ordering?:", ifelse(observed, "Yes", "No"),
- "\n"))
cat("\nAll permutations:\n")
+ writeLines(paste("Contains observed ordering?:", ifelse(observed, "Yes", "No"),
+ "\n"))
print(x)
return(invisible(x))
}
diff --git a/R/print.summary.permCheck.R b/R/print.summary.check.R
similarity index 100%
rename from R/print.summary.permCheck.R
rename to R/print.summary.check.R
diff --git a/R/setFoo-methods.R b/R/setFoo-methods.R
new file mode 100644
index 0000000..a4da3f5
--- /dev/null
+++ b/R/setFoo-methods.R
@@ -0,0 +1,408 @@
+## Replacement functions for blocks, plots and within, plus strata,
+## etc ...
+`setNperm<-` <- function(object, value) {
+ UseMethod("setNperm<-")
+}
+
+`setNperm<-.default` <- function(object, value) {
+ stop("No default method for `setNperm`")
+}
+
+`setNperm<-.how` <- function(object, value) {
+ object[["nperm"]] <- value
+ object <- fixupCall(object, "nperm", value)
+ object
+}
+
+`setNperm<-.permControl` <- function(object, value) {
+ object[["nperm"]] <- value
+ object <- fixupCall(object, "nperm", value)
+ object
+}
+
+`setMaxperm<-` <- function(object, value) {
+ UseMethod("setMaxperm<-")
+}
+
+`setMaxperm<-.default` <- function(object, value) {
+ stop("No default method for `setMaxperm`")
+}
+
+`setMaxperm<-.how` <- function(object, value) {
+ object[["maxperm"]] <- value
+ object <- fixupCall(object, "maxperm", value)
+ object
+}
+
+`setMaxperm<-.permControl` <- function(object, value) {
+ object[["maxperm"]] <- value
+ object <- fixupCall(object, "maxperm", value)
+ object
+}
+
+`setMinperm<-` <- function(object, value) {
+ UseMethod("setMinperm<-")
+}
+
+`setMinperm<-.default` <- function(object, value) {
+ stop("No default method for `setMinperm`")
+}
+
+`setMinperm<-.how` <- function(object, value) {
+ object[["minperm"]] <- value
+ object <- fixupCall(object, "minperm", value)
+ object
+}
+
+`setMinperm<-.permControl` <- function(object, value) {
+ object[["minperm"]] <- value
+ object <- fixupCall(object, "minperm", value)
+ object
+}
+
+`setComplete<-` <- function(object, value) {
+ UseMethod("setComplete<-")
+}
+
+`setComplete<-.default` <- function(object, value) {
+ stop("No default method for `setComplete`")
+}
+
+`setComplete<-.how` <- function(object, value) {
+ if (!is.null(value))
+ value <- rep(as.logical(value), length.out = 1)
+ object[["complete"]] <- value
+ object <- fixupCall(object, "complete", value)
+ object
+}
+
+`setComplete<-.permControl` <- function(object, value) {
+ if (!is.null(value))
+ value <- rep(as.logical(value), length.out = 1)
+ object[["complete"]] <- value
+ object <- fixupCall(object, "complete", value)
+ object
+}
+
+`setAllperms<-` <- function(object, value) {
+ UseMethod("setAllperms<-")
+}
+
+`setAllperms<-.default` <- function(object, value) {
+ stop("No default method for `setAllperms`")
+}
+
+`setAllperms<-.how` <- function(object, value) {
+ if (!is.null(value))
+ value <- as.matrix(value)
+ object[["all.perms"]] <- value
+ object <- fixupCall(object, "all.perms", value)
+ object
+}
+
+`setAllperms<-.permControl` <- function(object, value) {
+ if (!is.null(value))
+ value <- as.matrix(value)
+ object[["all.perms"]] <- value
+ object <- fixupCall(object, "all.perms", value)
+ object
+}
+
+`setMake<-` <- function(object, value) {
+ UseMethod("setMake<-")
+}
+
+`setMake<-.default` <- function(object, value) {
+ stop("No default method for `setMake`")
+}
+
+`setMake<-.how` <- function(object, value) {
+ if (!is.null(value))
+ value <- rep(as.logical(value), length.out = 1)
+ object[["make"]] <- value
+ object <- fixupCall(object, "make", value)
+ object
+}
+
+`setMake<-.permControl` <- function(object, value) {
+ if (!is.null(value))
+ value <- rep(as.logical(value), length.out = 1)
+ object[["make"]] <- value
+ object <- fixupCall(object, "make", value)
+ object
+}
+
+`setBlocks<-` <- function(object, value) {
+ UseMethod("setBlocks<-")
+}
+
+`setBlocks<-.default` <- function(object, value) {
+ stop("No default method for `setBlocks`")
+}
+
+`setBlocks<-.how` <- function(object, value) {
+ if (!is.null(value))
+ value <- as.factor(value)
+ object["blocks"] <- list(value)
+ object[["blocks.name"]] <- deparse(substitute(value))
+ object <- fixupCall(object, "blocks", value)
+ object
+}
+
+`setBlocks<-.permControl` <- function(object, value) {
+ if (!is.null(value))
+ value <- as.factor(value)
+ object["blocks"] <- list(value)
+ object[["blocks.name"]] <- deparse(substitute(value))
+ object <- fixupCall(object, "blocks", value)
+ object
+}
+
+`setObserved<-` <- function(object, value) {
+ UseMethod("setObserved<-")
+}
+
+`setObserved<-.default` <- function(object, value) {
+ stop("No default method for `setObserved`")
+}
+
+`setObserved<-.how` <- function(object, value) {
+ if (!is.null(value))
+ value <- rep(as.logical(value), length.out = 1)
+ object[["observed"]] <- value
+ object <- fixupCall(object, "observed", value)
+ object
+}
+
+`setObserved<-.permControl` <- function(object, value) {
+ if (!is.null(value))
+ value <- rep(as.logical(value), length.out = 1)
+ object[["observed"]] <- value
+ object <- fixupCall(object, "observed", value)
+ object
+}
+
+## Plots ##############################################################
+`setPlots<-` <- function(object, value) {
+ UseMethod("setPlots<-")
+}
+
+`setPlots<-.default` <- function(object, value) {
+ stop("No default method for `setPlots`")
+}
+
+`setPlots<-.how` <- function(object, value) {
+ stopifnot(inherits(value, "Plots"))
+ object[["plots"]] <- value
+ object <- fixupCall(object, "plots", getCall(value))
+ object
+}
+
+## Within ##############################################################
+`setWithin<-` <- function(object, value) {
+ UseMethod("setWithin<-")
+}
+
+`setWithin<-.default` <- function(object, value) {
+ stop("No default method for `setWithin`")
+}
+
+`setWithin<-.how` <- function(object, value) {
+ stopifnot(inherits(value, "Within"))
+ object[["within"]] <- value
+ object <- fixupCall(object, "within", getCall(value))
+ object
+}
+
+## Strata #############################################################
+`setStrata<-` <- function(object, value) {
+ UseMethod("setStrata<-")
+}
+
+`setStrata<-.default` <- function(object, value) {
+ stop("No default method for `setStrata`")
+}
+
+`setStrata<-.how` <- function(object, value) {
+ if (!is.null(value))
+ value <- as.factor(value)
+ object[["blocks"]] <- value
+ object <- fixupCall(object, "blocks", getCall(value))
+ object
+}
+
+`setStrata<-.Plots` <- function(object, value) {
+ if (!is.null(value))
+ value <- as.factor(value)
+ object[["strata"]] <- value
+ object <- fixupCall(object, "strata", getCall(value))
+ object
+}
+
+## Grid dimensions ####################################################
+`setRow<-` <- function(object, value) {
+ UseMethod("setRow<-")
+}
+
+`setRow<-.default` <- function(object, value) {
+ stop("No default method for `setRow`")
+}
+
+`setRow<-.how` <- function(object, value) {
+ stop("`setRow` can not be used directly on '\"how\"' objects.")
+}
+
+`setRow<-.Within` <- function(object, value) {
+ value <- as.integer(value)
+ object[["nrow"]] <- value
+ object <- fixupCall(object, "nrow", value)
+ object
+}
+
+`setRow<-.Plots` <- function(object, value) {
+ value <- as.integer(value)
+ object[["nrow"]] <- value
+ object <- fixupCall(object, "nrow", value)
+ object
+}
+
+`setCol<-` <- function(object, value) {
+ UseMethod("setCol<-")
+}
+
+`setCol<-.default` <- function(object, value) {
+ stop("No default method for `setCol`")
+}
+
+`setCol<-.how` <- function(object, value) {
+ stop("`setCol` can not be used directly on '\"how\"' objects.")
+}
+
+`setCol<-.Within` <- function(object, value) {
+ value <- as.integer(value)
+ object[["ncol"]] <- value
+ object <- fixupCall(object, "ncol", value)
+ object
+}
+
+`setCol<-.Plots` <- function(object, value) {
+ value <- as.integer(value)
+ object[["ncol"]] <- value
+ object <- fixupCall(object, "ncol", value)
+ object
+}
+
+`setDim<-` <- function(object, value) {
+ UseMethod("setDim<-")
+}
+
+`setDim<-.default` <- function(object, value) {
+ stop("No default method for `setDim`")
+}
+
+`setDim<-.how` <- function(object, value) {
+ stop("`setDim` can not be used directly on '\"how\"' objects.")
+}
+
+`setDim<-.Within` <- function(object, value) {
+ value <- as.integer(value)
+ stopifnot(all.equal(length(value), 2L))
+ setRow(object) <- value[1]
+ setCol(object) <- value[2]
+ object
+}
+
+`setDim<-.Plots` <- function(object, value) {
+ value <- as.integer(value)
+ stopifnot(all.equal(length(value), 2L))
+ setRow(object) <- value[1]
+ setCol(object) <- value[2]
+ object
+}
+
+## setType ############################################################
+`setType<-` <- function(object, value) {
+ UseMethod("setType<-")
+}
+
+`setType<-.default` <- function(object, value) {
+ stop("No default method for `setType`")
+}
+
+`setType<-.how` <- function(object, value) {
+ stop("`setType` can not be used directly on '\"how\"' objects.")
+}
+
+`setType<-.Within` <- function(object, value) {
+ value <- as.character(value)
+ if (!value %in% c("free","series","grid","none"))
+ stop("Invalid permutation type")
+ value <- rep(value, length.out = 1L)
+ object[["type"]] <- value
+ object <- fixupCall(object, "type", value)
+ object
+}
+
+`setType<-.Plots` <- function(object, value) {
+ value <- as.character(value)
+ if (!value %in% c("free","series","grid","none"))
+ stop("Invalid permutation type")
+ value <- rep(value, length.out = 1L)
+ object[["type"]] <- value
+ object <- fixupCall(object, "type", value)
+ object
+}
+
+## setMirror ############################################################
+`setMirror<-` <- function(object, value) {
+ UseMethod("setMirror<-")
+}
+
+`setMirror<-.default` <- function(object, value) {
+ stop("No default method for `setMirror`")
+}
+
+`setMirror<-.how` <- function(object, value) {
+ stop("`setMirror` can not be used directly on '\"how\"' objects.")
+}
+
+`setMirror<-.Within` <- function(object, value) {
+ if (!is.null(value))
+ value <- rep(as.logical(value), length.out = 1)
+ object[["Mirror"]] <- value
+ object <- fixupCall(object, "Mirror", value)
+ object
+}
+
+`setMirror<-.Plots` <- function(object, value) {
+ if (!is.null(value))
+ value <- rep(as.logical(value), length.out = 1)
+ object[["Mirror"]] <- value
+ object <- fixupCall(object, "Mirror", value)
+ object
+}
+
+## setConstant ############################################################
+`setConstant<-` <- function(object, value) {
+ UseMethod("setConstant<-")
+}
+
+`setConstant<-.default` <- function(object, value) {
+ stop("No default method for `setConstant`")
+}
+
+`setConstant<-.how` <- function(object, value) {
+ stop("`setConstant` can not be used directly on '\"how\"' objects.")
+}
+
+`setConstant<-.Within` <- function(object, value) {
+ if (!is.null(value))
+ value <- rep(as.logical(value), length.out = 1)
+ object[["Constant"]] <- value
+ object <- fixupCall(object, "Constant", value)
+ object
+}
+
+`setConstant<-.Plots` <- function(object, value) {
+ stop("`setConstant` does not apply to '\"Plots\"' objects.")
+}
diff --git a/R/shuffle-utils.R b/R/shuffle-utils.R
index 045ed5d..78f84a2 100644
--- a/R/shuffle-utils.R
+++ b/R/shuffle-utils.R
@@ -70,3 +70,15 @@
`shuffleFree` <- function(x, size) {
sample.int(x, size, replace = FALSE)
}
+
+## wrapper function when shuffling without any strata at all at any level
+`shuffleNoStrata` <- function(n, control) {
+ type <- control$within$type
+ switch(type,
+ "free" = shuffleFree(n, n),
+ "series" = shuffleSeries(seq_len(n), mirror = control$within$mirror),
+ "grid" = shuffleGrid(nrow = control$within$nrow,
+ ncol = control$within$ncol, mirror = control$within$mirror),
+ "none" = seq_len(n)
+ )
+}
diff --git a/R/shuffle.R b/R/shuffle.R
index 29dfe87..8260736 100644
--- a/R/shuffle.R
+++ b/R/shuffle.R
@@ -1,16 +1,10 @@
-`shuffle` <- function (n, control = permControl()) {
- ## If no strata then permute all samples using stated scheme
- if(is.null(control$strata)) {
- out <-
- switch(control$within$type,
- "free" = shuffleFree(n, n),
- "series" = shuffleSeries(seq_len(n),
- mirror = control$within$mirror),
- "grid" = shuffleGrid(nrow = control$within$nrow,
- ncol = control$within$ncol,
- mirror = control$within$mirror),
- "none" = seq_len(n)
- )
+`shuffle2` <- function (n, control = how()) {
+ ## capture strata data
+ Pstrata <- getStrata(control, which = "plots")
+ Bstrata <- getStrata(control, which = "blocks")
+ ## if no strata at all permute all samples using stated scheme
+ if(is.null(Pstrata) && is.null(Bstrata)) {
+ out <- shuffleNoStrata(n, control)
} else {
## If strata present, either permute samples, strata or both
diff --git a/R/shuffle2.R b/R/shuffle2.R
new file mode 100644
index 0000000..f2a30e2
--- /dev/null
+++ b/R/shuffle2.R
@@ -0,0 +1,122 @@
+## new version of shuffle() that allows for blocking
+`shuffle` <- function(n, control = how()) {
+ ## get blocking, if any
+ Block <- getStrata(control, which = "blocks")
+ ## If no blocking, put all samples in same block
+ if(is.null(Block)) {
+ Block <- factor(rep(1, n))
+ } else {
+ ## There was blocking so update control to remove it
+ ## as we don't need it in control at the within-block
+ ## permutations performed in the loop
+ control <- update(control, blocks = NULL)
+ }
+
+ sn <- seq_len(n) ## sequence of samples in order of input
+
+ ## split sn on basis of Block
+ spln <- split(sn, Block)
+ nb <- length(spln) ## number of blocks
+
+ ## result list
+ out <- vector(mode = "list", length = nb)
+
+ ## loop over spln and shuffle in each split
+ for(i in seq_len(nb)) {
+ out[[i]] <- doShuffle(spln[[i]], control)
+ }
+ out <- unsplit(out, Block) ## undo the original splitting
+ out
+}
+
+`doShuffle` <- function(ind, control) {
+ ## collect strata at Plot level
+ Pstrata <- getStrata(control, which = "plots", drop = TRUE)
+ plotCTRL <- getPlots(control)
+ ## ...which need to be reduced to only those for `ind`
+ Pstrata <- Pstrata[ind]
+
+ n <- length(ind)
+ sn <- seq_len(n)
+
+ ## if no strata at Plot level permute all samples using stated scheme
+ if(is.null(Pstrata)) {
+ perm <- shuffleNoStrata(n, control)
+ } else {
+ typeP <- getType(control, which = "plots")
+ typeW <- getType(control, which = "within")
+
+ ## permute Plot strata?
+ if(isTRUE(all.equal(typeP, "none"))) { ## NO
+ perm <- sn
+ } else { ## YES
+ flip <- runif(1L) < 0.5 ## logical, passed on & used only if mirroring
+ perm <- shuffleStrata(Pstrata,
+ type = typeP,
+ mirror = plotCTRL$mirror,
+ flip = flip,
+ nrow = plotCTRL$nrow,
+ ncol = plotCTRL$ncol)
+ }
+
+ ## permute the samples within Plot strata
+ if(!isTRUE(all.equal(typeW, "none"))) { ## NOTE the `!`
+ ## house keeping to track permuted strata - used later
+ tab <- table(Pstrata[perm])
+ levs <- names(tab) ## levels of Plot strata in this split
+
+ ## use same permutation within each level of strata?
+ withinCTRL <- getWithin(control)
+ CONSTANT <- withinCTRL$constant
+ if(isTRUE(CONSTANT)) {
+ if(isTRUE(all.equal(typeW, "free"))) {
+ N <- unique(tab)[1L]
+ same.rand <- shuffleFree(N, N)
+ } else if(isTRUE(all.equal(typeW, "series"))) {
+ start <- shuffleFree(n / length(levs), 1L)
+ flip <- runif(1L) < 0.5
+ } else if(isTRUE(all.equal(typeW, "grid"))) {
+ start.row <- shuffleFree(withinCTRL$nrow, 1L)
+ start.col <- shuffleFree(withinCTRL$ncol, 1L)
+ flip <- runif(2L) < 0.5
+ }
+ } else {
+ start <- start.row <- start.col <- flip <- NULL
+ }
+
+ ## copy perm at this stage
+ tmp <- perm
+
+ ## for each level of strata in this split, shuffle
+ for(lv in levs) {
+ ## must re-order strata here on basis of out as they
+ ## may have been permuted above
+ MATCH <- Pstrata[perm] == lv
+ gr <- perm[MATCH]
+ if((n.gr <- length(gr)) > 1) {
+ tmp[which(MATCH)] <-
+ switch(typeW,
+ "free" = if(isTRUE(CONSTANT)) {
+ gr[same.rand]
+ } else {
+ perm[gr][shuffleFree(n.gr, n.gr)]
+ },
+ "series" =
+ gr[shuffleSeries(seq_len(n.gr),
+ mirror = withinCTRL$mirror,
+ start = start, flip = flip)],
+ "grid" =
+ gr[shuffleGrid(nrow = withinCTRL$nrow,
+ ncol = withinCTRL$ncol,
+ mirror = withinCTRL$mirror,
+ start.row = start.row,
+ start.col = start.col,
+ flip = flip)]
+ )
+ }
+ }
+ perm <- tmp
+ }
+ }
+ ind[perm]
+}
diff --git a/R/shuffleSet.R b/R/shuffleSet.R
index 5233ef1..1178b7e 100644
--- a/R/shuffleSet.R
+++ b/R/shuffleSet.R
@@ -1,4 +1,4 @@
-`shuffleSet` <- function(n, nset = 1, control = permControl()) {
+`shuffleSet2` <- function(n, nset = 1, control = how()) {
Set <- matrix(nrow = nset, ncol = n)
WI <- getWithin(control)
strata <- getStrata(control)
diff --git a/R/shuffleSet2.R b/R/shuffleSet2.R
new file mode 100644
index 0000000..17b9195
--- /dev/null
+++ b/R/shuffleSet2.R
@@ -0,0 +1,205 @@
+## new version of shuffleSet() that allows for blocking
+`shuffleSet` <- function(n, nset, control = how(), check = TRUE) {
+ ## Store the .Random.seed, if it exists, so we can attach this as
+ ## an attribute to the permutation matrix returned in out
+ SEED <- NULL
+ if (exists(".Random.seed", envir = globalenv())) {
+ SEED <- .Random.seed
+ }
+
+ ## handle missing nset - take from control if can
+ if(missing(nset)) {
+ np <- getNperm(control)
+ if(is.null(np)) ## something wrong, default back to 1
+ nset <- 1
+ else
+ nset <- np
+ } else {
+ setNperm(control) <- nset ## this fixes the control$call too!
+ }
+
+ sn <- seq_len(n) ## sequence of samples in order of input
+
+ ## if checking permutation design, may end up with more perms
+ ## than requested in nset, depending upon what user specified
+ ## in `control`. The `check` argument can turn this step off
+ ## so you always get `nset` permutations and, yes, you can shoot
+ ## yourself in the foot with this, hence the default is to check!
+ if (isTRUE(check)) {
+ ## need to check number of permutations won't blow up
+ pcheck <- check(sn, control = control)
+ ## control possibly now updated
+ control <- pcheck$control
+ }
+
+ if(is.null(AP <- getAllperms(control))) {
+ ## get blocking, if any
+ Block <- getStrata(control, which = "blocks")
+ if(is.null(Block))
+ Block <- factor(rep(1, n))
+
+ ## split sn on basis of Block
+ spln <- split(sn, Block)
+ nb <- length(spln) ## number of blocks
+
+ ## result list
+ out <- vector(mode = "list", length = nb)
+
+ ## loop over spln and shuffle in each split
+ for(i in seq_len(nb)) {
+ out[[i]] <- doShuffleSet(spln[[i]], nset = nset, control)
+ }
+ ## undo the original splitting. Can't use unsplit() here as the
+ ## elements of out are matrices
+ out <- do.call(cbind, out)
+ out[, unlist(spln)] <- out ## reorders according to spln
+ } else {
+ ## if we have all.perms now then we must have generated it
+ ## during checking or user passed it with control
+ ## Use that instead of a ranodm set
+ out <- AP
+ }
+
+ ## Because all.perms might have been generated, we have the
+ ## possibility that nrow(out) != nset. In that case, also no random
+ ## numbers have been generated. Hence we can sample nset rows from
+ ## out and return that. This has the nice side-effect of not
+ ## generating any non-unique permutations. Suggested by Jari.
+ if ((nr <- nrow(out)) > nset) {
+ out <- out[sample.int(nr, nset), ]
+ }
+
+ ## Attach random seed stored earlier to permutation matrix
+ attr(out, "seed") <- SEED
+ attr(out, "control") <- control
+ attr(out, "observed") <- NULL ## nullify this as allPerms may have added it?
+
+ ## class the matrix so we can have a print method etc, but inherit from
+ ## the matrix S3 class
+ class(out) <- c("permutationMatrix", "matrix")
+
+ ## return
+ out
+}
+
+`doShuffleSet` <- function(ind, nset = 1, control) {
+ ## collect strata at Plot level
+ Pstrata <- getStrata(control, which = "plots", drop = TRUE)
+ plotCTRL <- getPlots(control)
+ typeP <- getType(control, which = "plots")
+
+ ## collect the within control object
+ withinCTRL <- getWithin(control)
+ typeW <- getType(control, which = "within")
+
+ n <- length(ind)
+ sn <- seq_len(n)
+
+ ## result object
+ Set <- matrix(nrow = nset, ncol = n)
+
+ ## if no strata at Plot level permute all samples using stated scheme
+ if(is.null(Pstrata)) {
+ ## If no strata at plot then permute all samples using stated scheme
+ Args <- switch(typeW,
+ "free" = list(x = n, size = n),
+ "series" = list(x = seq_len(n),
+ mirror = withinCTRL$mirror),
+ "grid" = list(nrow = withinCTRL$nrow,
+ ncol = withinCTRL$ncol,
+ mirror = withinCTRL$mirror))
+ FUN <- switch(typeW,
+ "free" = shuffleFree,
+ "series" = shuffleSeries,
+ "grid" = shuffleGrid)
+ if(withinCTRL$type == "none") {
+ Set[] <- rep(sn, each = nset)
+ } else {
+ for(i in seq_len(nset)) {
+ Set[i,] <- do.call(FUN, Args)
+ }
+ }
+ } else {
+ ## If strata at Plot level present, either permute samples, Plots or both
+
+ ## permute strata at Plot level?
+ if(isTRUE(all.equal(typeP, "none"))) {
+ Set[] <- rep(sn, each = nset)
+ } else {
+ for(i in seq_len(nset)) {
+ Set[i,] <- do.call(shuffleStrata,
+ list(strata = Pstrata,
+ type = typeP,
+ mirror = plotCTRL$mirror,
+ flip = NULL, ## runif(1L) < 0.5 ??
+ nrow = plotCTRL$nrow,
+ ncol = plotCTRL$ncol))
+ }
+ }
+
+ tmp <- Set
+
+ ## permute the samples within Plot strata
+ if(!isTRUE(all.equal(typeW, "none"))) {
+ for(i in seq_len(nset)) {
+ tab <- table(Pstrata[ind][Set[i,]])
+ ## the levels of the Plot strata
+ levs <- names(tab)
+
+ ## same permutation within each level of the Plot strata?
+ if(withinCTRL$constant) {
+ if(isTRUE(all.equal(typeW, "free"))) {
+ n <- unique(tab)[1L]
+ same.rand <- shuffleFree(n, n)
+ } else if(isTRUE(all.equal(typeW, "series"))) {
+ start <- shuffleFree(n / length(levs), 1L)
+ flip <- runif(1L) < 0.5 ## FIXME this should be moved out of the loop
+ } else if(isTRUE(all.equal(typeW, "grid"))) {
+ start.row <- shuffleFree(withinCTRL$nrow, 1L)
+ start.col <- shuffleFree(withinCTRL$ncol, 1L)
+ flip <- runif(2L) < 0.5 ## FIXME this should be moved out of the loop
+ }
+ } else {
+ start <- start.row <- start.col <- flip <- NULL
+ }
+
+ ## for each level of strata, permute
+ for(lv in levs) {
+ ## must re-order strata here on basis of Ser as they
+ ## may have been permuted above
+ MATCH <- Pstrata[ind][Set[i,]] == lv
+ gr <- Set[i,][MATCH]
+ if((n.gr <- length(gr)) > 1) {
+ if(withinCTRL$constant && isTRUE(all.equal(typeW, "free"))) {
+ tmp[i,][which(MATCH)] <- gr[same.rand]
+ } else {
+ Args <-
+ switch(typeW,
+ "free" = list(x = n.gr, size = n.gr),
+ "series" = list(x = seq_len(n.gr),
+ mirror = withinCTRL$mirror,
+ start = start,
+ flip = flip),
+ "grid" = list(nrow = withinCTRL$nrow,
+ ncol = withinCTRL$ncol,
+ mirror = withinCTRL$mirror,
+ start.row = start.row,
+ start.col = start.col,
+ flip = flip))
+ FUN <-
+ switch(typeW,
+ "free" = shuffleFree,
+ "series" = shuffleSeries,
+ "grid" = shuffleGrid)
+ tmp[i,][which(MATCH)] <- gr[do.call(FUN, Args)]
+ }
+ }
+ }
+ }
+ Set <- tmp
+ }
+ }
+ out <- Set ## have to copy or next line fails
+ out[] <- ind[Set]
+ out
+}
diff --git a/R/summary.permCheck.R b/R/summary.check.R
similarity index 100%
rename from R/summary.permCheck.R
rename to R/summary.check.R
diff --git a/R/update.Plots.R b/R/update.Plots.R
new file mode 100644
index 0000000..6d8d7c0
--- /dev/null
+++ b/R/update.Plots.R
@@ -0,0 +1,62 @@
+# File permute/R/update.Plots.R
+# Part of the R package, http://www.R-project.org
+#
+# Copyright (C) 1995-2012 The R Core Team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# A copy of the GNU General Public License is available at
+# http://www.r-project.org/Licenses/
+#
+# Modifications by Gavin L. Simpson
+#
+# Copyright (C) 2013 Gavin L. Simpson
+#
+# Modifcations made:
+# 1) Remove `formula.` argument and processing thereof.
+# 2) Evaluation is forced to the global environment.
+# 3) (minor) Took the definition of `call` out of the `if ()` statement
+# for clarity/style issues.
+# 4) Added this modification section to the copyright/licence header.
+# 5) Added code to preserve some components of the original object.
+
+`update.Plots` <- function (object, ..., evaluate = TRUE) {
+ call <- getCall(object)
+ if (is.null(call))
+ stop("need an object with call component")
+ extras <- match.call(expand.dots = FALSE)$...
+
+ ## preserve or update the plots names
+ pname <- if ("strata" %in% names(extras)) {
+ deparse(substitute(extras[["strata"]]))
+ } else {
+ object$plots.name
+ }
+
+ if (length(extras)) {
+ existing <- !is.na(match(names(extras), names(call)))
+ ## do these individually to allow NULL to remove entries.
+ for (a in names(extras)[existing])
+ call[[a]] <- extras[[a]]
+ if (any(!existing)) {
+ call <- c(as.list(call), extras[!existing])
+ call <- as.call(call)
+ }
+ }
+ if (evaluate) {
+ out <- eval(call, parent.frame())
+ out$plots.name <- pname
+ } else {
+ out <- call
+ }
+
+ out
+}
diff --git a/R/update.how.R b/R/update.how.R
new file mode 100644
index 0000000..bad2568
--- /dev/null
+++ b/R/update.how.R
@@ -0,0 +1,73 @@
+# File permute/R/update.how.R
+# Part of the R package, http://www.R-project.org
+#
+# Copyright (C) 1995-2012 The R Core Team
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# A copy of the GNU General Public License is available at
+# http://www.r-project.org/Licenses/
+#
+# Modifications by Gavin L. Simpson
+#
+# Copyright (C) 2013 Gavin L. Simpson
+#
+# Modifcations made:
+# 1) Remove `formula.` argument and processing thereof.
+# 2) Evaluation is forced to the global environment.
+# 3) (minor) Took the definition of `call` out of the `if ()` statement
+# for clarity/style issues.
+# 4) Added this modification section to the copyright/licence header.
+# 5) Added code to preserve some components of the original object.
+
+`update.how` <- function (object, ..., evaluate = TRUE) {
+ call <- getCall(object)
+ if (is.null(call))
+ stop("need an object with call component")
+ extras <- match.call(expand.dots = FALSE)$...
+
+ ## preserve or update block and/or plot names
+ bname <- if ("blocks" %in% names(extras)) {
+ deparse(substitute(extras[["blocks"]]))
+ } else {
+ object$blocks.name
+ }
+ pname <- if ("plots" %in% names(extras)) {
+ dots <- list(...)
+ dots$plots$plots.name
+ } else {
+ object$plots$plots.name
+ }
+
+ ## process remaining ... args
+ if (length(extras)) {
+ existing <- !is.na(match(names(extras), names(call)))
+ ## do these individually to allow NULL to remove entries.
+ for (a in names(extras)[existing])
+ call[[a]] <- extras[[a]]
+ if (any(!existing)) {
+ call <- c(as.list(call), extras[!existing])
+ call <- as.call(call)
+ }
+ }
+
+ ## probably want to evaluate hence default is TRUE
+ if (evaluate) {
+ out <- eval(call, parent.frame())
+ ## add back in the chars we discovered earlier
+ out$blocks.name <- bname
+ out$plots$plots.name <- pname
+ } else {
+ out <- call
+ }
+
+ out
+}
diff --git a/build/vignette.rds b/build/vignette.rds
new file mode 100644
index 0000000..ef8f615
Binary files /dev/null and b/build/vignette.rds differ
diff --git a/inst/COPYRIGHTS b/inst/COPYRIGHTS
new file mode 100644
index 0000000..5d375b2
--- /dev/null
+++ b/inst/COPYRIGHTS
@@ -0,0 +1,16 @@
+Unless otherwise stated, the source code of the permute package is
+copyright (C) Gavin L. Simpson 2010 - 2013.
+
+One exception is the code for the `update.how` and `update.Plots` S3
+methods in files
+
+PKG_BASE/R/update.how.R
+PKG_BASE/R/update.Plots.R
+
+These functions are based upon code from the `update.default` method of
+base R. These are Copyright (C) 1995-2012 The R Core Team. These codes
+are released under the GPL version 2 or, at your discretion, any later
+version.
+
+The full copyright and licence statements for these codes are retained
+in the header of the respective .R files listed above.
\ No newline at end of file
diff --git a/inst/ChangeLog b/inst/ChangeLog
index 07b1645..00111f1 100644
--- a/inst/ChangeLog
+++ b/inst/ChangeLog
@@ -1,7 +1,276 @@
-$Date: 2012-04-04 21:14:12 +0100 (Wed, 04 Apr 2012) $
+$Date: 2013-11-30 17:32:45 -0600 (Sat, 30 Nov 2013) $
permute ChangeLog
+Version 0.8-0
+
+ * Released to CRAN
+
+ * DESCRIPTION: now uses `Authors at R` to populate `Author` and
+ `Maintainer` fields. Finer grained recognition of contributors and
+ R Core Team's copyright.
+
+ * NEWS: added a `NEWS.Rd` file to document high-level changes to
+ permute. Detailed changes remain in `ChangeLog`, whilst `NEWS.Rd`
+ will summarise the main user-level changes to the package.
+
+ * allPerms: fix a bug where the blocks of permutations were being
+ recombined in the wrong way, by rows instead of by columns.
+
+ * numPerms: was ignoring the `constant` setting if free permutations
+ within level of plots.
+
+Version 0.7-8
+
+ * how, Plots: enforces that `blocks` and `strata` are factors, or
+ can be coerced to a factor via `as.factor()`, if specified.
+
+ * check: gains a new argument `quietly = FALSE` to suppress messages
+ about updates to the permutation design when they are not needed.
+
+ * allPerms: no longer allows messages about generating set of
+ permutations to be generated by `check()`. It calls `check()` now
+ with `quietly = TRUE` to achieve this.
+
+ * shuffleSet: played about a bit with the way the design is printed
+ if you show the matrix of permutations.
+
+Version 0.7-7
+
+ * shuffleSet: Implemented an idea of Jari's to allow `check()` and
+ `allPerms()` to do their thing and possibly generate the set of all
+ permutations, rather than turn off checking. If that now results in
+ more than `nset` permutations, `shuffleSet` randomly takes `nset` of
+ these. This is a nice suggestion as it avoids the problem that with
+ small numbers of possible permutations, you can randomly draw the
+ same permutation more than once.
+
+ As I have added this feature, I reverted some earlier changes to the
+ documentation that used the `check = FALSE` in their call to
+ `shuffleSet()`. The `check` argument is retained though, as a way for
+ function writers to skip that part of the permute workflow if desired.
+
+ The permutation matrix returned is now of class `"permutationMatrix"`.
+ This class has `as.matrix()` and `print()` S3 methods.
+
+ * allPerms: gains an argument `check`, which defaults to `TRUE`. This
+ is used to turn off checking within `allPerms` if desired. A use-case
+ for this is in `check()`, which might end up caling `allPerms()` to
+ generate the set of all permutations. In that case `allPerms()` used
+ to recheck the design. Now this doesn't happen.
+
+ `allPerms` also uses the new `set<-` replacement functions rather than
+ `update()` as the latter causes problems when used within functions as
+ it often evaluates the stored call in the wrong environment.
+
+ * check: following the change to `allPerms` (see above), `check()` no
+ longer results in it calling itself, via `allPerms()`, when generating
+ the set of possible permutations if the check heuristics indicate it
+ should be.
+
+ Turned on some `message()`s when the user asks for too many permutations
+ (more than the set of possible permutations) and when the set of
+ possible permutations is smaller than the `minperm` value stored in the
+ `"how"` object. The latter notifies the user that the entire set of
+ permutations is being generated. These messages were updated to reduce
+ their length.
+
+ `check` also uses the new `set<-` replacement functions rather than
+ `update()` as the latter causes problems when used within functions as
+ it often evaluates the stored call in the wrong environment.
+
+ * Plots, Within: now return a object of class `"Plots"` or `"Within"`,
+ respectively.
+
+ * get-methods: added a number of a new methods for existing functions
+ to work with `"Within"` and `"Plots"` classes.
+
+ * set-methods: added a number of a new functions and methods with the
+ common name `setFoo<-.Bar` where `Foo` is the component to be updated,
+ and `Bar` is the class. These are replacement functions only. They are
+ intended to be used within functions, where the user-friendly `update()`
+ will have problems getting the call updated correctly ot evaluating it.
+
+ * how, Plots, Within: Now work much harder to preserve details of the
+ design (i.e. the names of objects passed for the blocks or plot strata),
+ and also process the matched call so that the user can `update()` it.
+
+ * fixupCall: a new, unexported function that allows the call objects
+ stored in a `"how"` object to be updated. This is not exported as it is
+ intended only for internal use. Function writers should use the
+ `setFoo<-` functions instead. Ordinary users should use `update()` as
+ long as it is not in a function.
+
+ * update: new methods for objects of classes `"how"` and `"Plots".
+ Thes are copies of the standard R function `update.default` with some
+ changes. The source files for these two functions preserver the R
+ copyright statement and document modifications made by Gavin L.
+ Simpson.
+
+ * Depends: permute requires a version of R no earlier than version
+ 2.14.0.
+
+Version 0.7-6
+
+ * summary.allPerms: Was printing two slightly different subtitles.
+
+ * More unit tests...
+
+Version 0.7-5
+
+ * how: the matched call is now returned permitting the use of
+ `update()` to update elements of a stored permutation design object.
+ Suggested by Jari Oksanen.
+
+ `how` also gains an argument `make` which is the user-level way
+ to control whether all possible permutations are actually
+ created should the heuristics in `check()` decide they should be.
+
+ The `print` method for class "how" wasn't printing details of
+ mirroring or constant settings for within-plot components.
+
+ * shuffleSet: was incorrectly recombining individual block-level
+ permutations.
+ Reported by Jari Oksanen.
+
+ Gains an argument, `check`, which allows the user to control whether
+ the permutation design should be checked. In small data sets or where
+ there are very few permutations, `shuffleSet` could generate more
+ permutations (i.e. all possible ones) than requested. Turning off this
+ checking with `check = FALSE` will result in exactly `nset`
+ permutations being returned, but without a gaurantee that they will
+ be unique.
+
+ * numPerms: fixed a bug where `numPerms()` was ignoring Blocks when
+ computing the number of possible permutations.
+
+ * Within, Plots: as with `how()`, the matched call is now returned
+ as part of the list object, allowing desirable `update()` behaviour.
+
+ * allPerms, doAllPerms: now correctly work in presence of blocks,
+ and where there are no plots.
+
+ `allPerms` now includes the permutation design (its `control`
+ argument) as an attribute, `"control"`, on the returned matrix of
+ permutations.
+
+ `allPerms` loses arguments `max` and `observed` as these are
+ supposed to be in the control object created by `how()`.
+
+ `summary.allPerms` (its `print` method, more correctly) now prints
+ the permutation design alongside the set of permutations.
+
+ * get-methods: new extractor functions `getObserved()` and
+ `getMake()` return the `observed` and `make` components of object
+ created by `how()`.
+
+ * getComplete: This now only returns the `complete` component of
+ the `"how"` object. Use `getMinperm()` to extract the component
+ no-longer returned by `getComplete()`.
+
+ * check: function loses arguments `make.all` and `observed` as
+ these are in the control object returned by `how()`.
+
+ The logic of some of the checks has been tweaked slightly.
+
+ * Documentation fixes in examples of `allPerms` and `check`.
+
+ * permuplot: This is horribly broken and I'm not sure if it will
+ ever return. In the meantime, this function now prints a warning
+ message if used and returns nothing, invisibly.
+
+ The function is no longer exported from the package namespace, and
+ not documented.
+
+ I'm not convinced that the plot can adequately convery the breadth of
+ designs now possible. Hence I am minded to deprecate this in 0.8-0
+ when released to CRAN and to make it defunct some thereafter.
+
+Version 0.7-4
+
+ * Deprecated functions: Completed the deprecation of `permCheck()`
+ and `permControl()`. These functions will be made defunct following
+ the release of version 0.8-0, with a view to complete removal from
+ version 0.9-0 onwards.
+
+Version 0.7-3
+
+ * Tweak to 0.7-2 API changes: argument `blocks` no longer takes
+ a list from helper function `Blocks()`. It is easier and simpler
+ if this just takes a factor. In essence, `blocks` in synonymous
+ with `strata` from `vegan::permuted.index` and the new change will
+ allow for an easier transition.
+
+ * get-methods: New extractor functions `getMirror()`, and
+ `getConstant()` which retrieve the mirroring and constant elements
+ of a permutation design.
+
+ Also added `getRow()`, `getCol()` and `getDim()`, which extract
+ the row and column dimensions of a grid permutation design, or
+ both.
+
+ In addition, new methods `getNperm()` and `getMaxperm()` return
+ the number of permutations requested and the maximum nuber that
+ should be allowed, respectively. New method `getComplete` extracts
+ details of the complete enumeration features of permute.
+
+ * numPerms: updated to work with the new API and now handles
+ blocking. Exmaples now pass checks again.
+
+ * allPerms: updated to the new API.
+
+ * check: updated to the new API.
+
+ * how: new function, a copy of `permControl()` and will eventually
+ replace that function. Has a new `print` method.
+
+ Begun process of *deprecating* `permControl()` and its `print`
+ method.
+
+ * permControl, how: the `strata.name` component of the returned
+ object is no called `blocks.name`.
+
+ * Plots: now returns the object name supplied as argument `strata`
+ as component `plots.name`.
+
+ * TODO: started a TODO list of things I know are broken or needed.
+
+Version 0.7-2
+
+ * Major API change: Added capability to handle true blocking
+ constraints.
+ Suggested by Cajo ter Braak.
+
+ We now have:
+
+ o Blocks: samples are *never* permuted between blocks. Blocks
+ can't be permuted either.
+ o Plots: these define groups of samples, for example the
+ whole plots in a split-plot design, or repeated measures
+ on a set of sites. The sites are the "plots". Plots can
+ be permuted using any of the restricted schemes offered
+ in permute.
+ o Within: these are the samples, the rows in the data set.
+ They can be nested in Plots and/or in Blocks.
+
+ This capability has made it into permControl(), shuffle() and
+ shuffleSet(), though the latter certainly has one major bug
+ in the case where there is more than one Block.
+
+ Most other functionality is broken as the above change has
+ altered the permControl object in a way that is not backwards
+ compatible.
+
+ Note that the 0.7.x branch is a development branch and should
+ not be used in ernest until I work through all the implications
+ of this change. Rest assured, I won't be doing this again!
+
+Version 0.7-1
+
+ * allPerms: implement Doug Bates version which simplifies and
+ speeds up the code. A fast RcppEigen-based version also exists
+ but will need larger changes to the package to implement.
+
Version 0.7-0
* Vignette: silly typo is example code illustrating shuffle().
@@ -18,7 +287,8 @@ Version 0.7-0
if `mirror = FALSE` for the `constant = TRUE` case.
* shuffleStrata: assumed that the samples were in contiguous
- blocks. Reported by Cajo ter Braak.
+ blocks.
+ Reported by Cajo ter Braak.
* .Internal: removed all instances of .Internal calls in the
code.
diff --git a/inst/NEWS.Rd b/inst/NEWS.Rd
new file mode 100644
index 0000000..4183d6a
--- /dev/null
+++ b/inst/NEWS.Rd
@@ -0,0 +1,86 @@
+\name{NEWS}
+\title{permute News}
+\encoding{UTF-8}
+
+\section{Changes in version 0.8-0}{
+
+ \subsection{GENERAL}{
+
+ \itemize{
+ \item Version 0.8-0 represents a major update of \pkg{permute},
+ with some backwards-incompatible changes to the main
+ functions. The main addition is the availability of block-level
+ restrictions on the permutations, which are required for whole- and
+ split-plot designs.
+ }
+
+ } % general
+
+ \subsection{NEW FEATURES}{
+
+ \itemize{
+ \item \code{how()}, a new function to create permutation
+ designs. This replaces the deprecated function \code{permControl}.
+
+ \item \pkg{permute} gains the addition of true blocking structures
+ with which to restrict the permutations. Blocks sit as the
+ outermost layer of the permutations, and can contain plots which
+ in turn contain samples. In contrasts to plots, blocks are never
+ permuted and samples are never shuffled between
+ blocks. Permutation only ever happens within blocks.
+
+ To facilitate this, plot-level strata are now specified via
+ \code{Plots()} instead of via the old strata argument of
+ \code{how()}. Blocks are specified via a new argument \code{blocks},
+ which takes a factor variable.
+
+ \item A new suite of extractor and replacement functions is
+ provided with which to interact with permutation designs created
+ by \code{how()}. Extractor functions have names \code{getFoo()},
+ where \code{Foo()} is a component of the design. Replacement
+ functions have names \code{setFoo}. The replacement function are
+ especially for use by package authors wishing to alter permutation
+ within their functions. The extractor functions are recommened for
+ all users wishing to extract features of the permutation design.
+
+ \item As a convenience for users, the \code{update()} function
+ will now work with objects of classes \code{"how"}, \code{"Plots"}
+ or \code{"Within"} to allow quick updating of features of the
+ permutation design. This approach is intended for interactive use
+ at the top-level and not within functions, where the new
+ \code{setFoo} replacement functions should be used.
+
+ \item \code{shuffleSet()} is enhanced in this version. Firstly, the
+ function now returns a classed object which has a \code{print()}
+ method to allow for compact printing of the design elements used
+ to generate the set of permutations. Second, \code{shuffleSet()}
+ will sample \code{nset} permutations from the entire set of
+ permutations should a small number of possible permutations
+ trigger generation of the entire set. This avoids the generation
+ of a set of non-unique permutations. Finally the random seed that
+ generated the set is stored as an attribute.
+
+ \item \code{allPerms()} no longer assumes that samples are in
+ block and/or plot ordering.
+
+ \item The package vignette is much expanded in this version with
+ new sections on using \pkg{permute} within functions that will be
+ of interest to package authors wishing to use \pkg{permute} in
+ their packages.
+ }
+
+ } % new features
+
+ \subsection{DEPRECATED}{
+
+ \itemize{
+ \item \code{permControl} is deprecated in favour of \code{how}.
+
+ \item \code{permuplot} is broken and effectively defunct given the
+ changes to the way permutation are defined and the addition of
+ blocks. \code{permuplot} is no longer expoerted from the package
+ namespace.
+ }
+
+ } % deprecated
+}
\ No newline at end of file
diff --git a/inst/TODO.md b/inst/TODO.md
new file mode 100644
index 0000000..cbb5703
--- /dev/null
+++ b/inst/TODO.md
@@ -0,0 +1,84 @@
+# TODO List
+
+A TODO list for **permute** - or things I know are broken or needed.
+
+ * `summary.allPerms` - is not printing the permutation scheme.
+ *Done in 0.7-5*
+
+ * `print.permControl` - this needs to be updated to new API, and I don't
+ like the `*** Foo ***` headings I used before. *Done in 0.7-3*
+
+ * Need a way to update the permutation scheme, e.g. when a control
+ object already exists and want to tweak it. Example is in `?allPerms`
+ where I turn mirroring on via
+
+ ctrl$within$mirror <- TRUE
+
+ But how? Best idea currently is an `update.permControl` method. The
+ generic is in namespace `stats`. Or a `modify()` function, perhaps
+ coupled with specific replacement functions for certain components.
+
+ *DONE, in part, in 0.7-5* The matched call is now returned by `how()`
+ and this allows `update()` to do its work with no further effort from
+ me. What isn't so neat is that currently this means you need to type
+ out in full any specification of `within` and `plots` as these take
+ the results of function calls. Hence we have, from `./man/how.Rd`
+
+ plts <- gl(4,10)
+ blks <- gl(2,20)
+ h1 <- how(within = Within(type = "series", mirror = TRUE),
+ plots = Plots(strata = plts, type = "series"),
+ blocks = blks)
+
+ ## The design can be updated...
+ ## ... remove the blocking:
+ update(h1, blocks = NULL)
+ ## ... or switch the type of shuffling at a level:
+ update(h1, plots = Plots(strata = plts, type = "none"))
+
+ Where in the second `update()` the entire `Plots()` call needs to
+ repeated to change just one part, the `type`.
+
+ This has been tweaked a bit. The second example can now be done via:
+
+ update(h1, plots = update(getPlots(h1), type = "none"))
+
+ Here `getPlots(h1)` returns the `plots` component, which too has
+ a `call` component and hence can be `update()`ed, hence the nested
+ calls to `update()`.
+
+ * `permControl` - deprecate this in favour of `how` as in "how to
+ permute"? *DONE Completed in 0.7-4*
+
+ * `permuplot` - this may be fundamentally bust - it only worked in the
+ original API and never got updated. Now the API is 2 versions further
+ on! It is also more complex than the original - not sure it'll be
+ easy without a lot of work to visualise all possible schemes.
+
+ * `check` insists on returning all permutations *without* the observed
+ one.
+
+ *DONE Completed somewhere, probably when I made observed only work via
+ how()*
+
+ * The following example from `shuffleSet()` gives same number of
+ permutations via `numPerms()` for both designs; should be fewer if
+ same permutation within each plot.
+
+ ## 10 random permutations in presence of Plot-level strata
+ plotStrata <- Plots(strata = gl(4,5))
+ CTRL <- how(plots = plotStrata,
+ within = Within(type = "free"))
+ shuffleSet(20, 10, control = CTRL)
+ ## as above but same random permutation within Plot-level strata
+ CTRL <- how(plots = plotStrata,
+ within = Within(type = "free", constant = TRUE))
+ shuffleSet(20, 10, CTRL)
+
+ *DONE in 0.8-0*
+
+ * Write an Rd page for the `"permutationMatrix"` S3 class where I can
+ describe the object returned by `shuffleSet()` and the methods
+ available for it.
+
+ *DONE in 0.7-8*
\ No newline at end of file
diff --git a/inst/doc/permutations.R b/inst/doc/permutations.R
new file mode 100644
index 0000000..d0b4b2d
--- /dev/null
+++ b/inst/doc/permutations.R
@@ -0,0 +1,348 @@
+### R code from vignette source 'permutations.Rnw'
+
+###################################################
+### code chunk number 1: preliminary
+###################################################
+options("prompt" = "R> ", "continue" = "+ ")
+options(useFancyQuotes="UTF-8")
+
+
+###################################################
+### code chunk number 2: load_jackal
+###################################################
+require(permute)
+data(jackal)
+jackal
+
+
+###################################################
+### code chunk number 3: ttest_jackal
+###################################################
+jack.t <- t.test(Length ~ Sex, data = jackal, var.equal = TRUE,
+ alternative = "greater")
+jack.t
+
+
+###################################################
+### code chunk number 4: ftest_jackal
+###################################################
+var.test(Length ~ Sex, data = jackal)
+fligner.test(Length ~ Sex, data = jackal)
+
+
+###################################################
+### code chunk number 5: meanFun
+###################################################
+meanDif <- function(x, grp) {
+ mean(x[grp == "Male"]) - mean(x[grp == "Female"])
+}
+
+
+###################################################
+### code chunk number 6: randJackal
+###################################################
+Djackal <- numeric(length = 5000)
+N <- nrow(jackal)
+set.seed(42)
+for(i in seq_len(length(Djackal) - 1)) {
+ perm <- shuffle(N)
+ Djackal[i] <- with(jackal, meanDif(Length, Sex[perm]))
+}
+Djackal[5000] <- with(jackal, meanDif(Length, Sex))
+
+
+###################################################
+### code chunk number 7: hist_jackal (eval = FALSE)
+###################################################
+## hist(Djackal, main = "",
+## xlab = expression("Mean difference (Male - Female) in mm"))
+## rug(Djackal[5000], col = "red", lwd = 2)
+
+
+###################################################
+### code chunk number 8: permutations.Rnw:125-126
+###################################################
+(Dbig <- sum(Djackal >= Djackal[5000]))
+
+
+###################################################
+### code chunk number 9: permutations.Rnw:129-130
+###################################################
+Dbig / length(Djackal)
+
+
+###################################################
+### code chunk number 10: draw_hist_jackal
+###################################################
+hist(Djackal, main = "",
+ xlab = expression("Mean difference (Male - Female) in mm"))
+rug(Djackal[5000], col = "red", lwd = 2)
+
+
+###################################################
+### code chunk number 11: permutations.Rnw:142-143
+###################################################
+choose(20, 10)
+
+
+###################################################
+### code chunk number 12: show_args
+###################################################
+args(shuffle)
+
+
+###################################################
+### code chunk number 13: show_str
+###################################################
+str(how())
+
+
+###################################################
+### code chunk number 14: compare_shuffle_sample
+###################################################
+set.seed(2)
+(r1 <- shuffle(10))
+set.seed(2)
+(r2 <- sample(1:10, 10, replace = FALSE))
+all.equal(r1, r2)
+
+
+###################################################
+### code chunk number 15: series1
+###################################################
+set.seed(4)
+x <- 1:10
+CTRL <- how(within = Within(type = "series"))
+perm <- shuffle(10, control = CTRL)
+perm
+x[perm] ## equivalent
+
+
+###################################################
+### code chunk number 16: grid1
+###################################################
+set.seed(4)
+plt <- gl(3, 9)
+CTRL <- how(within = Within(type = "grid", ncol = 3, nrow = 3),
+ plots = Plots(strata = plt))
+perm <- shuffle(length(plt), control = CTRL)
+perm
+
+
+###################################################
+### code chunk number 17: vis_grid1
+###################################################
+## Original
+lapply(split(seq_along(plt), plt), matrix, ncol = 3)
+## Shuffled
+lapply(split(perm, plt), matrix, ncol = 3)
+
+
+###################################################
+### code chunk number 18: grid_2
+###################################################
+set.seed(4)
+CTRL <- how(within = Within(type = "grid", ncol = 3, nrow = 3,
+ constant = TRUE),
+ plots = Plots(strata = plt))
+perm2 <- shuffle(length(plt), control = CTRL)
+lapply(split(perm2, plt), matrix, ncol = 3)
+
+
+###################################################
+### code chunk number 19: series_2
+###################################################
+how(nperm = 10, within = Within(type = "series"))
+
+
+###################################################
+### code chunk number 20: shuffleSet_1
+###################################################
+set.seed(4)
+CTRL <- how(within = Within(type = "series"))
+pset <- shuffleSet(10, nset = 5, control = CTRL)
+pset
+
+
+###################################################
+### code chunk number 21: permutations.Rnw:256-257
+###################################################
+how(nperm = 999)
+
+
+###################################################
+### code chunk number 22: withinArgs
+###################################################
+args(Within)
+
+
+###################################################
+### code chunk number 23: change-continuation
+###################################################
+options("prompt" = " ", "continue" = " ")
+
+
+###################################################
+### code chunk number 24: ptest-fun
+###################################################
+pt.test <- function(x, group, nperm = 199) {
+ ## mean difference function
+ meanDif <- function(i, x, grp) {
+ grp <- grp[i]
+ mean(x[grp == "Male"]) - mean(x[grp == "Female"])
+ }
+ ## check x and group are of same length
+ stopifnot(all.equal(length(x), length(group)))
+ ## number of observations
+ N <- nobs(x)
+ ## generate the required set of permutations
+ pset <- shuffleSet(N, nset = nperm)
+ ## iterate over the set of permutations applying meanDif
+ D <- apply(pset, 1, meanDif, x = x, grp = group)
+ ## add on the observed mean difference
+ D <- c(meanDif(seq_len(N), x, group), D)
+ ## compute & return the p-value
+ Ds <- sum(D >= D[1]) # how many >= to the observed diff?
+ Ds / (nperm + 1) # what proportion of perms is this (the pval)?
+}
+
+
+###################################################
+### code chunk number 25: reset-continuation
+###################################################
+options("prompt" = "R> ", "continue" = "+ ")
+
+
+###################################################
+### code chunk number 26: run-ptest
+###################################################
+set.seed(42) ## same seed as earlier
+pval <- with(jackal, pt.test(Length, Sex, nperm = 4999))
+pval
+
+
+###################################################
+### code chunk number 27: change-continuation
+###################################################
+options("prompt" = " ", "continue" = " ")
+
+
+###################################################
+### code chunk number 28: parallel-ptest-fun
+###################################################
+ppt.test <- function(x, group, nperm = 199, cores = 2) {
+ ## mean difference function
+ meanDif <- function(i, .x, .grp) {
+ .grp <- .grp[i]
+ mean(.x[.grp == "Male"]) - mean(.x[.grp == "Female"])
+ }
+ ## check x and group are of same length
+ stopifnot(all.equal(length(x), length(group)))
+ ## number of observations
+ N <- nobs(x)
+ ## generate the required set of permutations
+ pset <- shuffleSet(N, nset = nperm)
+ if (cores > 1) {
+ ## initiate a cluster
+ cl <- makeCluster(cores)
+ on.exit(stopCluster(cl = cl))
+ ## iterate over the set of permutations applying meanDif
+ D <- parRapply(cl, pset, meanDif, .x = x, .grp = group)
+ } else {
+ D <- apply(pset, 1, meanDif, .x = x, .grp = group)
+ }
+ ## add on the observed mean difference
+ D <- c(meanDif(seq_len(N), x, group), D)
+ ## compute & return the p-value
+ Ds <- sum(D >= D[1]) # how many >= to the observed diff?
+ Ds / (nperm + 1) # what proportion of perms is this (the pval)?
+}
+
+
+###################################################
+### code chunk number 29: reset-continuation
+###################################################
+options("prompt" = "R> ", "continue" = "+ ")
+
+
+###################################################
+### code chunk number 30: run-pptest
+###################################################
+require("parallel")
+set.seed(42)
+system.time(ppval <- ppt.test(jackal$Length, jackal$Sex, nperm = 9999,
+ cores = 2))
+ppval
+
+
+###################################################
+### code chunk number 31: run-pptest2
+###################################################
+set.seed(42)
+system.time(ppval2 <- ppt.test(jackal$Length, jackal$Sex, nperm = 9999,
+ cores = 1))
+ppval2
+
+
+###################################################
+### code chunk number 32: get-set-eg0
+###################################################
+hh <- how()
+
+
+###################################################
+### code chunk number 33: get-set-eg1
+###################################################
+getNperm(hh)
+
+
+###################################################
+### code chunk number 34: <get-set-eg2
+###################################################
+getCall(hh)
+setNperm(hh) <- 999
+getNperm(hh)
+getCall(hh)
+
+
+###################################################
+### code chunk number 35: get-set-eg3
+###################################################
+hh <- how(within = Within(type = "series"),
+ plots = Plots(type = "series", strata = gl(10, 5)),
+ blocks = gl(5, 10))
+
+
+###################################################
+### code chunk number 36: get-set-eg4
+###################################################
+pl <- getPlots(hh)
+setType(pl) <- "free"
+setPlots(hh) <- pl
+
+
+###################################################
+### code chunk number 37: get-set-eg5
+###################################################
+getType(hh, which = "plots")
+
+
+###################################################
+### code chunk number 38: get-set-eg6
+###################################################
+getCall(getPlots(hh))
+
+
+###################################################
+### code chunk number 39: get-set-eg7
+###################################################
+hh <- update(hh, plots = update(getPlots(hh), type = "series"))
+getType(hh, which = "plots")
+
+
+###################################################
+### code chunk number 40: seesionInfo
+###################################################
+toLatex(sessionInfo(), locale = FALSE)
+
+
diff --git a/inst/doc/permutations.Rnw b/inst/doc/permutations.Rnw
index 4c5cc64..8a762df 100644
--- a/inst/doc/permutations.Rnw
+++ b/inst/doc/permutations.Rnw
@@ -9,13 +9,13 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% almost as usual
-\author{Gavin L. Simpson\\Environmental Change Research Centre --- UCL}
-\title{Restricted permutations; using the \pkg{permute} Package}
+\author{Gavin L. Simpson\\University of Regina}
+\title{Restricted permutations; using the \pkg{permute} package}
%% for pretty printing and a nice hypersummary also set:
\Plainauthor{Gavin L. Simpson} %% comma-separated
-\Plaintitle{Using the permute Package} %% without formatting
-\Shorttitle{Using the permuet Package} %% a short title (if necessary)
+\Plaintitle{Restricted permutations; using the permute package} %% without formatting
+\Shorttitle{Using the permute package} %% a short title (if necessary)
%% an abstract and keywords
\Abstract{
@@ -51,18 +51,18 @@
%% include your article here, just as usual
%% Note that you should use the \pkg{}, \proglang{} and \code{} commands.
<<preliminary,results=hide,echo=false>>=
-options("prompt" = "R> ", "continue" = "+ ")
+options("prompt" = "R> ", "continue" = "+ ")
options(useFancyQuotes="UTF-8")
@
\section{Introduction}
In classical frequentist statistics, the significance of a relationship or model is determined by reference to a null distribution for the test statistic. This distribution is derived mathematically and the probability of achieving a test statistic as large or larger if the null hypothesis were true is looked-up from this null distribution. In deriving this probability, some assumptions about the data or the errors are made. If these assumptions are violated, then the validity of the der [...]
-An alternative to deriving the null distribution from theory is to generate a null distribution for the test statistic by randomly shuffling the data in some manner, refitting the model and deriving values for the test statistic for the permuted data. The level of significance of the test can be computed as the proportion of values of the test statistic from the null distribution that are equal to or larger than the observed value.
+An alternative to deriving the null distribution from theory is to generate a null distribution of the test statistic by randomly shuffling the data in some manner, refitting the model and deriving values for the test statistic for the permuted data. The level of significance of the test can be computed as the proportion of values of the test statistic from the null distribution that are equal to or larger than the observed value.
-In many data sets, simply shuffling the data at random is inappropriate; under the null hypothesis, that data are not freely exchangeable. If there is temporal or spatial correlation, or the samples are clustered in some way, such as multiple samples collected from each of a number of fields. The \pkg{permute} was designed to provide facilities for generating these restricted permutations for use in randomisation tests.
+In many data sets, simply shuffling the data at random is inappropriate; under the null hypothesis, that data are not freely exchangeable, for example if there is temporal or spatial correlation, or the samples are clustered in some way, such as multiple samples collected from each of a number of fields. The \pkg{permute} package was designed to provide facilities for generating these restricted permutations for use in randomisation tests. \pkg{permute} takes as its motivation the permut [...]
-\section{Simple randomisation}
-As an illustration of both randomisation and the use of the \pkg{permute} package we consider a small data set of mandible length measurements on specimens of the golden jackal (\emph{Canis aureus}) from the British Museum of Natural History, London, UK. These data were collected as part of a study comparing prehistoric and modern canids \citep{higham80}, and were analysed by \citet{manly07}. There are ten measurements of mandible length on both male and female specimens. The data are av [...]
+\section{Simple randomisation}\label{sec:simple}
+As an illustration of both randomisation and simple usage of the \pkg{permute} package we consider a small data set of mandible length measurements on specimens of the golden jackal (\emph{Canis aureus}) from the British Museum of Natural History, London, UK. These data were collected as part of a study comparing prehistoric and modern canids \citep{higham80}, and were analysed by \citet{manly07}. There are ten measurements of mandible length on both male and female specimens. The data a [...]
<<load_jackal>>=
require(permute)
@@ -70,10 +70,11 @@ data(jackal)
jackal
@
-The interest is whether there is a difference in the mean mandible length between male and female golden jackals. The null hypothesis is that there is zero difference in mandible length between the two sexes or that females have larger mandible. The alternative hypothesis is that males have larger mandibles. The usual statistical test of this hypothesis is a one-sided $t$ test, which can be applied using \code{t.test()}
+The interest is whether there is a difference in the mean mandible length between male and female golden jackals. The null hypothesis is that there is zero difference in mandible length between the two sexes or that females have larger mandibles. The alternative hypothesis is that males have larger mandibles. The usual statistical test of this hypothesis is a one-sided $t$ test, which can be applied using \code{t.test()}
-<<ttest_jackal>>=
-jack.t <-t.test(Length ~ Sex, data = jackal, var.equal = TRUE, alternative = "greater")
+<<ttest_jackal, keep.source=true>>=
+jack.t <- t.test(Length ~ Sex, data = jackal, var.equal = TRUE,
+ alternative = "greater")
jack.t
@
@@ -90,7 +91,7 @@ Assumption 1 is unlikely to be valid for museum specimens such as these, that ha
var.test(Length ~ Sex, data = jackal)
fligner.test(Length ~ Sex, data = jackal)
@
-This assumption may be relaxed using \code{var.equal = FALSE} (the default) in our call to \code{t.test()}, to employ Welch's modification for unequal variances. Assumption 3 may be valid, but with such a small sample we are able to reliably test this.
+This assumption may be relaxed using \code{var.equal = FALSE} (the default) in the call to \code{t.test()}, to employ Welch's modification for unequal variances. Assumption 3 may be valid, but with such a small sample we are unable to reliably test this.
A randomisation test of the same hypothesis can be performed by randomly allocating ten of the mandible lengths to the male group and the remaining lengths to the female group. This randomisation is justified under the null hypothesis because the observed difference in mean mandible length between the two sexes is just a typical value for the difference in a sample if there were no difference in the population. An appropriate test statistic needs to be selected. We could use the $t$ stat [...]
@@ -100,7 +101,7 @@ meanDif <- function(x, grp) {
mean(x[grp == "Male"]) - mean(x[grp == "Female"])
}
@
-which can be used in a simple \code{for()} loop to generate the null distribution for the difference of means. First, we allocate some storage to hold the null difference of means; here we use 4999 random permutations so allocate a vector of length 5000. Then we iterate, randomly generating an ordering of the \code{Sex} vector and computing the difference means for that permutation.
+which can be used in a simple \code{for()} loop to generate the null distribution for the difference of means. First, we allocate some storage to hold the null difference of means; here we use 4999 random permutations so allocate a vector of length 5000. Then we iterate, randomly generating an ordering of the \code{Sex} vector and computing the difference of means for that permutation.
<<randJackal>>=
Djackal <- numeric(length = 5000)
N <- nrow(jackal)
@@ -128,7 +129,7 @@ giving a permutational $p$-value of
<<>>=
Dbig / length(Djackal)
@
-which is comparable with that determined from the frequentist $t$-test, and indicate strong evidence against the null hypothesis of no difference.
+which is comparable with that determined from the frequentist $t$-test, and indicates strong evidence against the null hypothesis of no difference.
\begin{figure}[t]
\centering
<<draw_hist_jackal, fig=true, echo=false>>=
@@ -149,15 +150,15 @@ The main workhorse function we used above was \code{shuffle()}. In this example,
In the previous section I introduced the \code{shuffle()} function to generate permutation indices for use in a randomisation test. Now we will take a closer look at \code{shuffle()} and explore the various restricted permutation designs from which it can generate permutation indices.
\code{shuffle()} has two arguments: i) \code{n}, the number of observations in the data set to be permuted, and ii) \code{control}, a list that defines the permutation design describing how the samples should be permuted.
-<<>>=
+<<show_args>>=
args(shuffle)
@
-A series of convenience functions are provided that allow the user to set-up even quite complex permutation designs with little effort. The user only needs to specify the aspects of the design they require and the convenience functions ensure all configuration choices are set and passed on to \code{shuffle()}. The main convenience function is \code{permControl()}, which return a list specifying all the options available for controlling the sorts of permutations returned by \code{shuffle()}
-<<>>=
-str(permControl())
+A series of convenience functions are provided that allow the user to set-up even quite complex permutation designs with little effort. The user only needs to specify the aspects of the design they require and the convenience functions ensure all configuration choices are set and passed on to \code{shuffle()}. The main convenience function is \code{how()}, which returns a list specifying all the options available for controlling the sorts of permutations returned by \code{shuffle()}.
+<<show_str>>=
+str(how())
@
The defaults describe a random permutation design where all objects are freely exchangeable. Using these defaults, \code{shuffle(10)} amounts to \code{sample(1:10, 10, replace = FALSE)}:
-<<>>=
+<<compare_shuffle_sample>>=
set.seed(2)
(r1 <- shuffle(10))
set.seed(2)
@@ -172,76 +173,349 @@ Several types of permutation are available in \pkg{permute}:
\item Free permutation of objects
\item Time series or line transect designs, where the temporal or spatial ordering is preserved.
\item Spatial grid designs, where the spatial ordering is preserved in both coordinate directions
- \item Permutation of blocks or groups of samples.
+ \item Permutation of plots or groups of samples.
+ \item Blocking factors which restrict permutations to within blocks. The preceding designs can be nested within blocks.
\end{itemize}
-The first three of these can be nested within the levels of a factor or to the levels of that factor, or to both. Such flexibility allows the analysis of split-plot designs using permutation tests.
+The first three of these can be nested within the levels of a factor or to the levels of that factor, or to both. Such flexibility allows the analysis of split-plot designs using permutation tests, especially when combined with blocks.
-\code{permControl()} is used to set up the design from which \code{shuffle()} will draw a permutation. \code{permControl()} has two main arguments that specify how samples are permuted \emph{within} blocks of samples or at the block level itself. These are \code{within} and \code{blocks}. Two convenience functions, \code{Within()} and \code{Blocks()} can be used to set the various options for permutation.
+\code{how()} is used to set up the design from which \code{shuffle()} will draw a permutation. \code{how()} has two main arguments that specify how samples are permuted \emph{within} plots of samples or at the plot level itself. These are \code{within} and \code{plots}. Two convenience functions, \code{Within()} and \code{Plots()} can be used to set the various options for permutation. Blocks operate at the uppermost level of this hierarchy; blocks define groups of plots, each of which m [...]
For example, to permute the observations \code{1:10} assuming a time series design for the entire set of observations, the following control object would be used
-<<keep.source=true>>=
+<<series1, keep.source=true>>=
set.seed(4)
x <- 1:10
-CTRL <- permControl(within = Within(type = "series"))
+CTRL <- how(within = Within(type = "series"))
perm <- shuffle(10, control = CTRL)
perm
x[perm] ## equivalent
@
-It is assumed that the observations are in temporal or transect order. We only specified the type of permutation within blocks, the remaining options were set to their defaults via \code{Within()}.
+It is assumed that the observations are in temporal or transect order. We only specified the type of permutation within plots, the remaining options were set to their defaults via \code{Within()}.
-A more complex design, with three blocks, and a 3 by 3 spatial grid arrangement within each block can be created as follows
+A more complex design, with three plots, and a 3 by 3 spatial grid arrangement within each plot can be created as follows
-<<keep.source=true>>=
+<<grid1, keep.source=true>>=
set.seed(4)
-block <- gl(3, 9)
-CTRL <- permControl(strata = block,
- within = Within(type = "grid", ncol = 3, nrow = 3))
-perm <- shuffle(length(block), control = CTRL)
+plt <- gl(3, 9)
+CTRL <- how(within = Within(type = "grid", ncol = 3, nrow = 3),
+ plots = Plots(strata = plt))
+perm <- shuffle(length(plt), control = CTRL)
perm
@
Visualising the permutation as the 3 matrices may help illustrate how the data have been shuffled
-<<keep.source=true>>=
+<<vis_grid1, keep.source=true>>=
## Original
-lapply(split(1:27, block), matrix, ncol = 3)
+lapply(split(seq_along(plt), plt), matrix, ncol = 3)
## Shuffled
-lapply(split(perm, block), matrix, ncol = 3)
+lapply(split(perm, plt), matrix, ncol = 3)
@
In the first grid, the lower-left corner of the grid was set to row 2 and column 2 of the original, to row 1 and column 2 in the second grid, and to row 3 column 2 in the third grid.
-To have the same permutation within each level of \code{block}, use the \code{constant} argument of the \code{Within()} function, setting it to \code{TRUE}
-<<keep.source=TRUE>>=
+To have the same permutation within each level of \code{plt}, use the \code{constant} argument of the \code{Within()} function, setting it to \code{TRUE}
+<<grid_2, keep.source=TRUE>>=
set.seed(4)
-CTRL <- permControl(strata = block,
- within = Within(type = "grid", ncol = 3, nrow = 3,
- constant = TRUE))
-perm2 <- shuffle(length(block), control = CTRL)
-lapply(split(perm2, block), matrix, ncol = 3)
+CTRL <- how(within = Within(type = "grid", ncol = 3, nrow = 3,
+ constant = TRUE),
+ plots = Plots(strata = plt))
+perm2 <- shuffle(length(plt), control = CTRL)
+lapply(split(perm2, plt), matrix, ncol = 3)
@
\subsection{Generating sets of permutations with shuffleSet()}
There are several reasons why one might wish to generate a set of $n$ permutations instead of repeatedly generating permutations one at a time. Interpreting the permutation design happens each time \code{shuffle()} is called. This is an unnecessary computational burden, especially if you want to perform tests with large numbers of permutations. Furthermore, having the set of permutations available allows for expedited use with other functions, they can be iterated over using \code{for} l [...]
-The \code{shuffleSet()} function allows the generation of sets of permutations from any of the designs available in \pkg{permute}. \code{shuffleSet()} takes an additional argument to that of \code{shuffle()}, \code{nset}, which is the number of permutations required for the set. Internally, \code{shuffle()} and \code{shuffleSet()} are very similar, with the major difference being that \code{shuffleSet()} arranges repeated calls to the workhorse permutation-generating functions with only [...]
+The \code{shuffleSet()} function allows the generation of sets of permutations from any of the designs available in \pkg{permute}. \code{shuffleSet()} takes an additional argument to that of \code{shuffle()}, \code{nset}, which is the number of permutations required for the set. \code{nset} can be missing, in which case the number of permutations in the set is looked for in the object passed to \code{control}; using this, the desired number of permutations can be set at the time the desi [...]
+
+<<series_2, results=hide>>=
+how(nperm = 10, within = Within(type = "series"))
+@
+
+Internally, \code{shuffle()} and \code{shuffleSet()} are very similar, with the major difference being that \code{shuffleSet()} arranges repeated calls to the workhorse permutation-generating functions, only incurring the overhead associated with interpreting the permutation design once. \code{shuffleSet()} returns a matrix where the rows represent different permutations in the set.
As an illustration, consider again the simple time series example from earlier. Here I generate a set of 5 permutations from the design, with the results returned as a matrix
-<<keep.source=true>>=
+<<shuffleSet_1, keep.source=true>>=
set.seed(4)
-CTRL <- permControl(within = Within(type = "series"))
+CTRL <- how(within = Within(type = "series"))
pset <- shuffleSet(10, nset = 5, control = CTRL)
pset
@
+It is worth taking a moment to explain what has happened here, behind the scenes. There are only \Sexpr{numPerms(10, CTRL)} unique orderings (including the observed) in the set of permutations for this design. Such a small set of permutations triggers\footnote{The trigger is via the utility function \code{check()}, which calls another utility function, \code{allPerms()}, to generate the set of permutations for the stated design. The trigger for complete enumeration is set via \code{how() [...]
+
+\section{Defining permutation designs}
+In this section I give examples how various permutation designs can be specified using \code{how()}. It is not the intention to provide exhaustive coverage of all possible designs that can be produced; such a list would be tedious to both write \emph{and} read. Instead, the main features and options will be described through a series of examples. The reader should then be able to put together the various options to create the exact structure required.
+
+\subsection{Set the number of permutations}
+It may be useful to specify the number of permutations required in a permutation test alongside the permutation design. This is done via the \code{nperm} argument, as seen earlier. If nothing else is specified
+<<results=hide>>=
+how(nperm = 999)
+@
+would indicate 999 random permutations where the samples are all freely exchangeable.
+
+One advantage of using \code{nperm} is that \code{shuffleSet()} will use this if the \code{nset} argument is not specified. Additionally, \code{shuffleSet()} will check to see if the desired number of permutations is possible given the data and the requested design. This is done via the function \code{check()}, which is discussed later.
+
+\subsection{The levels of the permutation hierarchy}
+There are three levels at which permutations can be controlled in \pkg{permute}. The highest level of the hierarchy is the \emph{block} level. Blocks are defined by a factor variable. Blocks restrict permutation of samples to within the levels of this factor; samples are never swapped between blocks.
+
+The \emph{plot} level sits below blocks. Plots are defined by a factor and group samples in the same way as blocks. As such, some permutation designs can be initiated using a factor at the plot level or the same factor at the block level. The major difference between blocks and plots is that plots can also be permuted, whereas blocks are never permuted.
+
+The lowest level of a permutation design in the \pkg{permute} hierarchy is known as \emph{within}, and refers to samples nested \emph{within} plots. If there are no plots or blocks, how samples are permuted at the \emph{within} level applies to the entire data set.
+
+\subsubsection{Permuting samples at the lowest level}
+How samples at the \emph{within} level are permuted is configured using the \code{Within()} function. It takes the following arguments
+<<withinArgs, echo=false>>=
+args(Within)
+@
+
+\begin{description}
+ \item[\code{type}]
+ controls how the samples at the lowest level are permuted. The default is to form unrestricted permutations via option \code{"type"}. Options \code{"series"} and \code{"grid"} form restricted permutations via cyclic or toroidal shifts, respectively. The former is useful for samples that are a time series or line-transect, whilst the latter is used for samples on a regular spatial grid. The final option, \code{"none"}, will result in the samples at the lowest level not being permuted [...]
+ \item[\code{constant}]
+ this argument only has an effect when there are plots in the design\footnote{Owing to the current implementation, whilst this option could also be useful when blocks to define groups of samples, it will not have any influence over how permutations are generated. As such, only use blocks for simple blocking structures and use plots if you require greater control of the permutations at the group (i.e. plot) level.}. \code{constant = FALSE}, stipulates that each plot should have the sam [...]
+ \item[\code{mirror}]
+ when \code{type} is \code{"series"} or \code{"grid"}, argument \code{"mirror"} controls whether permutations are taken from the mirror image of the observed ordering in space or time. Consider the sequence \code{1, 2, 3, 4}. The relationship between observations is also preserved if we reverse the original ordering to \code{4, 3, 2, 1} and generate permutations from both these orderings. This is what happens when \code{mirror = TRUE}. For time series, the reversed ordering \code{4, 3 [...]
+ \item[\code{ncol}, \code{nrow}]
+ define the dimensions of the spatial grid.
+\end{description}
+
+How \code{Within()} is used has already been encountered in earlier sections of this vignette; the function is used to supply a value to the \code{within} argument of \code{how()}. You may have noticed that all the arguments of \code{Within()} have default values? This means that the user need only supply a modified value for the arguments they wish to change. Also, arguments that are not relevant for the type of permutation stated are simply ignored; \code{nrow} and \code{ncol}, for exa [...]
+
+\subsubsection{Permuting samples at the Plot level}
+Permutation of samples at the \emph{plot} level is configured via the \code{Plots()} function. As with \code{Within()}, \code{Plots()} is supplied to the \code{plots} argument of \code{how()}. \code{Plots()} takes many of the same arguments as \code{Within()}, the two differences being \code{strata}, a factor variable that describes the grouping of samples at the \emph{plot} level, and the absence of a \code{constant} argument. As the majority of arguments are similar between \code{Withi [...]
+
+\begin{description}
+ \item[\code{strata}]
+ a factor variable. \code{strata} describes the grouping of samples at the \emph{plot} level, where samples from the same \emph{plot} are take the same \emph{level} of the factor.
+\end{description}
+
+When a \emph{plot}-level design is specified, samples are never permuted between \emph{plots}, only within plots if they are permuted at all. Hence, the type of permutation \emph{within} the \emph{plots} is controlled by \code{Within()}. Note also that with \code{Plots()}, the way the individual \emph{plots} are permuted can be from any one of the four basic permutation types; \code{"none"}, \code{"free"}, \code{"series"}, and \code{"grid"}, as described above. To permute the \emph{plots [...]
+
+\subsubsection[Specifying blocks; the top of the permute hierarchy]{Specifying blocks; the top of the \pkg{permute} hierarchy}
+In constrast to the \emph{within} and \emph{plots} levels, the \emph{blocks} level is simple to specify; all that is required is an indicator variable the same length as the data. Usually this is a factor, but \code{how()} will take anything that can be coerced to a factor via \code{as.factor()}.
+
+It is worth repeating what the role of the block-level structure is; blocks simply restrict permutation to \emph{within}, and never between, blocks, and blocks are never permuted. This is reflected in the implementation; the \emph{split}-\emph{apply}-\code{combine} paradigm is used to split on the blocking factor, the plot- and within-level permutation design is applied separately to each block, and finally the sets of permutations for each block are recombined.
+
+\subsection{Examples}
+To do.
+
+\section[Using permute in R functions]{Using \pkg{permute} in \proglang{R} functions}
+\pkg{permute} originally started life as a set of functions contained within the \pkg{vegan} package \citep{vegan} designed to provide a replacement for the \code{permuted.index()} function. From these humble origins, I realised other users and package authors might want to make use of the code I was writing and so Jari oksanen, the maintainer of \pkg{vegan}, and I decided to spin off the code into the \pkg{permute} package. Hence from the very beginning, \pkg{permute} was intended for u [...]
+
+In the previous sections, I described the various user-facing functions that are employed to set up permutation designs and generate permutations from these. Here I will outline how package authors can use functionality in the \pkg{permute} package to implement permutation tests.
+
+In Section~\ref{sec:simple} I showed how a permutation test function could be written using the \code{shuffle()} function and allowing the user to pass into the test function an object created with \code{how()}. As mentioned earlier, it is more efficient to generate a set of permutations via a call to \code{shuffleSet()} than to repeatedly call \code{shuffle()} and large number of times. Another advantage of using \code{shuffleSet()} is that once the set of permutations has been created, [...]
+
+To illustrate how to use \pkg{permute} in \proglang{R} functions, I'll rework the permutation test I used for the \code{jackal} data earlier in Section~\ref{sec:simple}.
+
+<<change-continuation,results=hide,echo=false>>=
+options("prompt" = " ", "continue" = " ")
+@
+<<ptest-fun, keep.source=true>>=
+pt.test <- function(x, group, nperm = 199) {
+ ## mean difference function
+ meanDif <- function(i, x, grp) {
+ grp <- grp[i]
+ mean(x[grp == "Male"]) - mean(x[grp == "Female"])
+ }
+ ## check x and group are of same length
+ stopifnot(all.equal(length(x), length(group)))
+ ## number of observations
+ N <- nobs(x)
+ ## generate the required set of permutations
+ pset <- shuffleSet(N, nset = nperm)
+ ## iterate over the set of permutations applying meanDif
+ D <- apply(pset, 1, meanDif, x = x, grp = group)
+ ## add on the observed mean difference
+ D <- c(meanDif(seq_len(N), x, group), D)
+ ## compute & return the p-value
+ Ds <- sum(D >= D[1]) # how many >= to the observed diff?
+ Ds / (nperm + 1) # what proportion of perms is this (the pval)?
+}
+@
+<<reset-continuation,results=hide,echo=false>>=
+options("prompt" = "R> ", "continue" = "+ ")
+@
+
+The commented function should be reasonably self explanatory. I've altered the in-line version of the \code{meanDif()} function to take a vector of permutation indices \code{i} as the first argument, and internally the \code{grp} vector is permuted according to \code{i}. The other major change is that \code{shuffleSet()} is used to generate a set of permutations, which are then iterated over using \code{apply()}.
+
+In use we see
+<<run-ptest>>=
+set.seed(42) ## same seed as earlier
+pval <- with(jackal, pt.test(Length, Sex, nperm = 4999))
+pval
+@
+which nicely agrees with the test we did earlier by hand.
+
+Iterating over a set of permutation indices also means that adding parallel processing of the permutations requires only trivial changes to the main function code. As an illustration, below I show a parallel version of \code{pt.test()}
+
+<<change-continuation,results=hide,echo=false>>=
+options("prompt" = " ", "continue" = " ")
+@
+<<parallel-ptest-fun, keep.source=true>>=
+ppt.test <- function(x, group, nperm = 199, cores = 2) {
+ ## mean difference function
+ meanDif <- function(i, .x, .grp) {
+ .grp <- .grp[i]
+ mean(.x[.grp == "Male"]) - mean(.x[.grp == "Female"])
+ }
+ ## check x and group are of same length
+ stopifnot(all.equal(length(x), length(group)))
+ ## number of observations
+ N <- nobs(x)
+ ## generate the required set of permutations
+ pset <- shuffleSet(N, nset = nperm)
+ if (cores > 1) {
+ ## initiate a cluster
+ cl <- makeCluster(cores)
+ on.exit(stopCluster(cl = cl))
+ ## iterate over the set of permutations applying meanDif
+ D <- parRapply(cl, pset, meanDif, .x = x, .grp = group)
+ } else {
+ D <- apply(pset, 1, meanDif, .x = x, .grp = group)
+ }
+ ## add on the observed mean difference
+ D <- c(meanDif(seq_len(N), x, group), D)
+ ## compute & return the p-value
+ Ds <- sum(D >= D[1]) # how many >= to the observed diff?
+ Ds / (nperm + 1) # what proportion of perms is this (the pval)?
+}
+@
+<<reset-continuation,results=hide,echo=false>>=
+options("prompt" = "R> ", "continue" = "+ ")
+@
+In use we observe
+<<run-pptest>>=
+require("parallel")
+set.seed(42)
+system.time(ppval <- ppt.test(jackal$Length, jackal$Sex, nperm = 9999,
+ cores = 2))
+ppval
+@
+In this case there is little to be gained by splitting the computations over two CPU cores
+<<run-pptest2>>=
+set.seed(42)
+system.time(ppval2 <- ppt.test(jackal$Length, jackal$Sex, nperm = 9999,
+ cores = 1))
+ppval2
+@
+The cost of setting up and managing the parallel processes, and recombining the separate sets of results almost negates the gain in running the permutations in parallel. Here, the computations involved in \code{meanDif()} are trivial and we would expect greater efficiencies from running the permutations in parallel for more complex analyses.
+
+\subsection{Accesing and changing permutation designs}
+Th object created by \code{how()} is a relatively simple list containing the settings for the specified permutation design. As such one could use the standard subsetting and replacement functions in base \proglang{R} to alter components of the list. This is not recommended, however, as the internal structure of the list returned by \code{how()} may change in a later version of \pkg{permute}. Furthermore, to facilitate the use of \code{update()} at the user-level to alter the permutation [...]
+
+The \code{getFoo()} functions provided by \pkg{permute} are
+
+\begin{description}
+ \item[\code{getWithin()}, \code{getPlots()}, \code{getBlocks()}]
+ these extract the details of the \emph{within}-, \emph{plots}-, and \emph{blocks}-level components of the design. Given the current design (as of \pkg{permute} version 0.8-0), the first two of these return lists with classes \code{"Within"} and \code{"Plots"}, respectively, whilst \code{getBlocks()} returns the block-level factor.
+\item[\code{getStrata()}]
+ returns the factor describing the grouping of samples at the \emph{plots} or \emph{blocks} levels, as determined by the value of argument \code{which}.
+ \item[\code{getType()}]
+ returns the type of permutation of samples at the \emph{within} or \emph{plots} levels, as determined by the value of argument \code{which}.
+ \item[\code{getMirror()}]
+ returns a logical, indicating whether permutations are drawn from the mirror image of the observed ordering at the \emph{within} or \emph{plots} levels, as determined by the value of argument \code{which}.
+ \item[\code{getConstant()}]
+ returns a logical, indicating whether the same permutation of samples, or a different permutation, is used within each of the plots.
+ \item[\code{getRow()}, \code{getCol()}, \code{getDim()}]
+ return dimensions of the spatial grid of samples at the \emph{plots} or \emph{blocks} levels, as determined by the value of argument \code{which}.
+ \item[\code{getNperm()}, \code{getMaxperm()}, \code{getMinperm()}]
+ return numerics for the stored number of permutations requested plus two triggers used when checking permutation designs via \code{check()}.
+ \item[\code{getComplete()}]
+ returns a logical, indicating whether complete enumeration of the set of permutations was requested.
+ \item[\code{getMake()}]
+ returns a logical, indicating whether the entire set of permutations should be produced or not.
+ \item[\code{getObserved()}]
+ returns a logical, which indicates whether the observed permutation (ordering of samples) is included in the entire set of permutation generated by \code{allPerms()}.
+ \item[\code{getAllperms()}]
+ extracts the complete set of permutations if present. Returns \code{NULL} if the set has not been generated.
+\end{description}
+
+The available \code{setFoo()<-} functions are
+
+\begin{description}
+ \item[\code{setPlots<-()}, \code{setWithin<-()};]
+ replaces the details of the \emph{within}-, and \emph{plots}-, components of the design. The replacement object must be of class \code{"Plots"} or \code{"Within"}, respectively, and hence is most usefully used in combination with the \code{Plots()} or \code{Within()} constructor functions.
+ \item[\code{setBlocks<-()};]
+ replaces the factor that partitions the observations into blocks. \code{value} can be any \proglang{R} object that can be coerced to a factor vector via \code{as.factor()}.
+ \item[\code{setStrata<-()};]
+ replaces either the \code{blocks} or \code{strata} components of the design, depending on what class of object \code{setStrata<-()} is applied to. When used on an object of class \code{"how"}, \code{setStrata<-()} replaces the \code{blocks} component of that object. When used on an object of class \code{"Plots"}, \code{setStrata<-()} replaces the \code{strata} component of that object. In both cases a factor variable is required and the replacement object will be coerced to a factor [...]
+ \item[\code{setType<-()};]
+ replaces the \code{type} component of an object of class \code{"Plots"} or \code{"Within"} with a character vector of length one. Must be one of the available types: \code{"none"}, \code{"free"}, \code{"series"}, or \code{"grid"}.
+ \item[\code{setMirror<-()};]
+ replaces the \code{mirror} component of an object of class \code{"Plots"} or \code{"Within"} with a logical vector of length one.
+ \item[\code{setConstant<-()};]
+ replaces the \code{constant} component of an object of class \code{"Within"} with a logical vector of length one.
+ \item[\code{setRow<-()}, \code{setCol<-()}, \code{setDim<-()};]
+ replace one or both of the spatial grid dimensions of an object of class \code{"Plots"} or \code{"Within"} with am integer vector of length one, or, in the case of \code{setDim<-()}, of length 2.
+ \item[\code{setNperm<-()}, \code{setMinperm<-()}, \code{setMaxperm<-()};]
+ update the stored values for the requested number of permutations and the minimum and maximum permutation thresholds that control whether the entire set of permutations is generated instead of \code{nperm} permutations.
+ \item[\code{setAllperms<-()};]
+ assigns a matrix of permutation indices to the \code{all.perms} component of the design list object.
+ \item[\code{setComplete<-()};]
+ updates the status of the \code{complete} setting. Takes a logical vector of length 1 or any object coercible to such.
+ \item[\code{setMake<-()};]
+ sets the indicator controlling whether the entrie set of permutations is generated during checking of the design via \code{check()}. Takes a logical vector of length 1 or any object coercible to such.
+ \item[\code{setObserved<-()};]
+ updates the indicator of whether the observed ordering is included in the set of all permutations should they be generated. Takes a logical vector of length 1 or any object coercible to such.
+\end{description}
+
+\subsubsection{Examples}
+I illustrate the behaviour of the \code{getFoo()} and \code{setFoo<-()} functions through a couple of simple examples. Firstly, generate a design object
+<<get-set-eg0>>=
+hh <- how()
+@
+This design is one of complete randomization, so all of the settings in the object take their default values. The default number of permutations is currently \Sexpr{getNperm(hh)}, and can be extracted using \code{getNperm()}
+<<get-set-eg1>>=
+getNperm(hh)
+@
+The corresponding replacement function can be use to alter the number of permutations after the design has been generated. To illustrate a finer point of the behaviour of these replacement functions, compare the matched call stored in \code{hh} before and after the number of permutations is changed
+<<<get-set-eg2>>=
+getCall(hh)
+setNperm(hh) <- 999
+getNperm(hh)
+getCall(hh)
+@
+Note how the \code{call} component has been altered to include the argument pair \code{nperm = 999}, hence if this call were evaluated, the resulting object would be a copy of \code{hh}.
+
+As a more complex example, consider the following design consisting of 5 blocks, each containing 2 plots of 5 samples each. Hence there are a total of 10 plots. Both the plots and within-plot sample are time series. This design can be created using
+<<get-set-eg3>>=
+hh <- how(within = Within(type = "series"),
+ plots = Plots(type = "series", strata = gl(10, 5)),
+ blocks = gl(5, 10))
+@
+
+To alter the design at the plot or within-plot levels, it is convenient to extract the relevant component using \code{getPlots()} or \code{getWithin()}, update the extracted object, and finally use the updated object to update \code{hh}. This process is illustrated below in order to change the plot-level permutation type to \code{"free"}
+<<get-set-eg4>>=
+pl <- getPlots(hh)
+setType(pl) <- "free"
+setPlots(hh) <- pl
+@
+We can confirm this has been changed by extracting the permutation type for the plot level
+<<get-set-eg5>>=
+getType(hh, which = "plots")
+@
+Notice too how the call has been expanded from \code{gl(10, 5)} to an integer vector. This expansion is to avoid the obvious problem of locating the objects referred to in the call should the call be re-evaluated later.
+<<get-set-eg6>>=
+getCall(getPlots(hh))
+@
+
+At the top level, a user can update the design using \code{update()}. Hence the equivalent of the above update is (this time resetting the original type; \code{type = "series"})
+<<get-set-eg7>>=
+hh <- update(hh, plots = update(getPlots(hh), type = "series"))
+getType(hh, which = "plots")
+@
+However, this approach is not assured of working within a function because we do not guarantee that components of the call used to create \code{hh} can be found from the execution frame where \code{update()} is called. To be safe, always use the \code{setFoo<-()} replacement functions to update design objects from within your functions.
\section*{Computational details}
-<<seesionInfo, results=tex>>=
-toLatex(sessionInfo())
+This vignette was built within the following environment:
+<<seesionInfo, results=tex, echo=false>>=
+toLatex(sessionInfo(), locale = FALSE)
@
\bibliography{permute}
\end{document}
diff --git a/inst/doc/permutations.pdf b/inst/doc/permutations.pdf
index f6306bc..0047d40 100644
Binary files a/inst/doc/permutations.pdf and b/inst/doc/permutations.pdf differ
diff --git a/inst/tests/.Rhistory b/inst/tests/.Rhistory
deleted file mode 100644
index 03da202..0000000
--- a/inst/tests/.Rhistory
+++ /dev/null
@@ -1,36 +0,0 @@
-require(permute)
-q()
-n
-require(permute)
-set.seed(2)
-factor(rep(c(1,3,4,2), 5), levels = 1:4)
-set.seed(2)
-shuffle(n, CTRL)
-out1
-class(out1)
-set.seed(2)
-all.equal(result, out1)
-identical(result, out1)
-class(result)
-class(out1)
-class(result)
-class(out1)
-identical(result, out1)
-block[result]
-class(block[result])
-identical(block[result], out2)
-identical(block[result], out2)
-class(block[result])
-class(out2)
-?identical
-attributes(blocks[result])
-attributes(block[result])
-attributes(out2)
-all.equal(block[result], out2)
-out2
-block(result)
-block[result]
-all.equal(block[result], out2)
-identical(block[result], out2)
-q()
-n
diff --git a/inst/tests/test-check.R b/inst/tests/test-check.R
new file mode 100644
index 0000000..6b63801
--- /dev/null
+++ b/inst/tests/test-check.R
@@ -0,0 +1,25 @@
+library(testthat)
+library_if_available(permute)
+
+context("Testing check()")
+
+## test that check will return all perms including the observed
+test_that("check returns observed ordering in set of all permutations *if* asked to", {
+ ## simple permutation
+ h <- how(observed = TRUE)
+ pp <- check(4, control = h)
+ expect_that(nrow(pp$control$all.perms), equals(factorial(4)))
+
+ ## time series
+ h <- how(within = Within(type = "series"), observed = TRUE)
+ n <- 10
+ pp <- check(n, control = h)
+ expect_that(nrow(pp$control$all.perms), equals(n))
+
+ ## time series specified as a vector
+ h <- how(within = Within(type = "series"), observed = TRUE)
+ n <- 10
+ vec <- seq_len(n)
+ pp <- check(vec, control = h)
+ expect_that(nrow(pp$control$all.perms), equals(n))
+})
diff --git a/inst/tests/test-shuffle.R b/inst/tests/test-shuffle.R
index cb7df63..254f0e1 100644
--- a/inst/tests/test-shuffle.R
+++ b/inst/tests/test-shuffle.R
@@ -5,7 +5,7 @@ context("Testing shuffle()")
## test no permutation
test_that("shuffle(n) returns seq_len(n) when not permuting", {
- ctrl <- permControl(within = Within(type = "none"))
+ ctrl <- how(within = Within(type = "none"))
expect_that(shuffle(3, control = ctrl), is_identical_to(seq_len(3)))
expect_that(shuffle(1, control = ctrl), is_identical_to(1L))
@@ -13,7 +13,7 @@ test_that("shuffle(n) returns seq_len(n) when not permuting", {
## test shuffle returns integers
test_that("shuffle() returns integers", {
- ctrl <- permControl(within = Within(type = "none"))
+ ctrl <- how(within = Within(type = "none"))
expect_that(shuffle(4), is_a("integer"))
expect_that(shuffle(100), is_a("integer"))
@@ -24,12 +24,11 @@ test_that("shuffle() returns integers", {
## test what shuffle returns when permuting only the strata
## must *not* assume that the samples are in contiguous blocks
test_that("shuffle() works for non-contigous blocks of samples", {
- ## permuting levels of block instead of observations
+ ## permuting levels of Plots instead of observations
## non-contiguous blocks - checks that r1972 continues to work
- block <- factor(rep(1:4, 5))
- CTRL <- permControl(strata = block,
- blocks = Blocks(type = "free"),
- within = Within(type = "none"))
+ Plot <- factor(rep(1:4, 5))
+ CTRL <- how(plots = Plots(strata = Plot, type = "free"),
+ within = Within(type = "none"))
n <- 20
set.seed(2)
result <- shuffle(n, CTRL)
@@ -40,5 +39,5 @@ test_that("shuffle() works for non-contigous blocks of samples", {
19,18,17,20))
expect_that(result, is_identical_to(out1))
out2 <- factor(as.integer(rep(c(3,2,1,4), 5)), levels = 1:4)
- expect_that(block[result], is_identical_to(out2))
+ expect_that(Plot[result], is_identical_to(out2))
})
diff --git a/inst/tests/test-shuffleSet.R b/inst/tests/test-shuffleSet.R
new file mode 100644
index 0000000..2df5030
--- /dev/null
+++ b/inst/tests/test-shuffleSet.R
@@ -0,0 +1,42 @@
+library(testthat)
+library_if_available(permute)
+
+context("Testing shuffleSet()")
+
+## test that shuffleSet interleves the separate block-level
+## permutations correctly back into the original ordering
+## This always generates odd, even, odd, ..., numbered vector
+## of observations, hence when we take the modulus 2 we get
+## a vector of 1,0,1,0,1,...
+test_that("shuffleSet interleves block-level perms correctly", {
+ gr <- factor(rep(1:2, length=20))
+ ctrl <- how(nperm = 5, blocks = gr)
+ p <- shuffleSet(20, control = ctrl) %% 2
+ y <- rep(c(1L, 0L), length.out = ncol(p))
+ nc <- ncol(p)
+ for (i in seq_len(nrow(p))) {
+ expect_that(p[i, ], equals(y))
+ }
+})
+
+## test that nset permutations are always returned if
+## make = FALSE in how()
+test_that( "shuffleSet returns exactly nset permutations when make == FALSE", {
+ ## simple random permutation
+ h <- how(make = FALSE)
+ ss <- shuffleSet(n = 4, nset = 10, control = h)
+ expect_that(nrow(ss), equals(10))
+
+ ## time series
+ h <- how(within = Within(type = "series"), make = FALSE)
+ ss <- shuffleSet(n = 20, nset = 15, control = h)
+ expect_that(nrow(ss), equals(15))
+
+})
+
+## test that shuffleSet always returns a matrix, even for nset == 1
+test_that("shuffleSet returns a matrix even for nset == 1", {
+ h <- how()
+ ss <- shuffleSet(25, nset = 1, control = h)
+ expect_that(ss, is_a("matrix"))
+})
diff --git a/man/allPerms.Rd b/man/allPerms.Rd
index c651348..3d21daf 100644
--- a/man/allPerms.Rd
+++ b/man/allPerms.Rd
@@ -10,8 +10,7 @@
permutations for a given R object and a specified permutation design.
}
\usage{
-allPerms(n, control = permControl(), max = 9999,
- observed = FALSE)
+allPerms(n, control = how(), check = TRUE)
\method{summary}{allPerms}(object, \dots)
}
@@ -20,12 +19,10 @@ allPerms(n, control = permControl(), max = 9999,
number of observations can be determined via \code{getNumObs}.}
\item{control}{a list of control values describing properties of the
permutation design, as returned by a call to
- \code{\link{permControl}}.}
- \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.}
+ \code{\link{how}}.}
+ \item{check}{logical; should \code{allPerms} check the design? The
+ default is to check, but this can be skipped, for example if a
+ function checked the design earlier.}
\item{object}{an object of class \code{"allPerms"}.}
\item{\dots}{arguments to other methods.}
}
@@ -45,7 +42,7 @@ allPerms(n, control = permControl(), max = 9999,
possible permutations would also become problematic in such cases. To
control this and guard against trying to evaluate too large a number
of permutations, if the number of possible permutations is larger than
- \code{max}, \code{allPerms} exits with an error.
+ \code{getMaxperm(control)}, \code{allPerms} exits with an error.
}
\value{
For \code{allPerms}, and object of class \code{"allPerms"}, a matrix
@@ -57,10 +54,6 @@ allPerms(n, control = permControl(), max = 9999,
\code{observed} contains argument \code{observed}.
}
\section{Warning}{
- This function currently assumes that any strata are represented by
- contiguous blocks in the order of the levels of \code{strata}. This is
- unlike \code{\link{shuffle}} and \code{\link{shuffleSet}}.
-
If permuting the strata themselves, a balanced design is required (the
same number of observations in each level of \code{strata}. This is
common to all functions in the package.
@@ -74,28 +67,23 @@ allPerms(vec) ## free permutation
## enumerate all possible permutations for a more complicated
## design
fac <- gl(2,6)
-##ctrl <- permControl(type = "grid", mirror = FALSE, strata = fac,
-## constant = TRUE, nrow = 3, ncol = 2)
-ctrl <- permControl(strata = fac,
- within = Within(type = "grid", mirror = FALSE,
- constant = TRUE, nrow = 3, ncol = 2))
+ctrl <- how(within = Within(type = "grid", mirror = FALSE,
+ constant = TRUE, nrow = 3, ncol = 2),
+ plots = Plots(strata = fac))
Nobs <- length(fac)
-numPerms(seq_len(Nobs), control = ctrl)
-(tmp <- allPerms(Nobs, control = ctrl, observed = TRUE))
+numPerms(seq_len(Nobs), control = ctrl) ## 6
+(tmp <- allPerms(Nobs, control = update(ctrl, observed = TRUE)))
(tmp2 <- allPerms(Nobs, control = ctrl))
## turn on mirroring
-ctrl$within$mirror <- TRUE
+##ctrl$within$mirror <- TRUE
+ctrl <- update(ctrl, within = update(getWithin(ctrl), mirror = TRUE))
numPerms(seq_len(Nobs), control = ctrl)
-(tmp3 <- allPerms(Nobs, control = ctrl, observed = TRUE))
+(tmp3 <- allPerms(Nobs, control = update(ctrl, observed = TRUE)))
(tmp4 <- allPerms(Nobs, control = ctrl))
-%\dontrun{
## prints out details of the permutation scheme as
## well as the matrix of permutations
-% FIXME: uncomment the two lines below when we remove old permute
-% code from vegan and have vegan depend on permute
summary(tmp3)
summary(tmp4)
-%}
}
diff --git a/man/allUtilis.Rd b/man/allUtils.Rd
similarity index 92%
rename from man/allUtilis.Rd
rename to man/allUtils.Rd
index ed245c2..58d4e5e 100644
--- a/man/allUtilis.Rd
+++ b/man/allUtils.Rd
@@ -15,7 +15,7 @@
}
\usage{
-allFree(n, v = 1:n)
+allFree(n, v = seq_len(n))
allSeries(n, nperms, mirror = FALSE)
@@ -32,8 +32,7 @@ allStrata(n, control)
\item{nr,nc}{integer; number of rows and columns of grid designs.}
\item{constant}{logical; same permutation within each block?}
\item{control}{a list of control values describing properties of the
- permutation design, as returned by a call to
- \code{\link{permControl}}.}
+ permutation design, as returned by a call to \code{\link{how}}.}
}
\details{
diff --git a/man/check.Rd b/man/check.Rd
new file mode 100644
index 0000000..7898bfd
--- /dev/null
+++ b/man/check.Rd
@@ -0,0 +1,153 @@
+\name{check}
+\alias{check}
+\alias{print.check}
+\alias{print.summary.check}
+\alias{summary.check}
+
+\title{Utility functions for permutation schemes}
+\description{
+ \code{check} provides checking of permutation schemes for
+ validity. \code{permuplot} produces a graphical representation of the
+ selected permutation design.
+}
+\usage{
+check(object, control = how(), quietly = FALSE)
+
+\method{summary}{check}(object, \dots)
+}
+
+\arguments{
+ \item{object}{an R object. See Details for a complete description,
+ especially for \code{\link{numPerms}}. For
+ \code{\link{summary.check}} an object of class \code{"check"}.}
+ \item{control}{a list of control values describing properties of the
+ permutation design, as returned by a call to \code{\link{how}}.}
+ \item{quietly}{logical; should messages by suppressed?}
+ \item{\dots}{arguments to other methods.}
+}
+\details{
+ \code{check} is a utility functions for working with the new
+ permutation schemes available in \code{\link{shuffle}}.
+
+ \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{"how"} suitably modified if
+ \code{check} identifies a problem.
+
+ The main problem is requesting more permutations than is possible with
+ the number of observations and the permutation design. In such cases,
+ \code{nperm} is reduced to equal the number of possible permutations,
+ and complete enumeration of all permutations is turned on
+ (\code{control$complete} is set to \code{TRUE}).
+
+ Alternatively, if the number of possible permutations is low, and less
+ than \code{control$minperm}, it is better to enumerate all possible
+ permutations, and as such complete enumeration of all permutations is
+ turned on (\code{control$complete} is set to \code{TRUE}).
+}
+\value{
+ For \code{check} a list containing the maximum number of
+ permutations possible and an object of class \code{"\link{how}"}.
+}
+\author{Gavin L. Simpson}
+\seealso{\code{\link{shuffle}} and \code{\link{how}}.}
+
+\examples{
+## use example data from ?pyrifos in package vegan
+require(vegan)
+example(pyrifos)
+
+## Demonstrate the maximum number of permutations for the pyrifos data
+## under a series of permutation schemes
+
+## no restrictions - lots of perms
+CONTROL <- how(within = Within(type = "free"))
+(check1 <- check(pyrifos, CONTROL))
+##summary(check1)
+
+## no strata but data are series with no mirroring, so 132 permutations
+CONTROL <- how(within = Within(type = "series", mirror = FALSE))
+check(pyrifos, CONTROL)
+
+## no strata but data are series with mirroring, so 264 permutations
+CONTROL <- how(within = Within(type = "series", mirror = TRUE))
+check(pyrifos, control = CONTROL)
+
+## unrestricted within strata
+check(pyrifos, control = how(plots = Plots(strata = ditch),
+ within = Within(type = "free")))
+
+## time series within strata, no mirroring
+check(pyrifos,
+ control = how(plots = Plots(strata = ditch),
+ within = Within(type = "series", mirror = FALSE)))
+
+## time series within strata, with mirroring
+check(pyrifos,
+ control = how(plots = Plots(strata = ditch),
+ within = Within(type = "series", mirror = TRUE)))
+
+## time series within strata, no mirroring, same permutation
+## within strata
+check(pyrifos,
+ control = how(plots = Plots(strata = ditch),
+ within = Within(type = "series", constant = TRUE)))
+
+## time series within strata, with mirroring, same permutation
+## within strata
+check(pyrifos,
+ control = how(plots = Plots(strata = ditch),
+ within = Within(type = "series", mirror = TRUE,
+ constant = TRUE)))
+## permute strata
+check(pyrifos, how(plots = Plots(strata = ditch, type = "free"),
+ within = Within(type = "none")))
+
+## this should also also for arbitrary vectors
+vec1 <- check(1:100)
+vec2 <- check(1:100, how())
+all.equal(vec1, vec2)
+vec3 <- check(1:100, how(within = Within(type = "series")))
+all.equal(100, vec3$n)
+vec4 <- check(1:100, how(within = Within(type= "series", mirror = TRUE)))
+all.equal(vec4$n, 200)
+
+## enumerate all possible permutations
+fac <- gl(2,6)
+ctrl <- how(plots = Plots(strata = fac),
+ within = Within(type = "grid", mirror = FALSE,
+ constant = TRUE, nrow = 3, ncol = 2))
+check(1:12, ctrl)
+
+numPerms(1:12, control = ctrl)
+(tmp <- allPerms(12, control = update(ctrl, observed = TRUE)))
+(tmp2 <- allPerms(12, control = ctrl))
+
+## turn on mirroring
+ctrl <- update(ctrl, within = update(getWithin(ctrl), mirror = TRUE))
+numPerms(1:12, control = ctrl)
+(tmp3 <- allPerms(12, control = update(ctrl, observed = TRUE)))
+(tmp4 <- allPerms(12, control = ctrl))
+## prints out details of the permutation scheme as
+## well as the matrix of permutations
+summary(tmp)
+summary(tmp2)
+
+## different numbers of observations per level of strata
+fac <- factor(rep(1:3, times = c(3,2,2)))
+## free permutations in levels of strata
+numPerms(7, how(within = Within(type = "free"),
+ plots = Plots(strata = fac, type = "none")))
+allPerms(7, how(within = Within(type = "free"),
+ plots = Plots(strata = fac)))
+## series permutations in levels of strata
+ctrl <- how(within = Within(type = "series"), plots = Plots(strata = fac))
+numPerms(7, control = ctrl)
+allPerms(7, control = ctrl)
+}
+\keyword{ utilities }
+\keyword{ design }
+\keyword{ methods }
diff --git a/man/get-methods.Rd b/man/get-methods.Rd
new file mode 100644
index 0000000..b43f8d6
--- /dev/null
+++ b/man/get-methods.Rd
@@ -0,0 +1,188 @@
+\name{get-methods}
+\alias{get-methods}
+\alias{getBlocks}
+\alias{getBlocks.default}
+\alias{getBlocks.how}
+\alias{getBlocks.permControl}
+\alias{getWithin}
+\alias{getWithin.default}
+\alias{getWithin.how}
+\alias{getWithin.permControl}
+\alias{getStrata}
+\alias{getStrata.default}
+\alias{getStrata.how}
+\alias{getStrata.permControl}
+\alias{getStrata.Plots}
+\alias{getType}
+\alias{getType.default}
+\alias{getType.how}
+\alias{getType.permControl}
+\alias{getType.Plots}
+\alias{getType.Within}
+\alias{getMirror}
+\alias{getMirror.default}
+\alias{getMirror.how}
+\alias{getMirror.permControl}
+\alias{getMirror.Plots}
+\alias{getMirror.Within}
+\alias{getConstant}
+\alias{getConstant.default}
+\alias{getConstant.how}
+\alias{getConstant.permControl}
+\alias{getConstant.Within}
+\alias{getPlots}
+\alias{getPlots.default}
+\alias{getPlots.how}
+\alias{getPlots.permControl}
+\alias{getRow}
+\alias{getRow.default}
+\alias{getRow.how}
+\alias{getRow.permControl}
+\alias{getRow.Plots}
+\alias{getRow.Within}
+\alias{getCol}
+\alias{getCol.default}
+\alias{getCol.how}
+\alias{getCol.permControl}
+\alias{getCol.Plots}
+\alias{getCol.Within}
+\alias{getDim}
+\alias{getDim.default}
+\alias{getDim.how}
+\alias{getDim.permControl}
+\alias{getDim.Plots}
+\alias{getDim.Within}
+\alias{getNperm}
+\alias{getNperm.default}
+\alias{getNperm.how}
+\alias{getNperm.permControl}
+\alias{getMaxperm}
+\alias{getMaxperm.default}
+\alias{getMaxperm.how}
+\alias{getMaxperm.permControl}
+\alias{getMinperm}
+\alias{getMinperm.default}
+\alias{getMinperm.how}
+\alias{getMinperm.permControl}
+\alias{getComplete}
+\alias{getComplete.default}
+\alias{getComplete.how}
+\alias{getComplete.permControl}
+\alias{getMake}
+\alias{getMake.default}
+\alias{getMake.how}
+\alias{getObserved}
+\alias{getObserved.default}
+\alias{getObserved.how}
+\alias{getAllperms}
+\alias{getAllperms.default}
+\alias{getAllperms.how}
+
+\title{Extractor functions to access components of a permutation design}
+\description{
+ Simple functions to allow abstracted access to components of a
+ permutation design, for example as returned by
+ \code{\link{how}}. Whilst many of these are very simple index
+ opertations on a list, using these rather than directly accessing that
+ list allows the internal representation of the permutation design to
+ change without breaking code.
+}
+\usage{
+
+getAllperms(object, ...)
+getBlocks(object, ...)
+getComplete(object, ...)
+getConstant(object, ...)
+getCol(object, ...)
+getDim(object, ...)
+getMake(object, ...)
+getMaxperm(object, ...)
+getMinperm(object, ...)
+getMirror(object, ...)
+getNperm(object, ...)
+getObserved(object, ...)
+getPlots(object, ...)
+getRow(object, ...)
+getStrata(object, ...)
+getType(object, ...)
+getWithin(object, ...)
+
+\method{getAllperms}{how}(object, ...)
+
+\method{getBlocks}{how}(object, ...)
+
+\method{getCol}{how}(object, which = c("plots", "within"), ...)
+\method{getCol}{Plots}(object, ...)
+\method{getCol}{Within}(object, ...)
+
+\method{getComplete}{how}(object, ...)
+
+\method{getConstant}{how}(object, ...)
+\method{getConstant}{Within}(object, ...)
+
+\method{getDim}{how}(object, which = c("plots", "within"), ...)
+\method{getDim}{Plots}(object, ...)
+\method{getDim}{Within}(object, ...)
+
+\method{getMake}{how}(object, ...)
+
+\method{getMaxperm}{how}(object, ...)
+
+\method{getMinperm}{how}(object, ...)
+
+\method{getMirror}{how}(object, which = c("plots", "within"), ...)
+\method{getMirror}{Plots}(object, ...)
+\method{getMirror}{Within}(object, ...)
+
+\method{getNperm}{how}(object, ...)
+
+\method{getObserved}{how}(object, ...)
+
+\method{getPlots}{how}(object, ...)
+
+\method{getRow}{how}(object, which = c("plots", "within"), ...)
+\method{getRow}{Plots}(object, ...)
+\method{getRow}{Within}(object, ...)
+
+\method{getStrata}{how}(object, which = c("plots", "blocks"),
+ drop = TRUE, ...)
+\method{getStrata}{Plots}(object, drop = TRUE, ...)
+
+\method{getType}{how}(object, which = c("plots", "within"), ...)
+\method{getType}{Plots}(object, ...)
+\method{getType}{Within}(object, ...)
+
+\method{getWithin}{how}(object, ...)
+
+}
+
+\arguments{
+ \item{object}{An R object to dispatch on.}
+ \item{which}{character; which level of restriction to extract
+ information for.}
+ \item{drop}{logical; should un-used factor levels be dropped?}
+ \item{\dots}{Arguments passed on to other methods.}
+}
+\details{
+ These are extractor functions for working with permutation design
+ objects created by \code{\link{how}}. They should be used in
+ preference to directly subsetting the permutation design in case the
+ internal structure of object changes as \pkg{permute} is developed.
+}
+\value{
+ These are simple extractor functions and return the contents of the
+ corresponding components of \code{object}.
+}
+\author{Gavin Simpson}
+\seealso{\code{\link{check}}, a utility function for checking
+ permutation scheme described by \code{\link{how}}.
+}
+
+\examples{
+## extract components from a "how" object
+hh <- how()
+getWithin(hh)
+getNperm(hh)
+}
+\keyword{ methods }
+\keyword{ utils }
\ No newline at end of file
diff --git a/man/how.Rd b/man/how.Rd
new file mode 100644
index 0000000..9dd6008
--- /dev/null
+++ b/man/how.Rd
@@ -0,0 +1,130 @@
+\name{how}
+\alias{how}
+\alias{print.how}
+\alias{Blocks}
+\alias{Within}
+\alias{Plots}
+
+\title{How to define a permutation design?}
+
+\description{
+ Utility functions to describe unrestricted and restricted permutation
+ designs for time series, line transects, spatial grids and blocking
+ factors.
+}
+
+\usage{
+how(within = Within(), plots = Plots(), blocks = NULL,
+ nperm = 199, complete = FALSE, maxperm = 9999,
+ minperm = 99, all.perms = NULL, make = TRUE,
+ observed = FALSE)
+
+Within(type = c("free","series","grid","none"),
+ constant = FALSE, mirror = FALSE,
+ ncol = NULL, nrow = NULL)
+
+Plots(strata = NULL, type = c("none","free","series","grid"),
+ mirror = FALSE, ncol = NULL, nrow = NULL)
+}
+
+\arguments{
+ \item{within, plots, blocks}{Permutation designs for samples within the
+ levels of \code{plots} (\code{within}), permutation of \code{plots}
+ themselves, or for the definition of blocking structures which
+ further restrict permutations (\code{blocks}). \code{within} and
+ \code{plots} each require a named list as produced by \code{Within}
+ and \code{Plots} respectively. \code{blocks} takes a factor (or an
+ object coercible to a factor via \code{as.factor}), the levels of
+ which define the blocking structure.}
+ \item{nperm}{numeric; the number of permutations.}
+ \item{complete}{logical; should complete enumeration of all
+ permutations be performed?}
+ \item{type}{character; the type of permutations required. One of
+ \code{"free"}, \code{"series"}, \code{"grid"} or \code{"none"}. See
+ Details.}
+ \item{maxperm}{numeric; the maximum number of permutations to
+ perform. Currently unused.}
+ \item{minperm}{numeric; the lower limit to the number of possible
+ permutations at which complete enumeration is performed. See argument
+ \code{complete} and Details, below.}
+ \item{all.perms}{an object of class \code{allPerms}, the result of a
+ call to \code{\link{allPerms}}.}
+ \item{make}{logical; should \code{check} generate all possible
+ permutations? Useful if want to check permutation design but not
+ produce the matrix of all permutations, or to circumvent the
+ heuristics governing when complete enumeration is activated.}
+ \item{observed}{logical; should the observed permutation be returned
+ as part of the set of all permutations? Default is \code{FALSE} to
+ facilitate usage in higher level functions.}
+ \item{constant}{logical; should the same permutation be used within
+ each level of strata? If \code{FALSE} a separate, possibly restricted,
+ permutation is produced for each level of \code{strata}.}
+ \item{mirror}{logical; should mirroring of sequences be allowed?}
+ \item{ncol, nrow}{numeric; the number of columns and rows of samples
+ in the spatial grid respectively.}
+ \item{strata}{A factor, or an object that can be coerced to a factor
+ via \code{as.factor}, specifying the strata for permutation.}
+}
+\details{
+ \code{shuffle} can generate permutations for a wide range of
+ restricted permutation schemes. A small selection of the available
+ combinations of options is provided in the Examples section below.
+
+ Argument \code{mirror} determines whether grid or series permutations
+ can be mirrored. Consider the sequence 1,2,3,4. The relationship
+ between consecutive observations is preserved if we reverse the
+ sequence to 4,3,2,1. If there is no inherent direction in your
+ experimental design, mirrored permutations can be considered
+ part of the Null model, and as such increase the number of possible
+ permutations. The default is to not use mirroring so you must
+ explicitly turn this on using \code{mirror = TRUE} in \code{how}.
+
+ To permute plots rather than the observations within plots (the
+ levels of \code{strata}), use \code{Within(type = "none")} and
+ \code{Plots(type = foo)}, where \code{foo} is how you want the plots
+ to be permuted. However, note that the number of observations within
+ each plot \strong{must} be equal!
+
+ For some experiments, such as BACI designs, one might wish to use the
+ same permutation within each plot. This is controlled by
+ argument \code{constant}. If \code{constant = TRUE} then the same
+ permutation will be generated for each level of \code{strata}. The
+ default is \code{constant = FALSE}.
+}
+\value{
+ For \code{how} a list with components for each of the possible arguments.
+}
+\references{
+ \code{shuffle()} is modelled after the permutation schemes of Canoco
+ 3.1 (ter Braak, 1990); see also Besag & Clifford (1989).
+
+ Besag, J. and Clifford, P. (1989) Generalized Monte Carlo significance
+ tests. \emph{Biometrika} \strong{76}; 633--642.
+
+ ter Braak, C. J. F. (1990). \emph{Update notes: CANOCO version
+ 3.1}. Wageningen: Agricultural Mathematics Group. (UR).
+}
+\author{Gavin Simpson}
+\seealso{\code{\link{shuffle}} and \code{\link{shuffleSet}} for
+ permuting from a design, and \code{\link{check}}, a utility function
+ for checking permutation design described by \code{how}.}
+\examples{
+## Set up factors for the Plots and Blocks
+plts <- gl(4, 10) ## 4 Plots of 10 samples each
+blks <- gl(2, 20) ## 2 Blocks of 20 samples each
+
+## permutation design
+h1 <- how(within = Within(type = "series", mirror = TRUE),
+ plots = Plots(strata = plts, type = "series"),
+ blocks = blks)
+
+## The design can be updated...
+## ... remove the blocking:
+update(h1, blocks = NULL)
+
+## ... or switch the type of shuffling at a level:
+#update(h1, plots = update(getPlots(h1), type = "none"))
+plots2 <- update(getPlots(h1), type = "none")
+update(h1, plots = plots2)
+}
+\keyword{ utils }
\ No newline at end of file
diff --git a/man/numPerms.Rd b/man/numPerms.Rd
index 77e3277..2cef9fc 100644
--- a/man/numPerms.Rd
+++ b/man/numPerms.Rd
@@ -7,13 +7,13 @@
under the current permutation scheme.
}
\usage{
-numPerms(object, control = permControl())
+numPerms(object, control = how())
}
\arguments{
\item{object}{any object handled by \code{\link{nobs}}.}
\item{control}{a list of control values describing properties of the
permutation design, as returned by a call to
- \code{\link{permControl}}.}
+ \code{\link{how}}.}
}
\details{
Function \code{numPerms} returns the number of permutations for the
@@ -27,7 +27,7 @@ numPerms(object, control = permControl())
not just the object containing the observations.
}
\value{
- The (numeric) number of possible permutaytions of observations in
+ The (numeric) number of possible permutations of observations in
\code{object}.
}
\note{
@@ -61,27 +61,36 @@ numPerms(object, control = permControl())
}
\author{Gavin Simpson}
\seealso{\code{\link{shuffle}} and
- \code{\link{permControl}}. Additional \code{\link{nobs}} methods are
+ \code{\link{how}}. Additional \code{\link{nobs}} methods are
provide, see \code{\link{nobs-methods}}.}
\examples{
-## permutation design --- see ?permControl
-ctrl <- permControl() ## defaults to freely exchangeable
+## permutation design --- see ?how
+ctrl <- how() ## defaults to freely exchangeable
-## vector
+## vector input
v <- 1:10
(obs <- nobs(v))
numPerms(v, control = ctrl)
-## integer
+## integer input
len <- length(v)
(obs <- nobs(len))
numPerms(len, control = ctrl)
## new design, objects are a time series
-ctrl <- permControl(within = Within(type = "series"))
+ctrl <- how(within = Within(type = "series"))
numPerms(v, control = ctrl)
## number of permutations possible drastically reduced...
-## turn on mirroring
-ctrl <- permControl(within = Within(type = "series", mirror = TRUE))
+## ...turn on mirroring
+ctrl <- how(within = Within(type = "series", mirror = TRUE))
numPerms(v, control = ctrl)
+
+## Try blocking --- 2 groups of 5
+bl <- numPerms(v, control = how(blocks = gl(2,5)))
+bl
+
+## should be same as
+pl <- numPerms(v, control = how(plots = Plots(strata = gl(2,5))))
+pl
+stopifnot(all.equal(bl, pl))
}
diff --git a/man/permCheck-deprecated.Rd b/man/permCheck-deprecated.Rd
new file mode 100644
index 0000000..cae9681
--- /dev/null
+++ b/man/permCheck-deprecated.Rd
@@ -0,0 +1,66 @@
+\name{permCheck-deprecated}
+\alias{permCheck} % for the deprecated function
+\alias{permCheck-deprecated} % for the deprecated function
+\alias{print.permCheck}
+\alias{print.summary.permCheck}
+\alias{summary.permCheck}
+
+\title{Utility functions for permutation schemes}
+\description{
+ \code{permCheck} provides checking of permutation schemes for
+ validity. \code{permuplot} produces a graphical representation of the
+ selected permutation design.
+}
+\usage{
+permCheck(object, control = how())
+
+\method{summary}{permCheck}(object, \dots)
+}
+
+\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"}.}
+ \item{control}{a list of control values describing properties of the
+ permutation design, as returned by a call to
+ \code{\link{how}}.}
+ \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} is a utility functions for working
+ with the new permutation schemes available in \code{\link{shuffle}}.
+
+ \code{permCheck} 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{"how"} suitably modified if
+ \code{permCheck} identifies a problem.
+
+ The main problem is requesting more permutations than possible with
+ the number of observations and the permutation design. In such cases,
+ \code{nperm} is reduced to equal the number of possible permutations,
+ and complete enumeration of all permutations is turned on
+ (\code{control$complete} is set to \code{TRUE}).
+
+ Alternatively, if the number of possible permutations is low, and less
+ than \code{control$minperm}, it is better to enumerate all possible
+ permutations, and as such complete enumeration of all permutations is
+ turned on (\code{control$complete} is set to \code{TRUE}).
+}
+\value{
+ For \code{permCheck} a list containing the maximum number of
+ permutations possible and an object of class
+ \code{"\link{how}"}.
+
+ For \code{permuplot}, a plot on the currently active device.
+}
+\author{Gavin L. Simpson}
+\seealso{\code{\link{shuffle}} and \code{\link{how}}.}
+\keyword{ utilities }
+\keyword{ methods }
diff --git a/man/permCheck.Rd b/man/permCheck.Rd
deleted file mode 100644
index 0b1d220..0000000
--- a/man/permCheck.Rd
+++ /dev/null
@@ -1,280 +0,0 @@
-\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{check} provides checking of permutation schemes for
- validity. \code{permuplot} produces a graphical representation of the
- selected permutation design.
-}
-\usage{
-check(object, control = permControl(), make.all = TRUE)
-
-\method{summary}{check}(object, \dots)
-
-permuplot(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"), \dots)
-}
-
-\arguments{
- \item{object}{an R object. See Details for a
- complete description, especially for \code{numPerms}. For
- \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{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
- number of observations can be determined via \code{getNumObs}.}
- \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.}
- \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{check} and \code{permuplot} are utility functions for working
- with the new permutation schemes available in \code{\link{shuffle}}.
-
- \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{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,
- \code{nperm} is reduced to equal the number of possible permutations,
- and complete enumeration of all permutations is turned on
- (\code{control$complete} is set to \code{TRUE}).
-
- Alternatively, if the number of possible permutations is low, and less
- than \code{control$minperm}, it is better to enumerate all possible
- 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.
-
- \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{check} a list containing the maximum number of
- permutations possible and an object of class
- \code{"\link{permControl}"}.
-
- For \code{permuplot}, a plot on the currently active device.
-}
-%\references{
-%}
-\author{Gavin Simpson}
-\seealso{\code{\link{shuffle}} and \code{\link{permControl}}.}
-
-\examples{
-%\dontrun{
-
-## use example data from ?pyrifos in package vegan
-require(vegan)
-example(pyrifos)
-
-## Demonstrate the maximum number of permutations for the pyrifos data
-## under a series of permutation schemes
-
-## no restrictions - lots of perms
-CONTROL <- permControl(within = Within(type = "free"))
-(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))
-check(pyrifos, CONTROL)
-
-## no strata but data are series with mirroring, so 264 permutations
-CONTROL <- permControl(within = Within(type = "series",
- mirror = TRUE))
-check(pyrifos, control = CONTROL)
-
-## unrestricted within strata
-check(pyrifos, control = permControl(strata = ditch,
- within = Within(type = "free")))
-
-## time series within strata, no mirroring
-check(pyrifos, control = permControl(strata = ditch,
- within = Within(type = "series",
- mirror = FALSE)))
-
-## time series within strata, with mirroring
-check(pyrifos, control = permControl(strata = ditch,
- within = Within(type = "series",
- mirror = TRUE)))
-
-## time series within strata, no mirroring, same permutation
-## within strata
-check(pyrifos, control = permControl(strata = ditch,
- within = Within(type = "series",
- constant = TRUE)))
-
-## time series within strata, with mirroring, same permutation
-## within strata
-check(pyrifos, control = permControl(strata = ditch,
- within = Within(type = "series",
- mirror = TRUE,
- constant = TRUE)))
-
-## permute strata
-check(pyrifos, permControl(strata = ditch,
- within = Within(type = "none"),
- blocks = Blocks(type = "free")))
-%}
-
-## this should also also for arbitrary vectors
-vec1 <- check(1:100)
-vec2 <- check(1:100, permControl())
-all.equal(vec1, vec2)
-vec3 <- check(1:100, permControl(within = Within(type = "series")))
-all.equal(100, vec3$n)
-vec4 <- check(1:100, permControl(within =
- Within(type= "series",
- mirror = TRUE)))
-all.equal(vec4$n, 200)
-
-## enumerate all possible permutations
-fac <- gl(2,6)
-ctrl <- permControl(strata = fac,
- within = Within(type = "grid", mirror = FALSE,
- constant = TRUE, nrow = 3,
- ncol = 2))
-check(1:12, ctrl)
-
-numPerms(1:12, control = ctrl)
-(tmp <- allPerms(12, control = ctrl, observed = TRUE))
-(tmp2 <- allPerms(12, control = ctrl))
-
-## turn on mirroring %%FIXME needs a proper method to do this
-ctrl$within$mirror <- TRUE
-numPerms(1:12, control = ctrl)
-(tmp3 <- allPerms(12, control = ctrl, observed = TRUE))
-(tmp4 <- allPerms(12, control = ctrl))
-## prints out details of the permutation scheme as
-## well as the matrix of permutations
-##summary(tmp) %% FIXME these don't print the scheme
-##summary(tmp2)
-
-
-%% FIXME - need all these updating to new API in permControl...
-%% Fixed one, above, but there may still be problems with some of
-%% the code below:
-\dontrun{
-## different numbers of observations per level of strata
-fac <- factor(rep(1:3, times = c(3,2,2)))
-## free permutations in levels of strata
-numPerms(7, permControl(type = "free", strata = fac))
-allPerms(7, permControl(type = "free", strata = fac))
-## series permutations in levels of strata
-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
-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 }
diff --git a/man/permControl-deprecated.Rd b/man/permControl-deprecated.Rd
new file mode 100644
index 0000000..dcb7802
--- /dev/null
+++ b/man/permControl-deprecated.Rd
@@ -0,0 +1,82 @@
+\name{permControl-deprecated}
+\alias{permControl}
+\alias{print.permControl}
+\alias{print.permControl-deprecated}
+
+\title{How to define a permutation design?}
+
+\description{
+ Utility functions to describe unrestricted and restricted permutation
+ designs for time series, line transects, spatial grids and blocking
+ factors.
+}
+
+\usage{
+permControl(within = Within(), plots = Plots(), blocks = NULL,
+ nperm = 199, complete = FALSE, maxperm = 9999,
+ minperm = 99, all.perms = NULL, observed = FALSE)
+}
+
+\arguments{
+ \item{within, plots, blocks}{Permutation designs for samples within the
+ levels of \code{plots} (\code{within}), permutation of \code{plots}
+ themselves, or for the definition of blocking structures which
+ further restrict permutations (\code{blocks}). \code{within} and
+ \code{plots} each require a named list as produced by \code{Within}
+ and \code{Plots} respectively. \code{blocks} takes a factor, the
+ levels of which define the blocking structure.}
+ \item{nperm}{the number of permutations.}
+ \item{complete}{logical; should complete enumeration of all
+ permutations be performed?}
+ \item{maxperm}{the maximum number of permutations to
+ perform. Currently unused.}
+ \item{minperm}{the lower limit to the number of possible permutations
+ at which complete enumeration is performed. See argument
+ \code{complete} and Details, below.}
+ \item{all.perms}{an object of class \code{allPerms}, the result of a
+ call to \code{\link{allPerms}}.}
+ \item{observed}{logical; should the observed permutation be returned
+ as part of the set of all permutations?}
+}
+\details{
+ Argument \code{mirror} determines whether grid or series permutations
+ can be mirrored. Consider the sequence 1,2,3,4. The relationship
+ between consecutive observations is preserved if we reverse the
+ sequence to 4,3,2,1. If there is no inherent direction in your
+ experimental design, mirrored permutations can be considered
+ part of the Null model, and as such increase the number of possible
+ permutations. The default is to not use mirroring so you must
+ explicitly turn this on using \code{mirror = TRUE} in
+ \code{permControl}.
+
+ To permute plots rather than the observations within plots (the
+ levels of \code{strata}), use \code{Within(type = "none")} and
+ \code{Plots(type = foo)}, where \code{foo} is how you want the plots
+ to be permuted. However, note that the number of observations within
+ each plot \strong{must} be equal!
+
+ For some experiments, such as BACI designs, one might wish to use the
+ same permutation within each plot. This is controlled by
+ argument \code{constant}. If \code{constant = TRUE} then the same
+ permutation will be generated for each level of \code{strata}. The
+ default is \code{constant = FALSE}.
+}
+\value{
+ For \code{permControl} a list with components for each
+ of the possible arguments.
+}
+\references{
+ \code{shuffle()} is modelled after the permutation schemes of Canoco
+ 3.1 (ter Braak, 1990); see also Besag & Clifford (1989).
+
+ Besag, J. and Clifford, P. (1989) Generalized Monte Carlo significance
+ tests. \emph{Biometrika} \strong{76}; 633--642.
+
+ ter Braak, C. J. F. (1990). \emph{Update notes: CANOCO version
+ 3.1}. Wageningen: Agricultural Mathematics Group. (UR).
+}
+\author{Gavin L. Simpson}
+\seealso{\code{\link{shuffle}} for permuting from a design,
+ \code{\link{check}}, a utility function for checking permutation
+ schemedesign described by \code{\link{how}}.}
+\keyword{ utils }
\ No newline at end of file
diff --git a/man/permute-deprecated.Rd b/man/permute-deprecated.Rd
new file mode 100644
index 0000000..94911cf
--- /dev/null
+++ b/man/permute-deprecated.Rd
@@ -0,0 +1,25 @@
+\name{permute-deprecated}
+
+\title{Deprecated functions in package permute}
+
+\description{
+ These functions have been replaced in the latest version of
+ permute. They are provided in the package to allow time for the
+ transition of code to the replacements in the package. The functions
+ listed here will soon be removed from the package, possibly by the
+ next minor (x.y) release.
+}
+
+\details{
+ \code{permCheck} was deprecated in favour of function
+ \code{\link{check}}. The documentation for \code{permCheck} can be
+ found via \code{help("permCheck-deprecated")} (note the quotes).
+
+ \code{permControl} was deprecated in favour of of function
+ \code{\link{how}}. The documentation for \code{permControl} can be
+ found via \code{help("permControl-deprecated")} (note the quotes).
+}
+
+\author{Gavin L. Simpson}
+
+\seealso{\code{\link{check}}, and \code{\link{how}}.}
\ No newline at end of file
diff --git a/man/set-methods.Rd b/man/set-methods.Rd
new file mode 100644
index 0000000..d4e7a8f
--- /dev/null
+++ b/man/set-methods.Rd
@@ -0,0 +1,147 @@
+\name{set-methods}
+\alias{set-methods}
+\alias{setBlocks<-}
+\alias{setBlocks<-.default}
+\alias{setBlocks<-.how}
+\alias{setBlocks<-.permControl}
+\alias{setWithin<-}
+\alias{setWithin<-.default}
+\alias{setWithin<-.how}
+\alias{setStrata<-}
+\alias{setStrata<-.default}
+\alias{setStrata<-.how}
+\alias{setStrata<-.Plots}
+\alias{setType<-}
+\alias{setType<-.default}
+\alias{setType<-.how}
+\alias{setType<-.Plots}
+\alias{setType<-.Within}
+\alias{setMirror<-}
+\alias{setMirror<-.default}
+\alias{setMirror<-.how}
+\alias{setMirror<-.Plots}
+\alias{setMirror<-.Within}
+\alias{setConstant<-}
+\alias{setConstant<-.default}
+\alias{setConstant<-.how}
+\alias{setConstant<-.Plots}
+\alias{setConstant<-.Within}
+\alias{setPlots<-}
+\alias{setPlots<-.default}
+\alias{setPlots<-.how}
+\alias{setRow<-}
+\alias{setRow<-.default}
+\alias{setRow<-.how}
+\alias{setRow<-.Plots}
+\alias{setRow<-.Within}
+\alias{setCol<-}
+\alias{setCol<-.default}
+\alias{setCol<-.how}
+\alias{setCol<-.Plots}
+\alias{setCol<-.Within}
+\alias{setDim<-}
+\alias{setDim<-.default}
+\alias{setDim<-.how}
+\alias{setDim<-.Plots}
+\alias{setDim<-.Within}
+\alias{setNperm<-}
+\alias{setNperm<-.default}
+\alias{setNperm<-.how}
+\alias{setNperm<-.permControl}
+\alias{setAllperms<-}
+\alias{setAllperms<-.default}
+\alias{setAllperms<-.how}
+\alias{setAllperms<-.permControl}
+\alias{setMaxperm<-}
+\alias{setMaxperm<-.default}
+\alias{setMaxperm<-.how}
+\alias{setMaxperm<-.permControl}
+\alias{setMinperm<-}
+\alias{setMinperm<-.default}
+\alias{setMinperm<-.how}
+\alias{setMinperm<-.permControl}
+\alias{setComplete<-}
+\alias{setComplete<-.default}
+\alias{setComplete<-.how}
+\alias{setComplete<-.permControl}
+\alias{setMake<-}
+\alias{setMake<-.default}
+\alias{setMake<-.how}
+\alias{setObserved<-}
+\alias{setObserved<-.default}
+\alias{setObserved<-.how}
+
+\title{Replacement functions to set components of a permutation design}
+\description{
+ Simple functions to allow abstracted replacement of components of a
+ permutation design, for example as returned by \code{\link{how}}. In
+ addition to performing replacement of components of the list returned
+ by \code{\link{how}}, these replacement function also update the
+ matched calls stored within the list to facilitate the use of
+ \code{\link{update}} by users.
+}
+\usage{
+
+setBlocks(object) <- value
+setPlots(object) <- value
+setWithin(object) <- value
+setStrata(object) <- value
+setNperm(object) <- value
+setAllperms(object) <- value
+setMaxperm(object) <- value
+setMinperm(object) <- value
+setComplete(object) <- value
+setMake(object) <- value
+setObserved(object) <- value
+setRow(object) <- value
+setCol(object) <- value
+setDim(object) <- value
+setType(object) <- value
+setMirror(object) <- value
+setConstant(object) <- value
+}
+
+\arguments{
+ \item{object}{An R object to dispatch on.}
+ \item{value}{The replacement value/object.}
+}
+\details{
+ These are replacement functions for working with permutation design
+ objects created by \code{\link{how}}. They should be used in
+ preference to directly updating the permutation design in case the
+ internal structure of object changes as \pkg{permute} is developed and
+ because the matched call also needs to be updated to facilitate use of
+ \code{\link{update}} on the \code{\link{how}} object.
+}
+\section{Note}{
+ \code{setStrata<-} has methods for objects of class \code{"how"} and
+ \code{"Plots"}. The former sets the \code{blocks} component of the
+ \code{\link{how}} object, whilst the latter sets the \code{strata}
+ component of the \code{\link{Plots}} object.
+
+ \code{setDim<-}, \code{setRow<-}, and \code{setCol<-} cannot be used
+ on an object of class \code{"how"}. Instead, extract the \code{Plots}
+ or \code{Within} components with \code{\link{getPlots}} or
+ \code{\link{getWithin}} and alter those components, then use the
+ resulting object to replace the \code{plots} or \code{within}
+ components using \code{setPlots} or \code{setWithin}.
+}
+\value{
+ These replacement functions return \code{object} suitably modified.
+}
+\author{Gavin Simpson}
+\seealso{\code{\link{check}}, a utility function for checking
+ permutation scheme described by \code{\link{how}}. Comparable
+ extractor functions are also available; see
+ \code{\link{get-methods}}.
+}
+
+\examples{
+## extract components from a "how" object
+hh <- how()
+getNperm(hh)
+setNperm(hh) <- 999
+getNperm(hh)
+}
+\keyword{ methods }
+\keyword{ utils }
\ No newline at end of file
diff --git a/man/shuffle-utils.Rd b/man/shuffle-utils.Rd
index c6d4422..3757826 100644
--- a/man/shuffle-utils.Rd
+++ b/man/shuffle-utils.Rd
@@ -48,8 +48,8 @@ shuffleStrata(strata, type, mirror = FALSE, start = NULL, flip = NULL,
\code{shuffleFree} is a wrapper to code underlying
\code{\link{sample}}, but without the extra over head of sanity
- checks. It is defined as \code{.Internal(sample(x, size, FALSE,
- NULL))}. You must arrange for the correct values to be supplied, where
+ checks. It is defined as \code{sample.int(x, size, replace = FALSE)}.
+ You must arrange for the correct values to be supplied, where
\code{x} is a vector of indices to sample from, and \code{size} is the
number of indices to sample. Sampling is done without replacement and
without regard to prior probabilities. Argument \code{size} is allowed
@@ -71,7 +71,7 @@ shuffleStrata(strata, type, mirror = FALSE, start = NULL, flip = NULL,
\author{Gavin Simpson}
\seealso{\code{\link{check}}, a utility function for checking
permutation scheme described by
- \code{\link{permControl}}. \code{\link{shuffle}} as a user-oriented
+ \code{\link{how}}. \code{\link{shuffle}} as a user-oriented
wrapper to these functions.}
\examples{
diff --git a/man/shuffle.Rd b/man/shuffle.Rd
index 26f80bb..49bc2f8 100644
--- a/man/shuffle.Rd
+++ b/man/shuffle.Rd
@@ -1,19 +1,6 @@
\name{shuffle}
\alias{shuffle}
-\alias{permControl}
-\alias{Blocks}
-\alias{Within}
-\alias{print.permControl}
\alias{permute}
-\alias{getBlocks}
-\alias{getBlocks.default}
-\alias{getBlocks.permControl}
-\alias{getWithin}
-\alias{getWithin.default}
-\alias{getWithin.permControl}
-\alias{getStrata}
-\alias{getStrata.default}
-\alias{getStrata.permControl}
\title{Unrestricted and restricted permutations}
\description{
@@ -21,97 +8,23 @@
line transects, spatial grids and blocking factors.
}
\usage{
-shuffle(n, control = permControl())
-
-permControl(strata = NULL, nperm = 199, complete = FALSE,
- within = Within(),
- blocks = Blocks(),
- maxperm = 9999, minperm = 99,
- all.perms = NULL, observed = FALSE)
-
-Within(type = c("free","series","grid","none"),
- constant = FALSE, mirror = FALSE,
- ncol = NULL, nrow = NULL)
-
-Blocks(type = c("free","series","grid","none"),
- mirror = FALSE, ncol = NULL, nrow = NULL)
+shuffle(n, control = how())
permute(i, n, control)
-
-getWithin(object, ...)
-
-\method{getWithin}{permControl}(object, ...)
-
-getBlocks(object, ...)
-
-\method{getBlocks}{permControl}(object, ...)
-
-getStrata(object, ...)
-
-\method{getStrata}{permControl}(object, ...)
}
\arguments{
\item{n}{numeric; the length of the returned vector of permuted
values. Usually the number of observations under consideration.}
\item{control}{a list of control values describing properties of the
- permutation design, as returned by a call to \code{permControl}.}
- \item{strata}{An integer vector or factor specifying the strata for
- permutation. If supplied, observations are permuted only within the
- specified strata.}
- \item{nperm}{the number of permutations.}
- \item{complete}{logical; should complete enumeration of all
- permutations be performed?}
- \item{within, blocks}{Permutation designs for samples within the
- levels of \code{strata} (\code{within}) or for the blocks (strata)
- themselves.}
- \item{type}{the type of permutations required. One of \code{"free"},
- \code{"series"}, \code{"grid"} or \code{"none"}. See Details.}
- \item{maxperm}{the maximum number of permutations to
- perform. Currently unused.}
- \item{minperm}{the lower limit to the number of possible permutations
- at which complete enumeration is performed. See argument
- \code{complete} and Details, below.}
- \item{all.perms}{an object of class \code{allPerms}, the result of a
- call to \code{\link{allPerms}}.}
- \item{observed}{logical; should the observed permutation be returned
- as part of the set of all permutations?}
- \item{constant}{logical; should the same permutation be used within
- each level of strata? If \code{FALSE} a separate, possibly restricted,
- permutation is produced for each level of \code{strata}.}
- \item{mirror}{logical; should mirroring of sequences be allowed?}
- \item{ncol, nrow}{numeric; the number of columns and rows of samples
- in the spatial grid respectively.}
+ permutation design, as returned by a call to \code{how}.}
\item{i}{integer; row of \code{control$all.perms} to return.}
- \item{object}{An R object to dispatch on.}
- \item{\dots}{Arguments passed on to other methods.}
}
\details{
\code{shuffle} can generate permutations for a wide range of
restricted permutation schemes. A small selection of the available
combinations of options is provided in the Examples section below.
- Argument \code{mirror} determines whether grid or series permutations
- can be mirrored. Consider the sequence 1,2,3,4. The relationship
- between consecutive observations is preserved if we reverse the
- sequence to 4,3,2,1. If there is no inherent direction in your
- experimental design, mirrored permutations can be considered
- part of the Null model, and as such increase the number of possible
- permutations. The default is to not use mirroring so you must
- explicitly turn this on using \code{mirror = TRUE} in
- \code{permControl}.
-
- To permute \code{strata} rather than the observations within the
- 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!
-
- For some experiments, such as BACI designs, one might wish to use the
- same permutation within each level of strata. This is controlled by
- argument \code{constant}. If \code{constant = TRUE} then the same
- permutation will be generated for each level of \code{strata}. The
- default is \code{constant = FALSE}.
-
\code{permute} is a higher level utility function for use in a loop
within a function implementing a permutation test. The main purpose of
\code{permute} is to return the correct permutation in each iteration
@@ -124,8 +37,8 @@ getStrata(object, ...)
permutation of the observations 1, \ldots, n using the permutation
scheme described by argument \code{control}.
- For \code{permControl} a list with components for each of the possible
- arguments.
+ For \code{permute} the \code{i}th permutation from the set of all
+ permutations, or a random permutation from the design.
}
%\note{
% \code{shuffle} is currently used in one Vegan function;
@@ -145,7 +58,7 @@ getStrata(object, ...)
}
\author{Gavin Simpson}
\seealso{\code{\link{check}}, a utility function for checking
- permutation scheme described by \code{\link{permControl}}.}
+ permutation scheme described by \code{\link{how}}.}
\examples{
set.seed(1234)
@@ -154,83 +67,75 @@ set.seed(1234)
shuffle(20)
## observations represent a time series of line transect
-CTRL <- permControl(within = Within(type = "series"))
+CTRL <- how(within = Within(type = "series"))
shuffle(20, control = CTRL)
## observations represent a time series of line transect
## but with mirroring allowed
-CTRL <- permControl(within = Within(type = "series",
- mirror = TRUE))
+CTRL <- how(within = Within(type = "series", mirror = TRUE))
shuffle(20, control = CTRL)
## observations represent a spatial grid, 5rx4c
nr <- 5
nc <- 4
-CTRL <- permControl(within = Within(type = "grid", ncol = nc,
- nrow = nr))
+CTRL <- how(within = Within(type = "grid", ncol = nc, nrow = nr))
perms <- shuffle(20, control = CTRL)
## view the permutation as a grid
matrix(matrix(1:20, nrow = nr, ncol = nc)[perms],
ncol = nc, nrow = nr)
## random permutations in presence of strata
-block <- gl(4, 5)
-CTRL <- permControl(strata = block,
- within = Within(type = "free"))
+plots <- Plots(strata = gl(4, 5))
+CTRL <- how(plots = plots, within = Within(type = "free"))
shuffle(20, CTRL)
## as above but same random permutation within strata
-CTRL <- permControl(strata = block,
- within = Within(type = "free", constant = TRUE))
+CTRL <- how(plots = plots, within = Within(type = "free",
+ constant = TRUE))
shuffle(20, CTRL)
## time series within each level of block
-CTRL <- permControl(strata = block,
- within = Within(type = "series"))
+CTRL <- how(plots = plots, within = Within(type = "series"))
shuffle(20, CTRL)
## as above, but with same permutation for each level
-CTRL <- permControl(strata = block,
- within = Within(type = "series",
- constant = TRUE))
+CTRL <- how(plots = plots, within = Within(type = "series",
+ constant = TRUE))
shuffle(20, CTRL)
## spatial grids within each level of block, 4 x (5r x 5c)
nr <- 5
nc <- 5
nb <- 4 ## number of blocks
-block <- gl(nb, 25)
-CTRL <- permControl(strata = block,
- within = Within(type = "grid",
- ncol = nc,
- nrow = nr))
+plots <- Plots(gl(nb, 25))
+CTRL <- how(plots = plots,
+ within = Within(type = "grid", ncol = nc, nrow = nr))
shuffle(100, CTRL)
## as above, but with same permutation for each level
-CTRL <- permControl(strata = block,
- within = Within(type = "grid",
- ncol = nc,
- nrow = nr,
- constant = TRUE))
+CTRL <- how(plots = plots,
+ within = Within(type = "grid", ncol = nc, nrow = nr,
+ constant = TRUE))
shuffle(100, CTRL)
-## permuting levels of block instead of observations
-block <- gl(4, 5)
-CTRL <- permControl(strata = block,
- blocks = Blocks(type = "free"),
- within = Within(type = "none"))
+## permuting levels of plots instead of observations
+CTRL <- how(plots = Plots(gl(4, 5), type = "free"),
+ within = Within(type = "none"))
shuffle(20, CTRL)
-## permuting levels of block instead of observations
-## but blocks represent a time series
-CTRL <- permControl(strata = block,
- blocks = Blocks(type = "series"),
- within = Within(type = "none"))
+## permuting levels of plots instead of observations
+## but plots represent a time series
+CTRL <- how(plots = Plots(gl(4, 5), type = "series"),
+ within = Within(type = "none"))
shuffle(20, CTRL)
-## permuting levels of block but blocks represent a time series
-## free permutation within blocks
-CTRL <- permControl(strata = block,
- blocks = Blocks(type = "series"),
- within = Within(type = "free"))
+## permuting levels of plots but plots represent a time series
+## free permutation within plots
+CTRL <- how(plots = Plots(gl(4, 5), type = "series"),
+ within = Within(type = "free"))
shuffle(20, CTRL)
+## permuting within blocks
+grp <- gl(2, 10) # 2 groups of 10 samples each
+CTRL <- how(blocks = grp)
+shuffle(length(grp), control = CTRL)
+
## Simple function using permute() to assess significance
## of a t.test
pt.test <- function(x, group, control) {
@@ -247,7 +152,7 @@ pt.test <- function(x, group, control) {
(xbar - ybar) / (pooled * sqrt(1/m + 1/n))
}
## check the control object
- control <- check(x, control)$control
+ #control <- check(x, control)$control ## FIXME
## number of observations
Nobs <- nobs(x)
## group names
@@ -278,8 +183,7 @@ dat <- c(gr1, gr2)
## grouping variable
grp <- gl(2, 20, labels = paste("Group", 1:2))
## create the permutation design
-control <- permControl(nperm = 999,
- within = Within(type = "free"))
+control <- how(nperm = 999, within = Within(type = "free"))
## perform permutation t test
perm.val <- pt.test(dat, grp, control)
perm.val
diff --git a/man/shuffleSet.Rd b/man/shuffleSet.Rd
index 70c9160..01d7092 100644
--- a/man/shuffleSet.Rd
+++ b/man/shuffleSet.Rd
@@ -11,7 +11,7 @@
set of permutations.
}
\usage{
-shuffleSet(n, nset = 1, control = permControl())
+shuffleSet(n, nset, control = how(), check = TRUE)
}
%- maybe also 'usage' for other objects documented here.
\arguments{
@@ -19,16 +19,48 @@ shuffleSet(n, nset = 1, control = permControl())
numeric; the number of observations in the sample set.
}
\item{nset}{
- numeric; the number of permutations to generate for the set
+ numeric; the number of permutations to generate for the set. Can be
+ missing, the default, in which case \code{nset} is determined from
+ \code{control}.
}
\item{control}{
- an object of class \code{"permControl"} describing a valid
- permutation design.
+ an object of class \code{"how"} describing a valid permutation
+ design.
+ }
+ \item{check}{
+ logical; should the design be checked for various problems via
+ function \code{\link{check}}? The default is to check the design for
+ the stated number of observations and update \code{control}
+ accordingly. See Details.
}
}
\details{
- Currently, only the simple case of permutations not in the presence of
- blocks (strata) is implemented.
+ \code{shuffleSet} is designed to generate a set of \code{nset}
+ permutation indices over which a function can iterate as part of a
+ permutation test. It is only slightly more efficient than calling
+ \code{\link{shuffle}} \code{nset} times, but it is far more practical
+ than the simpler function because a set of permutations can be worked
+ on by applying a function to the rows of the returned object. This
+ simplifies the function applied, and facilitates the use of parallel
+ processing functions, thus enabling a larger number of permutations to
+ be evaluated in reasonable time.
+
+ By default, \code{shuffleSet} will check the permutations design
+ following a few simple heuristics. See \code{\link{check}} for details
+ of these. Whether some of the heuristics are activiated or not can be
+ controlled via \code{\link{how}}, essentialy via its argument
+ \code{minperm}. In particular, if there are fewer than \code{minperm}
+ permutations, \code{shuffleSet} will generate and return \strong{all
+ possible permutations}, which may differ from the number requested via
+ argument \code{nset}.
+
+ The \code{check} argument to \code{shuffleSet} controls whether
+ checking is performed in the permutation design. If you set
+ \code{check = FALSE} then exactly \code{nset} permutations will be
+ returned. However, do be aware that there is no guarantee that the set
+ of permutations returned will be unique, especially so for designs and
+ data sets where there are few possible permutations relative to the
+ number requested.
}
\value{
Returns a matrix of permutations, where each row is a separate
@@ -45,7 +77,7 @@ shuffleSet(n, nset = 1, control = permControl())
%% ~Make other sections like Warning with \section{Warning }{....} ~
\references{
- \code{shuffle()} is modelled after the permutation schemes of Canoco
+ \code{shuffleSet()} is modelled after the permutation schemes of Canoco
3.1 (ter Braak, 1990); see also Besag & Clifford (1989).
Besag, J. and Clifford, P. (1989) Generalized Monte Carlo significance
@@ -56,47 +88,48 @@ shuffleSet(n, nset = 1, control = permControl())
}
\seealso{
See \code{\link{shuffle}} for generating a single permutation, and
- \code{\link{permControl}} for setting up permutation designs.
+ \code{\link{how}} for setting up permutation designs.
}
\examples{
## simple random permutations, 5 permutations in set
-shuffleSet(n = 10, nset = 10)
+shuffleSet(n = 10, nset = 5)
-## series random permutations, 10 permutations in set
-shuffleSet(10, 10, permControl(within = Within(type = "series")))
+## series random permutations, 5 permutations in set
+shuffleSet(10, 5, how(within = Within(type = "series")))
## series random permutations, 10 permutations in set,
## with possible mirroring
-CTRL <- permControl(within = Within(type = "series", mirror = TRUE))
+CTRL <- how(within = Within(type = "series", mirror = TRUE))
shuffleSet(10, 10, CTRL)
## Permuting strata
-grp <- gl(4,5) ## 4 groups of 5 observations
-CTRL <- permControl(strata = grp, within = Within(type = "none"),
- blocks = Blocks(type = "free"))
+## 4 groups of 5 observations
+CTRL <- how(within = Within(type = "none"),
+ plots = Plots(strata = gl(4,5), type = "free"))
shuffleSet(20, 10, control = CTRL)
-## 10 random permutations in presence of strata
-block <- gl(4, 5)
-CTRL <- permControl(strata = block,
- within = Within(type = "free"))
-shuffleSet(20, 10, CTRL)
-## as above but same random permutation within strata
-CTRL <- permControl(strata = block,
- within = Within(type = "free", constant = TRUE))
-shuffleSet(20, 10, CTRL)
+## 10 random permutations in presence of Plot-level strata
+plotStrata <- Plots(strata = gl(4,5))
+CTRL <- how(plots = plotStrata,
+ within = Within(type = "free"))
+numPerms(20, control = CTRL)
+shuffleSet(20, 10, control = CTRL)
+## as above but same random permutation within Plot-level strata
+CTRL <- how(plots = plotStrata,
+ within = Within(type = "free", constant = TRUE))
+numPerms(20, control = CTRL)
+shuffleSet(20, 10, CTRL) ## check this.
-## time series within each level of block
-CTRL <- permControl(strata = block,
- within = Within(type = "series"))
+## time series within each level of Plot strata
+CTRL <- how(plots = plotStrata,
+ within = Within(type = "series"))
shuffleSet(20, 10, CTRL)
-## as above, but with same permutation for each level
-CTRL <- permControl(strata = block,
- within = Within(type = "series",
- constant = TRUE))
+## as above, but with same permutation for each Plot-level stratum
+CTRL <- how(plots = plotStrata,
+ within = Within(type = "series", constant = TRUE))
shuffleSet(20, 10, CTRL)
}
% Add one or more standard keywords, see file 'KEYWORDS' in the
% R documentation directory.
\keyword{ htest }
-\keyword{ design }% __ONLY ONE__ keyword per line
+\keyword{ design }
diff --git a/tests/Examples/permute-Ex.Rout.save b/tests/Examples/permute-Ex.Rout.save
new file mode 100644
index 0000000..3fae873
--- /dev/null
+++ b/tests/Examples/permute-Ex.Rout.save
@@ -0,0 +1,1219 @@
+
+R version 3.0.2 Patched (2013-09-26 r64005) -- "Frisbee Sailing"
+Copyright (C) 2013 The R Foundation for Statistical Computing
+Platform: x86_64-unknown-linux-gnu (64-bit)
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+ Natural language support but running in an English locale
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> pkgname <- "permute"
+> source(file.path(R.home("share"), "R", "examples-header.R"))
+> options(warn = 1)
+> library('permute')
+>
+> base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')
+> cleanEx()
+> nameEx("allPerms")
+> ### * allPerms
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: allPerms
+> ### Title: Complete enumeration of all possible permutations
+> ### Aliases: allPerms print.allPerms summary.allPerms
+> ### print.summary.allPerms
+>
+> ### ** Examples
+>
+> ## allPerms can work with a vector
+> vec <- c(3,4,5)
+> allPerms(vec) ## free permutation
+ [,1] [,2] [,3]
+[1,] 1 3 2
+[2,] 2 1 3
+[3,] 2 3 1
+[4,] 3 1 2
+[5,] 3 2 1
+>
+> ## enumerate all possible permutations for a more complicated
+> ## design
+> fac <- gl(2,6)
+> ctrl <- how(within = Within(type = "grid", mirror = FALSE,
++ constant = TRUE, nrow = 3, ncol = 2),
++ plots = Plots(strata = fac))
+> Nobs <- length(fac)
+> numPerms(seq_len(Nobs), control = ctrl) ## 6
+[1] 6
+> (tmp <- allPerms(Nobs, control = update(ctrl, observed = TRUE)))
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
+[1,] 2 3 4 5 6 1 8 9 10 11 12 7
+[2,] 3 4 5 6 1 2 9 10 11 12 7 8
+[3,] 4 5 6 1 2 3 10 11 12 7 8 9
+[4,] 5 6 1 2 3 4 11 12 7 8 9 10
+[5,] 6 1 2 3 4 5 12 7 8 9 10 11
+[6,] 1 2 3 4 5 6 7 8 9 10 11 12
+> (tmp2 <- allPerms(Nobs, control = ctrl))
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
+[1,] 2 3 4 5 6 1 8 9 10 11 12 7
+[2,] 3 4 5 6 1 2 9 10 11 12 7 8
+[3,] 4 5 6 1 2 3 10 11 12 7 8 9
+[4,] 5 6 1 2 3 4 11 12 7 8 9 10
+[5,] 6 1 2 3 4 5 12 7 8 9 10 11
+>
+> ## turn on mirroring
+> ##ctrl$within$mirror <- TRUE
+> ctrl <- update(ctrl, within = update(getWithin(ctrl), mirror = TRUE))
+> numPerms(seq_len(Nobs), control = ctrl)
+[1] 12
+> (tmp3 <- allPerms(Nobs, control = update(ctrl, observed = TRUE)))
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
+ [1,] 2 3 4 5 6 1 8 9 10 11 12 7
+ [2,] 3 4 5 6 1 2 9 10 11 12 7 8
+ [3,] 4 5 6 1 2 3 10 11 12 7 8 9
+ [4,] 5 6 1 2 3 4 11 12 7 8 9 10
+ [5,] 6 1 2 3 4 5 12 7 8 9 10 11
+ [6,] 1 2 3 4 5 6 7 8 9 10 11 12
+ [7,] 1 6 5 4 3 2 7 12 11 10 9 8
+ [8,] 2 1 6 5 4 3 8 7 12 11 10 9
+ [9,] 3 2 1 6 5 4 9 8 7 12 11 10
+[10,] 4 3 2 1 6 5 10 9 8 7 12 11
+[11,] 5 4 3 2 1 6 11 10 9 8 7 12
+[12,] 6 5 4 3 2 1 12 11 10 9 8 7
+> (tmp4 <- allPerms(Nobs, control = ctrl))
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
+ [1,] 2 3 4 5 6 1 8 9 10 11 12 7
+ [2,] 3 4 5 6 1 2 9 10 11 12 7 8
+ [3,] 4 5 6 1 2 3 10 11 12 7 8 9
+ [4,] 5 6 1 2 3 4 11 12 7 8 9 10
+ [5,] 6 1 2 3 4 5 12 7 8 9 10 11
+ [6,] 1 6 5 4 3 2 7 12 11 10 9 8
+ [7,] 2 1 6 5 4 3 8 7 12 11 10 9
+ [8,] 3 2 1 6 5 4 9 8 7 12 11 10
+ [9,] 4 3 2 1 6 5 10 9 8 7 12 11
+[10,] 5 4 3 2 1 6 11 10 9 8 7 12
+[11,] 6 5 4 3 2 1 12 11 10 9 8 7
+>
+> ## prints out details of the permutation scheme as
+> ## well as the matrix of permutations
+> summary(tmp3)
+
+ Complete enumeration of permutations
+
+Permutation Design:
+
+Blocks:
+ Defined by: none
+
+Plots:
+ Plots: fac
+ Permutation type: none
+ Mirrored?: No
+
+Within Plots:
+ Permutation type: grid
+ Mirrored?: Yes
+ Different permutation within each Plot?: No
+ Grid dimensions: 3 rows 2 cols
+
+Permutation details:
+ Number of permutations requested: 199
+ Max. number of permutations allowed: 9999
+ Evaluate all permutations?: No. Activation limit: 99
+
+All permutations:
+Contains observed ordering?: Yes
+
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
+ [1,] 2 3 4 5 6 1 8 9 10 11 12 7
+ [2,] 3 4 5 6 1 2 9 10 11 12 7 8
+ [3,] 4 5 6 1 2 3 10 11 12 7 8 9
+ [4,] 5 6 1 2 3 4 11 12 7 8 9 10
+ [5,] 6 1 2 3 4 5 12 7 8 9 10 11
+ [6,] 1 2 3 4 5 6 7 8 9 10 11 12
+ [7,] 1 6 5 4 3 2 7 12 11 10 9 8
+ [8,] 2 1 6 5 4 3 8 7 12 11 10 9
+ [9,] 3 2 1 6 5 4 9 8 7 12 11 10
+[10,] 4 3 2 1 6 5 10 9 8 7 12 11
+[11,] 5 4 3 2 1 6 11 10 9 8 7 12
+[12,] 6 5 4 3 2 1 12 11 10 9 8 7
+> summary(tmp4)
+
+ Complete enumeration of permutations
+
+Permutation Design:
+
+Blocks:
+ Defined by: none
+
+Plots:
+ Plots: fac
+ Permutation type: none
+ Mirrored?: No
+
+Within Plots:
+ Permutation type: grid
+ Mirrored?: Yes
+ Different permutation within each Plot?: No
+ Grid dimensions: 3 rows 2 cols
+
+Permutation details:
+ Number of permutations requested: 198
+ Max. number of permutations allowed: 9999
+ Evaluate all permutations?: No. Activation limit: 99
+
+All permutations:
+Contains observed ordering?: No
+
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
+ [1,] 2 3 4 5 6 1 8 9 10 11 12 7
+ [2,] 3 4 5 6 1 2 9 10 11 12 7 8
+ [3,] 4 5 6 1 2 3 10 11 12 7 8 9
+ [4,] 5 6 1 2 3 4 11 12 7 8 9 10
+ [5,] 6 1 2 3 4 5 12 7 8 9 10 11
+ [6,] 1 6 5 4 3 2 7 12 11 10 9 8
+ [7,] 2 1 6 5 4 3 8 7 12 11 10 9
+ [8,] 3 2 1 6 5 4 9 8 7 12 11 10
+ [9,] 4 3 2 1 6 5 10 9 8 7 12 11
+[10,] 5 4 3 2 1 6 11 10 9 8 7 12
+[11,] 6 5 4 3 2 1 12 11 10 9 8 7
+>
+>
+>
+> cleanEx()
+> nameEx("check")
+> ### * check
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: check
+> ### Title: Utility functions for permutation schemes
+> ### Aliases: check print.check print.summary.check summary.check
+> ### Keywords: utilities design methods
+>
+> ### ** Examples
+>
+> ## use example data from ?pyrifos in package vegan
+> require(vegan)
+Loading required package: vegan
+Loading required package: lattice
+This is vegan 2.1-37
+> example(pyrifos)
+
+pyrifs> data(pyrifos)
+
+pyrifs> ditch <- gl(12, 1, length=132)
+
+pyrifs> week <- gl(11, 12, labels=c(-4, -1, 0.1, 1, 2, 4, 8, 12, 15, 19, 24))
+
+pyrifs> dose <- factor(rep(c(0.1, 0, 0, 0.9, 0, 44, 6, 0.1, 44, 0.9, 0, 6), 11))
+>
+> ## Demonstrate the maximum number of permutations for the pyrifos data
+> ## under a series of permutation schemes
+>
+> ## no restrictions - lots of perms
+> CONTROL <- how(within = Within(type = "free"))
+> (check1 <- check(pyrifos, CONTROL))
+[1] 1.118249e+224
+> ##summary(check1)
+>
+> ## no strata but data are series with no mirroring, so 132 permutations
+> CONTROL <- how(within = Within(type = "series", mirror = FALSE))
+> check(pyrifos, CONTROL)
+'nperm' > set of all permutations; Resetting 'nperm'.
+[1] 132
+>
+> ## no strata but data are series with mirroring, so 264 permutations
+> CONTROL <- how(within = Within(type = "series", mirror = TRUE))
+> check(pyrifos, control = CONTROL)
+[1] 264
+>
+> ## unrestricted within strata
+> check(pyrifos, control = how(plots = Plots(strata = ditch),
++ within = Within(type = "free")))
+[1] 1.636321e+91
+>
+> ## time series within strata, no mirroring
+> check(pyrifos,
++ control = how(plots = Plots(strata = ditch),
++ within = Within(type = "series", mirror = FALSE)))
+[1] 3.138428e+12
+>
+> ## time series within strata, with mirroring
+> check(pyrifos,
++ control = how(plots = Plots(strata = ditch),
++ within = Within(type = "series", mirror = TRUE)))
+[1] 1.2855e+16
+>
+> ## time series within strata, no mirroring, same permutation
+> ## within strata
+> check(pyrifos,
++ control = how(plots = Plots(strata = ditch),
++ within = Within(type = "series", constant = TRUE)))
+'nperm' > set of all permutations; Resetting 'nperm'.
+Set of permutations < 'minperm'. Generating entire set.
+[1] 11
+>
+> ## time series within strata, with mirroring, same permutation
+> ## within strata
+> check(pyrifos,
++ control = how(plots = Plots(strata = ditch),
++ within = Within(type = "series", mirror = TRUE,
++ constant = TRUE)))
+'nperm' > set of all permutations; Resetting 'nperm'.
+Set of permutations < 'minperm'. Generating entire set.
+[1] 22
+> ## permute strata
+> check(pyrifos, how(plots = Plots(strata = ditch, type = "free"),
++ within = Within(type = "none")))
+[1] 479001600
+>
+> ## this should also also for arbitrary vectors
+> vec1 <- check(1:100)
+> vec2 <- check(1:100, how())
+> all.equal(vec1, vec2)
+[1] TRUE
+> vec3 <- check(1:100, how(within = Within(type = "series")))
+'nperm' > set of all permutations; Resetting 'nperm'.
+> all.equal(100, vec3$n)
+[1] TRUE
+> vec4 <- check(1:100, how(within = Within(type= "series", mirror = TRUE)))
+> all.equal(vec4$n, 200)
+[1] TRUE
+>
+> ## enumerate all possible permutations
+> fac <- gl(2,6)
+> ctrl <- how(plots = Plots(strata = fac),
++ within = Within(type = "grid", mirror = FALSE,
++ constant = TRUE, nrow = 3, ncol = 2))
+> check(1:12, ctrl)
+'nperm' > set of all permutations; Resetting 'nperm'.
+Set of permutations < 'minperm'. Generating entire set.
+[1] 6
+>
+> numPerms(1:12, control = ctrl)
+[1] 6
+> (tmp <- allPerms(12, control = update(ctrl, observed = TRUE)))
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
+[1,] 2 3 4 5 6 1 8 9 10 11 12 7
+[2,] 3 4 5 6 1 2 9 10 11 12 7 8
+[3,] 4 5 6 1 2 3 10 11 12 7 8 9
+[4,] 5 6 1 2 3 4 11 12 7 8 9 10
+[5,] 6 1 2 3 4 5 12 7 8 9 10 11
+[6,] 1 2 3 4 5 6 7 8 9 10 11 12
+> (tmp2 <- allPerms(12, control = ctrl))
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
+[1,] 2 3 4 5 6 1 8 9 10 11 12 7
+[2,] 3 4 5 6 1 2 9 10 11 12 7 8
+[3,] 4 5 6 1 2 3 10 11 12 7 8 9
+[4,] 5 6 1 2 3 4 11 12 7 8 9 10
+[5,] 6 1 2 3 4 5 12 7 8 9 10 11
+>
+> ## turn on mirroring
+> ctrl <- update(ctrl, within = update(getWithin(ctrl), mirror = TRUE))
+> numPerms(1:12, control = ctrl)
+[1] 12
+> (tmp3 <- allPerms(12, control = update(ctrl, observed = TRUE)))
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
+ [1,] 2 3 4 5 6 1 8 9 10 11 12 7
+ [2,] 3 4 5 6 1 2 9 10 11 12 7 8
+ [3,] 4 5 6 1 2 3 10 11 12 7 8 9
+ [4,] 5 6 1 2 3 4 11 12 7 8 9 10
+ [5,] 6 1 2 3 4 5 12 7 8 9 10 11
+ [6,] 1 2 3 4 5 6 7 8 9 10 11 12
+ [7,] 1 6 5 4 3 2 7 12 11 10 9 8
+ [8,] 2 1 6 5 4 3 8 7 12 11 10 9
+ [9,] 3 2 1 6 5 4 9 8 7 12 11 10
+[10,] 4 3 2 1 6 5 10 9 8 7 12 11
+[11,] 5 4 3 2 1 6 11 10 9 8 7 12
+[12,] 6 5 4 3 2 1 12 11 10 9 8 7
+> (tmp4 <- allPerms(12, control = ctrl))
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
+ [1,] 2 3 4 5 6 1 8 9 10 11 12 7
+ [2,] 3 4 5 6 1 2 9 10 11 12 7 8
+ [3,] 4 5 6 1 2 3 10 11 12 7 8 9
+ [4,] 5 6 1 2 3 4 11 12 7 8 9 10
+ [5,] 6 1 2 3 4 5 12 7 8 9 10 11
+ [6,] 1 6 5 4 3 2 7 12 11 10 9 8
+ [7,] 2 1 6 5 4 3 8 7 12 11 10 9
+ [8,] 3 2 1 6 5 4 9 8 7 12 11 10
+ [9,] 4 3 2 1 6 5 10 9 8 7 12 11
+[10,] 5 4 3 2 1 6 11 10 9 8 7 12
+[11,] 6 5 4 3 2 1 12 11 10 9 8 7
+> ## prints out details of the permutation scheme as
+> ## well as the matrix of permutations
+> summary(tmp)
+
+ Complete enumeration of permutations
+
+Permutation Design:
+
+Blocks:
+ Defined by: none
+
+Plots:
+ Plots: fac
+ Permutation type: none
+ Mirrored?: No
+
+Within Plots:
+ Permutation type: grid
+ Mirrored?: No
+ Different permutation within each Plot?: No
+ Grid dimensions: 3 rows 2 cols
+
+Permutation details:
+ Number of permutations requested: 199
+ Max. number of permutations allowed: 9999
+ Evaluate all permutations?: No. Activation limit: 99
+
+All permutations:
+Contains observed ordering?: Yes
+
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
+[1,] 2 3 4 5 6 1 8 9 10 11 12 7
+[2,] 3 4 5 6 1 2 9 10 11 12 7 8
+[3,] 4 5 6 1 2 3 10 11 12 7 8 9
+[4,] 5 6 1 2 3 4 11 12 7 8 9 10
+[5,] 6 1 2 3 4 5 12 7 8 9 10 11
+[6,] 1 2 3 4 5 6 7 8 9 10 11 12
+> summary(tmp2)
+
+ Complete enumeration of permutations
+
+Permutation Design:
+
+Blocks:
+ Defined by: none
+
+Plots:
+ Plots: fac
+ Permutation type: none
+ Mirrored?: No
+
+Within Plots:
+ Permutation type: grid
+ Mirrored?: No
+ Different permutation within each Plot?: No
+ Grid dimensions: 3 rows 2 cols
+
+Permutation details:
+ Number of permutations requested: 198
+ Max. number of permutations allowed: 9999
+ Evaluate all permutations?: No. Activation limit: 99
+
+All permutations:
+Contains observed ordering?: No
+
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
+[1,] 2 3 4 5 6 1 8 9 10 11 12 7
+[2,] 3 4 5 6 1 2 9 10 11 12 7 8
+[3,] 4 5 6 1 2 3 10 11 12 7 8 9
+[4,] 5 6 1 2 3 4 11 12 7 8 9 10
+[5,] 6 1 2 3 4 5 12 7 8 9 10 11
+>
+> ## different numbers of observations per level of strata
+> fac <- factor(rep(1:3, times = c(3,2,2)))
+> ## free permutations in levels of strata
+> numPerms(7, how(within = Within(type = "free"),
++ plots = Plots(strata = fac, type = "none")))
+[1] 24
+> allPerms(7, how(within = Within(type = "free"),
++ plots = Plots(strata = fac)))
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7]
+ [1,] 1 2 3 4 5 7 6
+ [2,] 1 2 3 5 4 6 7
+ [3,] 1 2 3 5 4 7 6
+ [4,] 1 3 2 4 5 6 7
+ [5,] 1 3 2 4 5 7 6
+ [6,] 1 3 2 5 4 6 7
+ [7,] 1 3 2 5 4 7 6
+ [8,] 2 1 3 4 5 6 7
+ [9,] 2 1 3 4 5 7 6
+[10,] 2 1 3 5 4 6 7
+[11,] 2 1 3 5 4 7 6
+[12,] 2 3 1 4 5 6 7
+[13,] 2 3 1 4 5 7 6
+[14,] 2 3 1 5 4 6 7
+[15,] 2 3 1 5 4 7 6
+[16,] 3 1 2 4 5 6 7
+[17,] 3 1 2 4 5 7 6
+[18,] 3 1 2 5 4 6 7
+[19,] 3 1 2 5 4 7 6
+[20,] 3 2 1 4 5 6 7
+[21,] 3 2 1 4 5 7 6
+[22,] 3 2 1 5 4 6 7
+[23,] 3 2 1 5 4 7 6
+> ## series permutations in levels of strata
+> ctrl <- how(within = Within(type = "series"), plots = Plots(strata = fac))
+> numPerms(7, control = ctrl)
+[1] 12
+> allPerms(7, control = ctrl)
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7]
+ [1,] 2 3 1 5 4 7 6
+ [2,] 2 3 1 5 4 6 7
+ [3,] 2 3 1 4 5 7 6
+ [4,] 2 3 1 4 5 6 7
+ [5,] 3 1 2 5 4 7 6
+ [6,] 3 1 2 5 4 6 7
+ [7,] 3 1 2 4 5 7 6
+ [8,] 3 1 2 4 5 6 7
+ [9,] 1 2 3 5 4 7 6
+[10,] 1 2 3 5 4 6 7
+[11,] 1 2 3 4 5 7 6
+>
+>
+>
+> cleanEx()
+
+detaching ‘package:vegan’, ‘package:lattice’
+
+> nameEx("get-methods")
+> ### * get-methods
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: get-methods
+> ### Title: Extractor functions to access components of a permutation design
+> ### Aliases: get-methods getBlocks getBlocks.default getBlocks.how
+> ### getBlocks.permControl getWithin getWithin.default getWithin.how
+> ### getWithin.permControl getStrata getStrata.default getStrata.how
+> ### getStrata.permControl getStrata.Plots getType getType.default
+> ### getType.how getType.permControl getType.Plots getType.Within
+> ### getMirror getMirror.default getMirror.how getMirror.permControl
+> ### getMirror.Plots getMirror.Within getConstant getConstant.default
+> ### getConstant.how getConstant.permControl getConstant.Within getPlots
+> ### getPlots.default getPlots.how getPlots.permControl getRow
+> ### getRow.default getRow.how getRow.permControl getRow.Plots
+> ### getRow.Within getCol getCol.default getCol.how getCol.permControl
+> ### getCol.Plots getCol.Within getDim getDim.default getDim.how
+> ### getDim.permControl getDim.Plots getDim.Within getNperm
+> ### getNperm.default getNperm.how getNperm.permControl getMaxperm
+> ### getMaxperm.default getMaxperm.how getMaxperm.permControl getMinperm
+> ### getMinperm.default getMinperm.how getMinperm.permControl getComplete
+> ### getComplete.default getComplete.how getComplete.permControl getMake
+> ### getMake.default getMake.how getObserved getObserved.default
+> ### getObserved.how getAllperms getAllperms.default getAllperms.how
+> ### Keywords: methods utils
+>
+> ### ** Examples
+>
+> ## extract components from a "how" object
+> hh <- how()
+> getWithin(hh)
+$type
+[1] "free"
+
+$constant
+[1] FALSE
+
+$mirror
+[1] FALSE
+
+$ncol
+NULL
+
+$nrow
+NULL
+
+$call
+Within()
+
+attr(,"class")
+[1] "Within"
+> getNperm(hh)
+[1] 199
+>
+>
+>
+> cleanEx()
+> nameEx("how")
+> ### * how
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: how
+> ### Title: How to define a permutation design?
+> ### Aliases: how print.how Blocks Within Plots
+> ### Keywords: utils
+>
+> ### ** Examples
+>
+> ## Set up factors for the Plots and Blocks
+> plts <- gl(4, 10) ## 4 Plots of 10 samples each
+> blks <- gl(2, 20) ## 2 Blocks of 20 samples each
+>
+> ## permutation design
+> h1 <- how(within = Within(type = "series", mirror = TRUE),
++ plots = Plots(strata = plts, type = "series"),
++ blocks = blks)
+>
+> ## The design can be updated...
+> ## ... remove the blocking:
+> update(h1, blocks = NULL)
+
+Permutation Design:
+
+Blocks:
+ Defined by: none
+
+Plots:
+ Plots: plts
+ Permutation type: series
+ Mirrored?: No
+
+Within Plots:
+ Permutation type: series
+ Mirrored?: Yes
+ Different permutation within each Plot?: Yes
+
+Permutation details:
+ Number of permutations requested: 199
+ Max. number of permutations allowed: 9999
+ Evaluate all permutations?: No. Activation limit: 99
+>
+> ## ... or switch the type of shuffling at a level:
+> #update(h1, plots = update(getPlots(h1), type = "none"))
+> plots2 <- update(getPlots(h1), type = "none")
+> update(h1, plots = plots2)
+
+Permutation Design:
+
+Blocks:
+ Blocks: blks
+
+Plots:
+ Plots: plts
+ Permutation type: none
+ Mirrored?: No
+
+Within Plots:
+ Permutation type: series
+ Mirrored?: Yes
+ Different permutation within each Plot?: Yes
+
+Permutation details:
+ Number of permutations requested: 199
+ Max. number of permutations allowed: 9999
+ Evaluate all permutations?: No. Activation limit: 99
+>
+>
+>
+> cleanEx()
+> nameEx("jackal")
+> ### * jackal
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: jackal
+> ### Title: Mandible lengths of male and female golden jackals
+> ### Aliases: jackal
+> ### Keywords: datasets
+>
+> ### ** Examples
+>
+> data(jackal)
+> str(jackal)
+'data.frame': 20 obs. of 2 variables:
+ $ Length: num 120 107 110 116 114 111 113 117 114 112 ...
+ $ Sex : Factor w/ 2 levels "Male","Female": 1 1 1 1 1 1 1 1 1 1 ...
+>
+> ## boxplot of mandible length vs sex
+> plot(Length ~ Sex, data = jackal)
+>
+>
+>
+> cleanEx()
+> nameEx("nobs")
+> ### * nobs
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: nobs-methods
+> ### Title: Number of observations in a given object
+> ### Aliases: nobs-methods nobs.numeric nobs.integer nobs.matrix
+> ### nobs.data.frame
+>
+> ### ** Examples
+>
+> ## numeric vector
+> len <- sample(1:10, 1)
+> v <- as.numeric(sample(1:100, len))
+> len
+[1] 3
+> obs <- nobs(v)
+> isTRUE(all.equal(len, obs))
+[1] TRUE
+>
+> ## integer
+> len <- sample(1L:10L, 1)
+> obs <- nobs(len)
+> isTRUE(all.equal(len, obs))
+[1] FALSE
+>
+>
+>
+>
+> cleanEx()
+> nameEx("numPerms")
+> ### * numPerms
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: numPerms
+> ### Title: Number of possible permutations for a given object
+> ### Aliases: numPerms
+>
+> ### ** Examples
+>
+> ## permutation design --- see ?how
+> ctrl <- how() ## defaults to freely exchangeable
+>
+> ## vector input
+> v <- 1:10
+> (obs <- nobs(v))
+[1] 10
+> numPerms(v, control = ctrl)
+[1] 3628800
+>
+> ## integer input
+> len <- length(v)
+> (obs <- nobs(len))
+[1] 1
+> numPerms(len, control = ctrl)
+[1] 3628800
+>
+> ## new design, objects are a time series
+> ctrl <- how(within = Within(type = "series"))
+> numPerms(v, control = ctrl)
+[1] 10
+> ## number of permutations possible drastically reduced...
+> ## ...turn on mirroring
+> ctrl <- how(within = Within(type = "series", mirror = TRUE))
+> numPerms(v, control = ctrl)
+[1] 20
+>
+> ## Try blocking --- 2 groups of 5
+> bl <- numPerms(v, control = how(blocks = gl(2,5)))
+> bl
+[1] 14400
+>
+> ## should be same as
+> pl <- numPerms(v, control = how(plots = Plots(strata = gl(2,5))))
+> pl
+[1] 14400
+> stopifnot(all.equal(bl, pl))
+>
+>
+>
+> cleanEx()
+> nameEx("set-methods")
+> ### * set-methods
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: set-methods
+> ### Title: Replacement functions to set components of a permutation design
+> ### Aliases: set-methods setBlocks<- setBlocks<-.default setBlocks<-.how
+> ### setBlocks<-.permControl setWithin<- setWithin<-.default
+> ### setWithin<-.how setStrata<- setStrata<-.default setStrata<-.how
+> ### setStrata<-.Plots setType<- setType<-.default setType<-.how
+> ### setType<-.Plots setType<-.Within setMirror<- setMirror<-.default
+> ### setMirror<-.how setMirror<-.Plots setMirror<-.Within setConstant<-
+> ### setConstant<-.default setConstant<-.how setConstant<-.Plots
+> ### setConstant<-.Within setPlots<- setPlots<-.default setPlots<-.how
+> ### setRow<- setRow<-.default setRow<-.how setRow<-.Plots setRow<-.Within
+> ### setCol<- setCol<-.default setCol<-.how setCol<-.Plots setCol<-.Within
+> ### setDim<- setDim<-.default setDim<-.how setDim<-.Plots setDim<-.Within
+> ### setNperm<- setNperm<-.default setNperm<-.how setNperm<-.permControl
+> ### setAllperms<- setAllperms<-.default setAllperms<-.how
+> ### setAllperms<-.permControl setMaxperm<- setMaxperm<-.default
+> ### setMaxperm<-.how setMaxperm<-.permControl setMinperm<-
+> ### setMinperm<-.default setMinperm<-.how setMinperm<-.permControl
+> ### setComplete<- setComplete<-.default setComplete<-.how
+> ### setComplete<-.permControl setMake<- setMake<-.default setMake<-.how
+> ### setObserved<- setObserved<-.default setObserved<-.how
+> ### Keywords: methods utils
+>
+> ### ** Examples
+>
+> ## extract components from a "how" object
+> hh <- how()
+> getNperm(hh)
+[1] 199
+> setNperm(hh) <- 999
+> getNperm(hh)
+[1] 999
+>
+>
+>
+> cleanEx()
+> nameEx("shuffle-utils")
+> ### * shuffle-utils
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: shuffle-utils
+> ### Title: Utility functions for unrestricted and restricted permutations
+> ### Aliases: shuffle-utils shuffleFree shuffleGrid shuffleSeries
+> ### shuffleStrata
+> ### Keywords: htest design
+>
+> ### ** Examples
+>
+> set.seed(3)
+>
+> ## draw 1 value at random from the set 1:10
+> shuffleFree(1:10, 1)
+[1] 1
+>
+> ## permute the series 1:10
+> x <- 1:10
+> shuffleSeries(x) ## with random starting point
+ [1] 10 1 2 3 4 5 6 7 8 9
+> shuffleSeries(x, start = 5L) ## known starting point
+ [1] 6 7 8 9 10 1 2 3 4 5
+> shuffleSeries(x, flip = TRUE) ## random start, forced mirror
+ [1] 5 6 7 8 9 10 1 2 3 4
+> shuffleSeries(x, mirror = TRUE) ## random start, possibly mirror
+ [1] 5 6 7 8 9 10 1 2 3 4
+>
+> ## permute a grid of size 3x3
+> shuffleGrid(3, 3) ## random starting row/col
+[1] 6 4 5 9 7 8 3 1 2
+> shuffleGrid(3, 3, start.row = 2,
++ start.col = 3) ## with known row/col
+[1] 3 1 2 6 4 5 9 7 8
+> shuffleGrid(3, 3, flip = rep(TRUE, 2)) ## random start, forced mirror
+[1] 8 9 7 2 3 1 5 6 4
+>
+>
+>
+> cleanEx()
+> nameEx("shuffle")
+> ### * shuffle
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: shuffle
+> ### Title: Unrestricted and restricted permutations
+> ### Aliases: shuffle permute
+> ### Keywords: htest design
+>
+> ### ** Examples
+>
+> set.seed(1234)
+>
+> ## unrestricted permutations
+> shuffle(20)
+ [1] 3 12 11 18 14 10 1 4 8 6 7 5 20 15 2 9 17 16 19 13
+>
+> ## observations represent a time series of line transect
+> CTRL <- how(within = Within(type = "series"))
+> shuffle(20, control = CTRL)
+ [1] 8 9 10 11 12 13 14 15 16 17 18 19 20 1 2 3 4 5 6 7
+>
+> ## observations represent a time series of line transect
+> ## but with mirroring allowed
+> CTRL <- how(within = Within(type = "series", mirror = TRUE))
+> shuffle(20, control = CTRL)
+ [1] 7 6 5 4 3 2 1 20 19 18 17 16 15 14 13 12 11 10 9 8
+>
+> ## observations represent a spatial grid, 5rx4c
+> nr <- 5
+> nc <- 4
+> CTRL <- how(within = Within(type = "grid", ncol = nc, nrow = nr))
+> perms <- shuffle(20, control = CTRL)
+> ## view the permutation as a grid
+> matrix(matrix(1:20, nrow = nr, ncol = nc)[perms],
++ ncol = nc, nrow = nr)
+ [,1] [,2] [,3] [,4]
+[1,] 7 12 17 2
+[2,] 8 13 18 3
+[3,] 9 14 19 4
+[4,] 10 15 20 5
+[5,] 6 11 16 1
+>
+> ## random permutations in presence of strata
+> plots <- Plots(strata = gl(4, 5))
+> CTRL <- how(plots = plots, within = Within(type = "free"))
+> shuffle(20, CTRL)
+ [1] 5 3 4 2 1 8 7 6 9 10 14 11 15 12 13 18 20 16 17 19
+> ## as above but same random permutation within strata
+> CTRL <- how(plots = plots, within = Within(type = "free",
++ constant = TRUE))
+> shuffle(20, CTRL)
+ [1] 3 5 2 1 4 8 10 7 6 9 13 15 12 11 14 18 20 17 16 19
+>
+> ## time series within each level of block
+> CTRL <- how(plots = plots, within = Within(type = "series"))
+> shuffle(20, CTRL)
+ [1] 2 3 4 5 1 8 9 10 6 7 15 11 12 13 14 19 20 16 17 18
+> ## as above, but with same permutation for each level
+> CTRL <- how(plots = plots, within = Within(type = "series",
++ constant = TRUE))
+> shuffle(20, CTRL)
+ [1] 2 3 4 5 1 7 8 9 10 6 12 13 14 15 11 17 18 19 20 16
+>
+> ## spatial grids within each level of block, 4 x (5r x 5c)
+> nr <- 5
+> nc <- 5
+> nb <- 4 ## number of blocks
+> plots <- Plots(gl(nb, 25))
+> CTRL <- how(plots = plots,
++ within = Within(type = "grid", ncol = nc, nrow = nr))
+> shuffle(100, CTRL)
+ [1] 24 25 21 22 23 4 5 1 2 3 9 10 6 7 8 14 15 11
+ [19] 12 13 19 20 16 17 18 27 28 29 30 26 32 33 34 35 31 37
+ [37] 38 39 40 36 42 43 44 45 41 47 48 49 50 46 56 57 58 59
+ [55] 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 51 52
+ [73] 53 54 55 83 84 85 81 82 88 89 90 86 87 93 94 95 91 92
+ [91] 98 99 100 96 97 78 79 80 76 77
+> ## as above, but with same permutation for each level
+> CTRL <- how(plots = plots,
++ within = Within(type = "grid", ncol = nc, nrow = nr,
++ constant = TRUE))
+> shuffle(100, CTRL)
+ [1] 23 24 25 21 22 3 4 5 1 2 8 9 10 6 7 13 14 15
+ [19] 11 12 18 19 20 16 17 48 49 50 46 47 28 29 30 26 27 33
+ [37] 34 35 31 32 38 39 40 36 37 43 44 45 41 42 73 74 75 71
+ [55] 72 53 54 55 51 52 58 59 60 56 57 63 64 65 61 62 68 69
+ [73] 70 66 67 98 99 100 96 97 78 79 80 76 77 83 84 85 81 82
+ [91] 88 89 90 86 87 93 94 95 91 92
+>
+> ## permuting levels of plots instead of observations
+> CTRL <- how(plots = Plots(gl(4, 5), type = "free"),
++ within = Within(type = "none"))
+> shuffle(20, CTRL)
+ [1] 11 12 13 14 15 1 2 3 4 5 6 7 8 9 10 16 17 18 19 20
+> ## permuting levels of plots instead of observations
+> ## but plots represent a time series
+> CTRL <- how(plots = Plots(gl(4, 5), type = "series"),
++ within = Within(type = "none"))
+> shuffle(20, CTRL)
+ [1] 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 1 2 3 4 5
+>
+> ## permuting levels of plots but plots represent a time series
+> ## free permutation within plots
+> CTRL <- how(plots = Plots(gl(4, 5), type = "series"),
++ within = Within(type = "free"))
+> shuffle(20, CTRL)
+ [1] 2 1 3 4 5 6 10 9 7 8 11 12 13 14 15 16 18 20 17 19
+>
+> ## permuting within blocks
+> grp <- gl(2, 10) # 2 groups of 10 samples each
+> CTRL <- how(blocks = grp)
+> shuffle(length(grp), control = CTRL)
+ [1] 1 3 6 10 4 2 7 8 9 5 12 14 11 15 18 17 16 19 20 13
+>
+> ## Simple function using permute() to assess significance
+> ## of a t.test
+> pt.test <- function(x, group, control) {
++ ## function to calculate t
++ t.statistic <- function(x, y) {
++ m <- length(x)
++ n <- length(y)
++ ## means and variances, but for speed
++ xbar <- mean(x)
++ ybar <- mean(y)
++ xvar <- var(x)
++ yvar <- var(y)
++ pooled <- sqrt(((m-1)*xvar + (n-1)*yvar) / (m+n-2))
++ (xbar - ybar) / (pooled * sqrt(1/m + 1/n))
++ }
++ ## check the control object
++ #control <- check(x, control)$control ## FIXME
++ ## number of observations
++ Nobs <- nobs(x)
++ ## group names
++ lev <- names(table(group))
++ ## vector to hold results, +1 because of observed t
++ t.permu <- numeric(length = control$nperm) + 1
++ ## calculate observed t
++ t.permu[1] <- t.statistic(x[group == lev[1]], x[group == lev[2]])
++ ## generate randomisation distribution of t
++ for(i in seq_along(t.permu)) {
++ ## return a permutation
++ want <- permute(i, Nobs, control)
++ ## calculate permuted t
++ t.permu[i+1] <- t.statistic(x[want][group == lev[1]],
++ x[want][group == lev[2]])
++ }
++ ## pval from permutation test
++ pval <- sum(abs(t.permu) >= abs(t.permu[1])) / (control$nperm + 1)
++ ## return value
++ return(list(t.stat = t.permu[1], pval = pval))
++ }
+>
+> ## generate some data with slightly different means
+> set.seed(1234)
+> gr1 <- rnorm(20, mean = 9)
+> gr2 <- rnorm(20, mean = 10)
+> dat <- c(gr1, gr2)
+> ## grouping variable
+> grp <- gl(2, 20, labels = paste("Group", 1:2))
+> ## create the permutation design
+> control <- how(nperm = 999, within = Within(type = "free"))
+> ## perform permutation t test
+> perm.val <- pt.test(dat, grp, control)
+> perm.val
+$t.stat
+[1] -2.342064
+
+$pval
+[1] 0.024
+
+>
+> ## compare perm.val with the p-value from t.test()
+> t.test(dat ~ grp, var.equal = TRUE)
+
+ Two Sample t-test
+
+data: dat by grp
+t = -2.3421, df = 38, p-value = 0.02452
+alternative hypothesis: true difference in means is not equal to 0
+95 percent confidence interval:
+ -1.25582408 -0.09136416
+sample estimates:
+mean in group Group 1 mean in group Group 2
+ 8.749336 9.422930
+
+>
+>
+>
+> cleanEx()
+> nameEx("shuffleSet")
+> ### * shuffleSet
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: shuffleSet
+> ### Title: Generate a set of permutations from the specified design.
+> ### Aliases: shuffleSet
+> ### Keywords: htest design
+>
+> ### ** Examples
+>
+> ## simple random permutations, 5 permutations in set
+> shuffleSet(n = 10, nset = 5)
+No. of Permutations: 5
+No. of Samples: 10 (Nested in: plots; Randomised)
+
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
+[1,] 3 4 5 7 2 8 9 6 10 1
+[2,] 3 2 6 10 5 7 8 4 1 9
+[3,] 10 2 6 1 9 8 7 5 3 4
+[4,] 5 6 4 2 10 8 9 1 7 3
+[5,] 9 6 7 4 8 10 1 2 3 5
+>
+> ## series random permutations, 5 permutations in set
+> shuffleSet(10, 5, how(within = Within(type = "series")))
+Set of permutations < 'minperm'. Generating entire set.
+No. of Permutations: 5
+No. of Samples: 10 (Nested in: plots; Sequence)
+
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
+[1,] 6 7 8 9 10 1 2 3 4 5
+[2,] 8 9 10 1 2 3 4 5 6 7
+[3,] 5 6 7 8 9 10 1 2 3 4
+[4,] 3 4 5 6 7 8 9 10 1 2
+[5,] 2 3 4 5 6 7 8 9 10 1
+>
+> ## series random permutations, 10 permutations in set,
+> ## with possible mirroring
+> CTRL <- how(within = Within(type = "series", mirror = TRUE))
+> shuffleSet(10, 10, CTRL)
+Set of permutations < 'minperm'. Generating entire set.
+No. of Permutations: 10
+No. of Samples: 10 (Nested in: plots; Sequence; mirrored)
+
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
+ [1,] 3 4 5 6 7 8 9 10 1 2
+ [2,] 7 8 9 10 1 2 3 4 5 6
+ [3,] 10 1 2 3 4 5 6 7 8 9
+ [4,] 2 1 10 9 8 7 6 5 4 3
+ [5,] 8 9 10 1 2 3 4 5 6 7
+ [6,] 4 3 2 1 10 9 8 7 6 5
+ [7,] 5 6 7 8 9 10 1 2 3 4
+ [8,] 9 8 7 6 5 4 3 2 1 10
+ [9,] 5 4 3 2 1 10 9 8 7 6
+[10,] 6 5 4 3 2 1 10 9 8 7
+>
+> ## Permuting strata
+> ## 4 groups of 5 observations
+> CTRL <- how(within = Within(type = "none"),
++ plots = Plots(strata = gl(4,5), type = "free"))
+> shuffleSet(20, 10, control = CTRL)
+Set of permutations < 'minperm'. Generating entire set.
+No. of Permutations: 10
+No. of Samples: 20 (Nested in: plots; )
+Restricted by Plots: gl(4, 5) (4 plots; Randomised)
+
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
+ [1,] 6 7 8 9 10 1 2 3 4 5 11 12 13
+ [2,] 6 7 8 9 10 16 17 18 19 20 11 12 13
+ [3,] 11 12 13 14 15 16 17 18 19 20 6 7 8
+ [4,] 1 2 3 4 5 11 12 13 14 15 6 7 8
+ [5,] 16 17 18 19 20 6 7 8 9 10 11 12 13
+ [6,] 6 7 8 9 10 1 2 3 4 5 16 17 18
+ [7,] 11 12 13 14 15 6 7 8 9 10 16 17 18
+ [8,] 16 17 18 19 20 11 12 13 14 15 6 7 8
+ [9,] 11 12 13 14 15 16 17 18 19 20 1 2 3
+[10,] 16 17 18 19 20 1 2 3 4 5 6 7 8
+ [,14] [,15] [,16] [,17] [,18] [,19] [,20]
+ [1,] 14 15 16 17 18 19 20
+ [2,] 14 15 1 2 3 4 5
+ [3,] 9 10 1 2 3 4 5
+ [4,] 9 10 16 17 18 19 20
+ [5,] 14 15 1 2 3 4 5
+ [6,] 19 20 11 12 13 14 15
+ [7,] 19 20 1 2 3 4 5
+ [8,] 9 10 1 2 3 4 5
+ [9,] 4 5 6 7 8 9 10
+[10,] 9 10 11 12 13 14 15
+>
+> ## 10 random permutations in presence of Plot-level strata
+> plotStrata <- Plots(strata = gl(4,5))
+> CTRL <- how(plots = plotStrata,
++ within = Within(type = "free"))
+> numPerms(20, control = CTRL)
+[1] 207360000
+> shuffleSet(20, 10, control = CTRL)
+No. of Permutations: 10
+No. of Samples: 20 (Nested in: plots; Randomised)
+Restricted by Plots: gl(4, 5) (4 plots)
+
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
+ [1,] 5 4 2 3 1 8 10 7 6 9 12 13 11
+ [2,] 4 2 5 3 1 9 7 6 10 8 12 11 15
+ [3,] 1 3 5 4 2 10 7 9 6 8 13 15 11
+ [4,] 3 5 2 4 1 9 8 6 10 7 13 11 15
+ [5,] 1 3 5 4 2 7 9 10 8 6 13 11 12
+ [6,] 5 3 4 2 1 7 6 8 10 9 11 14 13
+ [7,] 3 1 5 4 2 7 6 10 9 8 13 15 11
+ [8,] 2 3 4 5 1 7 6 9 10 8 13 12 11
+ [9,] 4 3 2 1 5 7 8 9 6 10 12 15 11
+[10,] 1 5 2 4 3 8 7 6 9 10 11 15 13
+ [,14] [,15] [,16] [,17] [,18] [,19] [,20]
+ [1,] 14 15 17 16 20 18 19
+ [2,] 13 14 20 18 17 16 19
+ [3,] 14 12 18 16 19 17 20
+ [4,] 14 12 19 18 16 20 17
+ [5,] 15 14 19 20 18 16 17
+ [6,] 12 15 19 17 16 20 18
+ [7,] 14 12 20 16 18 17 19
+ [8,] 15 14 17 16 20 18 19
+ [9,] 13 14 19 20 17 18 16
+[10,] 12 14 16 20 17 19 18
+> ## as above but same random permutation within Plot-level strata
+> CTRL <- how(plots = plotStrata,
++ within = Within(type = "free", constant = TRUE))
+> numPerms(20, control = CTRL)
+[1] 120
+> shuffleSet(20, 10, CTRL) ## check this.
+No. of Permutations: 10
+No. of Samples: 20 (Nested in: plots; Randomised; same permutation in
+each plot)
+Restricted by Plots: gl(4, 5) (4 plots)
+
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
+ [1,] 1 2 5 3 4 6 7 10 8 9 11 12 15
+ [2,] 1 3 4 5 2 6 8 9 10 7 11 13 14
+ [3,] 1 2 5 3 4 6 7 10 8 9 11 12 15
+ [4,] 2 1 3 4 5 7 6 8 9 10 12 11 13
+ [5,] 4 1 5 3 2 9 6 10 8 7 14 11 15
+ [6,] 4 1 2 5 3 9 6 7 10 8 14 11 12
+ [7,] 5 1 3 4 2 10 6 8 9 7 15 11 13
+ [8,] 1 5 3 2 4 6 10 8 7 9 11 15 13
+ [9,] 3 1 2 5 4 8 6 7 10 9 13 11 12
+[10,] 4 2 5 3 1 9 7 10 8 6 14 12 15
+ [,14] [,15] [,16] [,17] [,18] [,19] [,20]
+ [1,] 13 14 16 17 20 18 19
+ [2,] 15 12 16 18 19 20 17
+ [3,] 13 14 16 17 20 18 19
+ [4,] 14 15 17 16 18 19 20
+ [5,] 13 12 19 16 20 18 17
+ [6,] 15 13 19 16 17 20 18
+ [7,] 14 12 20 16 18 19 17
+ [8,] 12 14 16 20 18 17 19
+ [9,] 15 14 18 16 17 20 19
+[10,] 13 11 19 17 20 18 16
+>
+> ## time series within each level of Plot strata
+> CTRL <- how(plots = plotStrata,
++ within = Within(type = "series"))
+> shuffleSet(20, 10, CTRL)
+No. of Permutations: 10
+No. of Samples: 20 (Nested in: plots; Sequence)
+Restricted by Plots: gl(4, 5) (4 plots)
+
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
+ [1,] 1 2 3 4 5 6 7 8 9 10 15 11 12
+ [2,] 5 1 2 3 4 6 7 8 9 10 13 14 15
+ [3,] 1 2 3 4 5 7 8 9 10 6 13 14 15
+ [4,] 2 3 4 5 1 9 10 6 7 8 11 12 13
+ [5,] 2 3 4 5 1 9 10 6 7 8 13 14 15
+ [6,] 3 4 5 1 2 9 10 6 7 8 12 13 14
+ [7,] 5 1 2 3 4 9 10 6 7 8 12 13 14
+ [8,] 4 5 1 2 3 6 7 8 9 10 13 14 15
+ [9,] 2 3 4 5 1 6 7 8 9 10 14 15 11
+[10,] 3 4 5 1 2 6 7 8 9 10 13 14 15
+ [,14] [,15] [,16] [,17] [,18] [,19] [,20]
+ [1,] 13 14 18 19 20 16 17
+ [2,] 11 12 18 19 20 16 17
+ [3,] 11 12 19 20 16 17 18
+ [4,] 14 15 16 17 18 19 20
+ [5,] 11 12 20 16 17 18 19
+ [6,] 15 11 18 19 20 16 17
+ [7,] 15 11 20 16 17 18 19
+ [8,] 11 12 16 17 18 19 20
+ [9,] 12 13 17 18 19 20 16
+[10,] 11 12 19 20 16 17 18
+> ## as above, but with same permutation for each Plot-level stratum
+> CTRL <- how(plots = plotStrata,
++ within = Within(type = "series", constant = TRUE))
+> shuffleSet(20, 10, CTRL)
+'nperm' > set of all permutations; Resetting 'nperm'.
+Set of permutations < 'minperm'. Generating entire set.
+No. of Permutations: 4
+No. of Samples: 20 (Nested in: plots; Sequence; same permutation in
+each plot)
+Restricted by Plots: gl(4, 5) (4 plots)
+
+ [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14]
+[1,] 2 3 4 5 1 7 8 9 10 6 12 13 14 15
+[2,] 3 4 5 1 2 8 9 10 6 7 13 14 15 11
+[3,] 4 5 1 2 3 9 10 6 7 8 14 15 11 12
+[4,] 5 1 2 3 4 10 6 7 8 9 15 11 12 13
+ [,15] [,16] [,17] [,18] [,19] [,20]
+[1,] 11 17 18 19 20 16
+[2,] 12 18 19 20 16 17
+[3,] 13 19 20 16 17 18
+[4,] 14 20 16 17 18 19
+>
+>
+>
+> ### * <FOOTER>
+> ###
+> options(digits = 7L)
+> base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
+Time elapsed: 2.288 0.038 2.347 0 0
+> grDevices::dev.off()
+null device
+ 1
+> ###
+> ### Local variables: ***
+> ### mode: outline-minor ***
+> ### outline-regexp: "\\(> \\)?### [*]+" ***
+> ### End: ***
+> quit('no')
diff --git a/vignettes/Z.cls b/vignettes/Z.cls
index 594aa50..0adeb55 100644
--- a/vignettes/Z.cls
+++ b/vignettes/Z.cls
@@ -183,7 +183,7 @@
\newcommand{\jsssubsubsec}[2][default]{\vskip \preSskip%
\pdfbookmark[3]{#1}{Subsubsection.\thesubsubsection.#1}%
\refstepcounter{subsubsection}%
- {\large \textit{#2}} \nopagebreak
+ {\large \thesubsubsection. \textit{#2}} \nopagebreak
\vskip \postSskip \nopagebreak}
\newcommand{\jsssubsubsecnn}[1]{\vskip \preSskip%
{\textit{\large #1}} \nopagebreak
diff --git a/vignettes/permutations.Rnw b/vignettes/permutations.Rnw
index 4c5cc64..8a762df 100644
--- a/vignettes/permutations.Rnw
+++ b/vignettes/permutations.Rnw
@@ -9,13 +9,13 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% almost as usual
-\author{Gavin L. Simpson\\Environmental Change Research Centre --- UCL}
-\title{Restricted permutations; using the \pkg{permute} Package}
+\author{Gavin L. Simpson\\University of Regina}
+\title{Restricted permutations; using the \pkg{permute} package}
%% for pretty printing and a nice hypersummary also set:
\Plainauthor{Gavin L. Simpson} %% comma-separated
-\Plaintitle{Using the permute Package} %% without formatting
-\Shorttitle{Using the permuet Package} %% a short title (if necessary)
+\Plaintitle{Restricted permutations; using the permute package} %% without formatting
+\Shorttitle{Using the permute package} %% a short title (if necessary)
%% an abstract and keywords
\Abstract{
@@ -51,18 +51,18 @@
%% include your article here, just as usual
%% Note that you should use the \pkg{}, \proglang{} and \code{} commands.
<<preliminary,results=hide,echo=false>>=
-options("prompt" = "R> ", "continue" = "+ ")
+options("prompt" = "R> ", "continue" = "+ ")
options(useFancyQuotes="UTF-8")
@
\section{Introduction}
In classical frequentist statistics, the significance of a relationship or model is determined by reference to a null distribution for the test statistic. This distribution is derived mathematically and the probability of achieving a test statistic as large or larger if the null hypothesis were true is looked-up from this null distribution. In deriving this probability, some assumptions about the data or the errors are made. If these assumptions are violated, then the validity of the der [...]
-An alternative to deriving the null distribution from theory is to generate a null distribution for the test statistic by randomly shuffling the data in some manner, refitting the model and deriving values for the test statistic for the permuted data. The level of significance of the test can be computed as the proportion of values of the test statistic from the null distribution that are equal to or larger than the observed value.
+An alternative to deriving the null distribution from theory is to generate a null distribution of the test statistic by randomly shuffling the data in some manner, refitting the model and deriving values for the test statistic for the permuted data. The level of significance of the test can be computed as the proportion of values of the test statistic from the null distribution that are equal to or larger than the observed value.
-In many data sets, simply shuffling the data at random is inappropriate; under the null hypothesis, that data are not freely exchangeable. If there is temporal or spatial correlation, or the samples are clustered in some way, such as multiple samples collected from each of a number of fields. The \pkg{permute} was designed to provide facilities for generating these restricted permutations for use in randomisation tests.
+In many data sets, simply shuffling the data at random is inappropriate; under the null hypothesis, that data are not freely exchangeable, for example if there is temporal or spatial correlation, or the samples are clustered in some way, such as multiple samples collected from each of a number of fields. The \pkg{permute} package was designed to provide facilities for generating these restricted permutations for use in randomisation tests. \pkg{permute} takes as its motivation the permut [...]
-\section{Simple randomisation}
-As an illustration of both randomisation and the use of the \pkg{permute} package we consider a small data set of mandible length measurements on specimens of the golden jackal (\emph{Canis aureus}) from the British Museum of Natural History, London, UK. These data were collected as part of a study comparing prehistoric and modern canids \citep{higham80}, and were analysed by \citet{manly07}. There are ten measurements of mandible length on both male and female specimens. The data are av [...]
+\section{Simple randomisation}\label{sec:simple}
+As an illustration of both randomisation and simple usage of the \pkg{permute} package we consider a small data set of mandible length measurements on specimens of the golden jackal (\emph{Canis aureus}) from the British Museum of Natural History, London, UK. These data were collected as part of a study comparing prehistoric and modern canids \citep{higham80}, and were analysed by \citet{manly07}. There are ten measurements of mandible length on both male and female specimens. The data a [...]
<<load_jackal>>=
require(permute)
@@ -70,10 +70,11 @@ data(jackal)
jackal
@
-The interest is whether there is a difference in the mean mandible length between male and female golden jackals. The null hypothesis is that there is zero difference in mandible length between the two sexes or that females have larger mandible. The alternative hypothesis is that males have larger mandibles. The usual statistical test of this hypothesis is a one-sided $t$ test, which can be applied using \code{t.test()}
+The interest is whether there is a difference in the mean mandible length between male and female golden jackals. The null hypothesis is that there is zero difference in mandible length between the two sexes or that females have larger mandibles. The alternative hypothesis is that males have larger mandibles. The usual statistical test of this hypothesis is a one-sided $t$ test, which can be applied using \code{t.test()}
-<<ttest_jackal>>=
-jack.t <-t.test(Length ~ Sex, data = jackal, var.equal = TRUE, alternative = "greater")
+<<ttest_jackal, keep.source=true>>=
+jack.t <- t.test(Length ~ Sex, data = jackal, var.equal = TRUE,
+ alternative = "greater")
jack.t
@
@@ -90,7 +91,7 @@ Assumption 1 is unlikely to be valid for museum specimens such as these, that ha
var.test(Length ~ Sex, data = jackal)
fligner.test(Length ~ Sex, data = jackal)
@
-This assumption may be relaxed using \code{var.equal = FALSE} (the default) in our call to \code{t.test()}, to employ Welch's modification for unequal variances. Assumption 3 may be valid, but with such a small sample we are able to reliably test this.
+This assumption may be relaxed using \code{var.equal = FALSE} (the default) in the call to \code{t.test()}, to employ Welch's modification for unequal variances. Assumption 3 may be valid, but with such a small sample we are unable to reliably test this.
A randomisation test of the same hypothesis can be performed by randomly allocating ten of the mandible lengths to the male group and the remaining lengths to the female group. This randomisation is justified under the null hypothesis because the observed difference in mean mandible length between the two sexes is just a typical value for the difference in a sample if there were no difference in the population. An appropriate test statistic needs to be selected. We could use the $t$ stat [...]
@@ -100,7 +101,7 @@ meanDif <- function(x, grp) {
mean(x[grp == "Male"]) - mean(x[grp == "Female"])
}
@
-which can be used in a simple \code{for()} loop to generate the null distribution for the difference of means. First, we allocate some storage to hold the null difference of means; here we use 4999 random permutations so allocate a vector of length 5000. Then we iterate, randomly generating an ordering of the \code{Sex} vector and computing the difference means for that permutation.
+which can be used in a simple \code{for()} loop to generate the null distribution for the difference of means. First, we allocate some storage to hold the null difference of means; here we use 4999 random permutations so allocate a vector of length 5000. Then we iterate, randomly generating an ordering of the \code{Sex} vector and computing the difference of means for that permutation.
<<randJackal>>=
Djackal <- numeric(length = 5000)
N <- nrow(jackal)
@@ -128,7 +129,7 @@ giving a permutational $p$-value of
<<>>=
Dbig / length(Djackal)
@
-which is comparable with that determined from the frequentist $t$-test, and indicate strong evidence against the null hypothesis of no difference.
+which is comparable with that determined from the frequentist $t$-test, and indicates strong evidence against the null hypothesis of no difference.
\begin{figure}[t]
\centering
<<draw_hist_jackal, fig=true, echo=false>>=
@@ -149,15 +150,15 @@ The main workhorse function we used above was \code{shuffle()}. In this example,
In the previous section I introduced the \code{shuffle()} function to generate permutation indices for use in a randomisation test. Now we will take a closer look at \code{shuffle()} and explore the various restricted permutation designs from which it can generate permutation indices.
\code{shuffle()} has two arguments: i) \code{n}, the number of observations in the data set to be permuted, and ii) \code{control}, a list that defines the permutation design describing how the samples should be permuted.
-<<>>=
+<<show_args>>=
args(shuffle)
@
-A series of convenience functions are provided that allow the user to set-up even quite complex permutation designs with little effort. The user only needs to specify the aspects of the design they require and the convenience functions ensure all configuration choices are set and passed on to \code{shuffle()}. The main convenience function is \code{permControl()}, which return a list specifying all the options available for controlling the sorts of permutations returned by \code{shuffle()}
-<<>>=
-str(permControl())
+A series of convenience functions are provided that allow the user to set-up even quite complex permutation designs with little effort. The user only needs to specify the aspects of the design they require and the convenience functions ensure all configuration choices are set and passed on to \code{shuffle()}. The main convenience function is \code{how()}, which returns a list specifying all the options available for controlling the sorts of permutations returned by \code{shuffle()}.
+<<show_str>>=
+str(how())
@
The defaults describe a random permutation design where all objects are freely exchangeable. Using these defaults, \code{shuffle(10)} amounts to \code{sample(1:10, 10, replace = FALSE)}:
-<<>>=
+<<compare_shuffle_sample>>=
set.seed(2)
(r1 <- shuffle(10))
set.seed(2)
@@ -172,76 +173,349 @@ Several types of permutation are available in \pkg{permute}:
\item Free permutation of objects
\item Time series or line transect designs, where the temporal or spatial ordering is preserved.
\item Spatial grid designs, where the spatial ordering is preserved in both coordinate directions
- \item Permutation of blocks or groups of samples.
+ \item Permutation of plots or groups of samples.
+ \item Blocking factors which restrict permutations to within blocks. The preceding designs can be nested within blocks.
\end{itemize}
-The first three of these can be nested within the levels of a factor or to the levels of that factor, or to both. Such flexibility allows the analysis of split-plot designs using permutation tests.
+The first three of these can be nested within the levels of a factor or to the levels of that factor, or to both. Such flexibility allows the analysis of split-plot designs using permutation tests, especially when combined with blocks.
-\code{permControl()} is used to set up the design from which \code{shuffle()} will draw a permutation. \code{permControl()} has two main arguments that specify how samples are permuted \emph{within} blocks of samples or at the block level itself. These are \code{within} and \code{blocks}. Two convenience functions, \code{Within()} and \code{Blocks()} can be used to set the various options for permutation.
+\code{how()} is used to set up the design from which \code{shuffle()} will draw a permutation. \code{how()} has two main arguments that specify how samples are permuted \emph{within} plots of samples or at the plot level itself. These are \code{within} and \code{plots}. Two convenience functions, \code{Within()} and \code{Plots()} can be used to set the various options for permutation. Blocks operate at the uppermost level of this hierarchy; blocks define groups of plots, each of which m [...]
For example, to permute the observations \code{1:10} assuming a time series design for the entire set of observations, the following control object would be used
-<<keep.source=true>>=
+<<series1, keep.source=true>>=
set.seed(4)
x <- 1:10
-CTRL <- permControl(within = Within(type = "series"))
+CTRL <- how(within = Within(type = "series"))
perm <- shuffle(10, control = CTRL)
perm
x[perm] ## equivalent
@
-It is assumed that the observations are in temporal or transect order. We only specified the type of permutation within blocks, the remaining options were set to their defaults via \code{Within()}.
+It is assumed that the observations are in temporal or transect order. We only specified the type of permutation within plots, the remaining options were set to their defaults via \code{Within()}.
-A more complex design, with three blocks, and a 3 by 3 spatial grid arrangement within each block can be created as follows
+A more complex design, with three plots, and a 3 by 3 spatial grid arrangement within each plot can be created as follows
-<<keep.source=true>>=
+<<grid1, keep.source=true>>=
set.seed(4)
-block <- gl(3, 9)
-CTRL <- permControl(strata = block,
- within = Within(type = "grid", ncol = 3, nrow = 3))
-perm <- shuffle(length(block), control = CTRL)
+plt <- gl(3, 9)
+CTRL <- how(within = Within(type = "grid", ncol = 3, nrow = 3),
+ plots = Plots(strata = plt))
+perm <- shuffle(length(plt), control = CTRL)
perm
@
Visualising the permutation as the 3 matrices may help illustrate how the data have been shuffled
-<<keep.source=true>>=
+<<vis_grid1, keep.source=true>>=
## Original
-lapply(split(1:27, block), matrix, ncol = 3)
+lapply(split(seq_along(plt), plt), matrix, ncol = 3)
## Shuffled
-lapply(split(perm, block), matrix, ncol = 3)
+lapply(split(perm, plt), matrix, ncol = 3)
@
In the first grid, the lower-left corner of the grid was set to row 2 and column 2 of the original, to row 1 and column 2 in the second grid, and to row 3 column 2 in the third grid.
-To have the same permutation within each level of \code{block}, use the \code{constant} argument of the \code{Within()} function, setting it to \code{TRUE}
-<<keep.source=TRUE>>=
+To have the same permutation within each level of \code{plt}, use the \code{constant} argument of the \code{Within()} function, setting it to \code{TRUE}
+<<grid_2, keep.source=TRUE>>=
set.seed(4)
-CTRL <- permControl(strata = block,
- within = Within(type = "grid", ncol = 3, nrow = 3,
- constant = TRUE))
-perm2 <- shuffle(length(block), control = CTRL)
-lapply(split(perm2, block), matrix, ncol = 3)
+CTRL <- how(within = Within(type = "grid", ncol = 3, nrow = 3,
+ constant = TRUE),
+ plots = Plots(strata = plt))
+perm2 <- shuffle(length(plt), control = CTRL)
+lapply(split(perm2, plt), matrix, ncol = 3)
@
\subsection{Generating sets of permutations with shuffleSet()}
There are several reasons why one might wish to generate a set of $n$ permutations instead of repeatedly generating permutations one at a time. Interpreting the permutation design happens each time \code{shuffle()} is called. This is an unnecessary computational burden, especially if you want to perform tests with large numbers of permutations. Furthermore, having the set of permutations available allows for expedited use with other functions, they can be iterated over using \code{for} l [...]
-The \code{shuffleSet()} function allows the generation of sets of permutations from any of the designs available in \pkg{permute}. \code{shuffleSet()} takes an additional argument to that of \code{shuffle()}, \code{nset}, which is the number of permutations required for the set. Internally, \code{shuffle()} and \code{shuffleSet()} are very similar, with the major difference being that \code{shuffleSet()} arranges repeated calls to the workhorse permutation-generating functions with only [...]
+The \code{shuffleSet()} function allows the generation of sets of permutations from any of the designs available in \pkg{permute}. \code{shuffleSet()} takes an additional argument to that of \code{shuffle()}, \code{nset}, which is the number of permutations required for the set. \code{nset} can be missing, in which case the number of permutations in the set is looked for in the object passed to \code{control}; using this, the desired number of permutations can be set at the time the desi [...]
+
+<<series_2, results=hide>>=
+how(nperm = 10, within = Within(type = "series"))
+@
+
+Internally, \code{shuffle()} and \code{shuffleSet()} are very similar, with the major difference being that \code{shuffleSet()} arranges repeated calls to the workhorse permutation-generating functions, only incurring the overhead associated with interpreting the permutation design once. \code{shuffleSet()} returns a matrix where the rows represent different permutations in the set.
As an illustration, consider again the simple time series example from earlier. Here I generate a set of 5 permutations from the design, with the results returned as a matrix
-<<keep.source=true>>=
+<<shuffleSet_1, keep.source=true>>=
set.seed(4)
-CTRL <- permControl(within = Within(type = "series"))
+CTRL <- how(within = Within(type = "series"))
pset <- shuffleSet(10, nset = 5, control = CTRL)
pset
@
+It is worth taking a moment to explain what has happened here, behind the scenes. There are only \Sexpr{numPerms(10, CTRL)} unique orderings (including the observed) in the set of permutations for this design. Such a small set of permutations triggers\footnote{The trigger is via the utility function \code{check()}, which calls another utility function, \code{allPerms()}, to generate the set of permutations for the stated design. The trigger for complete enumeration is set via \code{how() [...]
+
+\section{Defining permutation designs}
+In this section I give examples how various permutation designs can be specified using \code{how()}. It is not the intention to provide exhaustive coverage of all possible designs that can be produced; such a list would be tedious to both write \emph{and} read. Instead, the main features and options will be described through a series of examples. The reader should then be able to put together the various options to create the exact structure required.
+
+\subsection{Set the number of permutations}
+It may be useful to specify the number of permutations required in a permutation test alongside the permutation design. This is done via the \code{nperm} argument, as seen earlier. If nothing else is specified
+<<results=hide>>=
+how(nperm = 999)
+@
+would indicate 999 random permutations where the samples are all freely exchangeable.
+
+One advantage of using \code{nperm} is that \code{shuffleSet()} will use this if the \code{nset} argument is not specified. Additionally, \code{shuffleSet()} will check to see if the desired number of permutations is possible given the data and the requested design. This is done via the function \code{check()}, which is discussed later.
+
+\subsection{The levels of the permutation hierarchy}
+There are three levels at which permutations can be controlled in \pkg{permute}. The highest level of the hierarchy is the \emph{block} level. Blocks are defined by a factor variable. Blocks restrict permutation of samples to within the levels of this factor; samples are never swapped between blocks.
+
+The \emph{plot} level sits below blocks. Plots are defined by a factor and group samples in the same way as blocks. As such, some permutation designs can be initiated using a factor at the plot level or the same factor at the block level. The major difference between blocks and plots is that plots can also be permuted, whereas blocks are never permuted.
+
+The lowest level of a permutation design in the \pkg{permute} hierarchy is known as \emph{within}, and refers to samples nested \emph{within} plots. If there are no plots or blocks, how samples are permuted at the \emph{within} level applies to the entire data set.
+
+\subsubsection{Permuting samples at the lowest level}
+How samples at the \emph{within} level are permuted is configured using the \code{Within()} function. It takes the following arguments
+<<withinArgs, echo=false>>=
+args(Within)
+@
+
+\begin{description}
+ \item[\code{type}]
+ controls how the samples at the lowest level are permuted. The default is to form unrestricted permutations via option \code{"type"}. Options \code{"series"} and \code{"grid"} form restricted permutations via cyclic or toroidal shifts, respectively. The former is useful for samples that are a time series or line-transect, whilst the latter is used for samples on a regular spatial grid. The final option, \code{"none"}, will result in the samples at the lowest level not being permuted [...]
+ \item[\code{constant}]
+ this argument only has an effect when there are plots in the design\footnote{Owing to the current implementation, whilst this option could also be useful when blocks to define groups of samples, it will not have any influence over how permutations are generated. As such, only use blocks for simple blocking structures and use plots if you require greater control of the permutations at the group (i.e. plot) level.}. \code{constant = FALSE}, stipulates that each plot should have the sam [...]
+ \item[\code{mirror}]
+ when \code{type} is \code{"series"} or \code{"grid"}, argument \code{"mirror"} controls whether permutations are taken from the mirror image of the observed ordering in space or time. Consider the sequence \code{1, 2, 3, 4}. The relationship between observations is also preserved if we reverse the original ordering to \code{4, 3, 2, 1} and generate permutations from both these orderings. This is what happens when \code{mirror = TRUE}. For time series, the reversed ordering \code{4, 3 [...]
+ \item[\code{ncol}, \code{nrow}]
+ define the dimensions of the spatial grid.
+\end{description}
+
+How \code{Within()} is used has already been encountered in earlier sections of this vignette; the function is used to supply a value to the \code{within} argument of \code{how()}. You may have noticed that all the arguments of \code{Within()} have default values? This means that the user need only supply a modified value for the arguments they wish to change. Also, arguments that are not relevant for the type of permutation stated are simply ignored; \code{nrow} and \code{ncol}, for exa [...]
+
+\subsubsection{Permuting samples at the Plot level}
+Permutation of samples at the \emph{plot} level is configured via the \code{Plots()} function. As with \code{Within()}, \code{Plots()} is supplied to the \code{plots} argument of \code{how()}. \code{Plots()} takes many of the same arguments as \code{Within()}, the two differences being \code{strata}, a factor variable that describes the grouping of samples at the \emph{plot} level, and the absence of a \code{constant} argument. As the majority of arguments are similar between \code{Withi [...]
+
+\begin{description}
+ \item[\code{strata}]
+ a factor variable. \code{strata} describes the grouping of samples at the \emph{plot} level, where samples from the same \emph{plot} are take the same \emph{level} of the factor.
+\end{description}
+
+When a \emph{plot}-level design is specified, samples are never permuted between \emph{plots}, only within plots if they are permuted at all. Hence, the type of permutation \emph{within} the \emph{plots} is controlled by \code{Within()}. Note also that with \code{Plots()}, the way the individual \emph{plots} are permuted can be from any one of the four basic permutation types; \code{"none"}, \code{"free"}, \code{"series"}, and \code{"grid"}, as described above. To permute the \emph{plots [...]
+
+\subsubsection[Specifying blocks; the top of the permute hierarchy]{Specifying blocks; the top of the \pkg{permute} hierarchy}
+In constrast to the \emph{within} and \emph{plots} levels, the \emph{blocks} level is simple to specify; all that is required is an indicator variable the same length as the data. Usually this is a factor, but \code{how()} will take anything that can be coerced to a factor via \code{as.factor()}.
+
+It is worth repeating what the role of the block-level structure is; blocks simply restrict permutation to \emph{within}, and never between, blocks, and blocks are never permuted. This is reflected in the implementation; the \emph{split}-\emph{apply}-\code{combine} paradigm is used to split on the blocking factor, the plot- and within-level permutation design is applied separately to each block, and finally the sets of permutations for each block are recombined.
+
+\subsection{Examples}
+To do.
+
+\section[Using permute in R functions]{Using \pkg{permute} in \proglang{R} functions}
+\pkg{permute} originally started life as a set of functions contained within the \pkg{vegan} package \citep{vegan} designed to provide a replacement for the \code{permuted.index()} function. From these humble origins, I realised other users and package authors might want to make use of the code I was writing and so Jari oksanen, the maintainer of \pkg{vegan}, and I decided to spin off the code into the \pkg{permute} package. Hence from the very beginning, \pkg{permute} was intended for u [...]
+
+In the previous sections, I described the various user-facing functions that are employed to set up permutation designs and generate permutations from these. Here I will outline how package authors can use functionality in the \pkg{permute} package to implement permutation tests.
+
+In Section~\ref{sec:simple} I showed how a permutation test function could be written using the \code{shuffle()} function and allowing the user to pass into the test function an object created with \code{how()}. As mentioned earlier, it is more efficient to generate a set of permutations via a call to \code{shuffleSet()} than to repeatedly call \code{shuffle()} and large number of times. Another advantage of using \code{shuffleSet()} is that once the set of permutations has been created, [...]
+
+To illustrate how to use \pkg{permute} in \proglang{R} functions, I'll rework the permutation test I used for the \code{jackal} data earlier in Section~\ref{sec:simple}.
+
+<<change-continuation,results=hide,echo=false>>=
+options("prompt" = " ", "continue" = " ")
+@
+<<ptest-fun, keep.source=true>>=
+pt.test <- function(x, group, nperm = 199) {
+ ## mean difference function
+ meanDif <- function(i, x, grp) {
+ grp <- grp[i]
+ mean(x[grp == "Male"]) - mean(x[grp == "Female"])
+ }
+ ## check x and group are of same length
+ stopifnot(all.equal(length(x), length(group)))
+ ## number of observations
+ N <- nobs(x)
+ ## generate the required set of permutations
+ pset <- shuffleSet(N, nset = nperm)
+ ## iterate over the set of permutations applying meanDif
+ D <- apply(pset, 1, meanDif, x = x, grp = group)
+ ## add on the observed mean difference
+ D <- c(meanDif(seq_len(N), x, group), D)
+ ## compute & return the p-value
+ Ds <- sum(D >= D[1]) # how many >= to the observed diff?
+ Ds / (nperm + 1) # what proportion of perms is this (the pval)?
+}
+@
+<<reset-continuation,results=hide,echo=false>>=
+options("prompt" = "R> ", "continue" = "+ ")
+@
+
+The commented function should be reasonably self explanatory. I've altered the in-line version of the \code{meanDif()} function to take a vector of permutation indices \code{i} as the first argument, and internally the \code{grp} vector is permuted according to \code{i}. The other major change is that \code{shuffleSet()} is used to generate a set of permutations, which are then iterated over using \code{apply()}.
+
+In use we see
+<<run-ptest>>=
+set.seed(42) ## same seed as earlier
+pval <- with(jackal, pt.test(Length, Sex, nperm = 4999))
+pval
+@
+which nicely agrees with the test we did earlier by hand.
+
+Iterating over a set of permutation indices also means that adding parallel processing of the permutations requires only trivial changes to the main function code. As an illustration, below I show a parallel version of \code{pt.test()}
+
+<<change-continuation,results=hide,echo=false>>=
+options("prompt" = " ", "continue" = " ")
+@
+<<parallel-ptest-fun, keep.source=true>>=
+ppt.test <- function(x, group, nperm = 199, cores = 2) {
+ ## mean difference function
+ meanDif <- function(i, .x, .grp) {
+ .grp <- .grp[i]
+ mean(.x[.grp == "Male"]) - mean(.x[.grp == "Female"])
+ }
+ ## check x and group are of same length
+ stopifnot(all.equal(length(x), length(group)))
+ ## number of observations
+ N <- nobs(x)
+ ## generate the required set of permutations
+ pset <- shuffleSet(N, nset = nperm)
+ if (cores > 1) {
+ ## initiate a cluster
+ cl <- makeCluster(cores)
+ on.exit(stopCluster(cl = cl))
+ ## iterate over the set of permutations applying meanDif
+ D <- parRapply(cl, pset, meanDif, .x = x, .grp = group)
+ } else {
+ D <- apply(pset, 1, meanDif, .x = x, .grp = group)
+ }
+ ## add on the observed mean difference
+ D <- c(meanDif(seq_len(N), x, group), D)
+ ## compute & return the p-value
+ Ds <- sum(D >= D[1]) # how many >= to the observed diff?
+ Ds / (nperm + 1) # what proportion of perms is this (the pval)?
+}
+@
+<<reset-continuation,results=hide,echo=false>>=
+options("prompt" = "R> ", "continue" = "+ ")
+@
+In use we observe
+<<run-pptest>>=
+require("parallel")
+set.seed(42)
+system.time(ppval <- ppt.test(jackal$Length, jackal$Sex, nperm = 9999,
+ cores = 2))
+ppval
+@
+In this case there is little to be gained by splitting the computations over two CPU cores
+<<run-pptest2>>=
+set.seed(42)
+system.time(ppval2 <- ppt.test(jackal$Length, jackal$Sex, nperm = 9999,
+ cores = 1))
+ppval2
+@
+The cost of setting up and managing the parallel processes, and recombining the separate sets of results almost negates the gain in running the permutations in parallel. Here, the computations involved in \code{meanDif()} are trivial and we would expect greater efficiencies from running the permutations in parallel for more complex analyses.
+
+\subsection{Accesing and changing permutation designs}
+Th object created by \code{how()} is a relatively simple list containing the settings for the specified permutation design. As such one could use the standard subsetting and replacement functions in base \proglang{R} to alter components of the list. This is not recommended, however, as the internal structure of the list returned by \code{how()} may change in a later version of \pkg{permute}. Furthermore, to facilitate the use of \code{update()} at the user-level to alter the permutation [...]
+
+The \code{getFoo()} functions provided by \pkg{permute} are
+
+\begin{description}
+ \item[\code{getWithin()}, \code{getPlots()}, \code{getBlocks()}]
+ these extract the details of the \emph{within}-, \emph{plots}-, and \emph{blocks}-level components of the design. Given the current design (as of \pkg{permute} version 0.8-0), the first two of these return lists with classes \code{"Within"} and \code{"Plots"}, respectively, whilst \code{getBlocks()} returns the block-level factor.
+\item[\code{getStrata()}]
+ returns the factor describing the grouping of samples at the \emph{plots} or \emph{blocks} levels, as determined by the value of argument \code{which}.
+ \item[\code{getType()}]
+ returns the type of permutation of samples at the \emph{within} or \emph{plots} levels, as determined by the value of argument \code{which}.
+ \item[\code{getMirror()}]
+ returns a logical, indicating whether permutations are drawn from the mirror image of the observed ordering at the \emph{within} or \emph{plots} levels, as determined by the value of argument \code{which}.
+ \item[\code{getConstant()}]
+ returns a logical, indicating whether the same permutation of samples, or a different permutation, is used within each of the plots.
+ \item[\code{getRow()}, \code{getCol()}, \code{getDim()}]
+ return dimensions of the spatial grid of samples at the \emph{plots} or \emph{blocks} levels, as determined by the value of argument \code{which}.
+ \item[\code{getNperm()}, \code{getMaxperm()}, \code{getMinperm()}]
+ return numerics for the stored number of permutations requested plus two triggers used when checking permutation designs via \code{check()}.
+ \item[\code{getComplete()}]
+ returns a logical, indicating whether complete enumeration of the set of permutations was requested.
+ \item[\code{getMake()}]
+ returns a logical, indicating whether the entire set of permutations should be produced or not.
+ \item[\code{getObserved()}]
+ returns a logical, which indicates whether the observed permutation (ordering of samples) is included in the entire set of permutation generated by \code{allPerms()}.
+ \item[\code{getAllperms()}]
+ extracts the complete set of permutations if present. Returns \code{NULL} if the set has not been generated.
+\end{description}
+
+The available \code{setFoo()<-} functions are
+
+\begin{description}
+ \item[\code{setPlots<-()}, \code{setWithin<-()};]
+ replaces the details of the \emph{within}-, and \emph{plots}-, components of the design. The replacement object must be of class \code{"Plots"} or \code{"Within"}, respectively, and hence is most usefully used in combination with the \code{Plots()} or \code{Within()} constructor functions.
+ \item[\code{setBlocks<-()};]
+ replaces the factor that partitions the observations into blocks. \code{value} can be any \proglang{R} object that can be coerced to a factor vector via \code{as.factor()}.
+ \item[\code{setStrata<-()};]
+ replaces either the \code{blocks} or \code{strata} components of the design, depending on what class of object \code{setStrata<-()} is applied to. When used on an object of class \code{"how"}, \code{setStrata<-()} replaces the \code{blocks} component of that object. When used on an object of class \code{"Plots"}, \code{setStrata<-()} replaces the \code{strata} component of that object. In both cases a factor variable is required and the replacement object will be coerced to a factor [...]
+ \item[\code{setType<-()};]
+ replaces the \code{type} component of an object of class \code{"Plots"} or \code{"Within"} with a character vector of length one. Must be one of the available types: \code{"none"}, \code{"free"}, \code{"series"}, or \code{"grid"}.
+ \item[\code{setMirror<-()};]
+ replaces the \code{mirror} component of an object of class \code{"Plots"} or \code{"Within"} with a logical vector of length one.
+ \item[\code{setConstant<-()};]
+ replaces the \code{constant} component of an object of class \code{"Within"} with a logical vector of length one.
+ \item[\code{setRow<-()}, \code{setCol<-()}, \code{setDim<-()};]
+ replace one or both of the spatial grid dimensions of an object of class \code{"Plots"} or \code{"Within"} with am integer vector of length one, or, in the case of \code{setDim<-()}, of length 2.
+ \item[\code{setNperm<-()}, \code{setMinperm<-()}, \code{setMaxperm<-()};]
+ update the stored values for the requested number of permutations and the minimum and maximum permutation thresholds that control whether the entire set of permutations is generated instead of \code{nperm} permutations.
+ \item[\code{setAllperms<-()};]
+ assigns a matrix of permutation indices to the \code{all.perms} component of the design list object.
+ \item[\code{setComplete<-()};]
+ updates the status of the \code{complete} setting. Takes a logical vector of length 1 or any object coercible to such.
+ \item[\code{setMake<-()};]
+ sets the indicator controlling whether the entrie set of permutations is generated during checking of the design via \code{check()}. Takes a logical vector of length 1 or any object coercible to such.
+ \item[\code{setObserved<-()};]
+ updates the indicator of whether the observed ordering is included in the set of all permutations should they be generated. Takes a logical vector of length 1 or any object coercible to such.
+\end{description}
+
+\subsubsection{Examples}
+I illustrate the behaviour of the \code{getFoo()} and \code{setFoo<-()} functions through a couple of simple examples. Firstly, generate a design object
+<<get-set-eg0>>=
+hh <- how()
+@
+This design is one of complete randomization, so all of the settings in the object take their default values. The default number of permutations is currently \Sexpr{getNperm(hh)}, and can be extracted using \code{getNperm()}
+<<get-set-eg1>>=
+getNperm(hh)
+@
+The corresponding replacement function can be use to alter the number of permutations after the design has been generated. To illustrate a finer point of the behaviour of these replacement functions, compare the matched call stored in \code{hh} before and after the number of permutations is changed
+<<<get-set-eg2>>=
+getCall(hh)
+setNperm(hh) <- 999
+getNperm(hh)
+getCall(hh)
+@
+Note how the \code{call} component has been altered to include the argument pair \code{nperm = 999}, hence if this call were evaluated, the resulting object would be a copy of \code{hh}.
+
+As a more complex example, consider the following design consisting of 5 blocks, each containing 2 plots of 5 samples each. Hence there are a total of 10 plots. Both the plots and within-plot sample are time series. This design can be created using
+<<get-set-eg3>>=
+hh <- how(within = Within(type = "series"),
+ plots = Plots(type = "series", strata = gl(10, 5)),
+ blocks = gl(5, 10))
+@
+
+To alter the design at the plot or within-plot levels, it is convenient to extract the relevant component using \code{getPlots()} or \code{getWithin()}, update the extracted object, and finally use the updated object to update \code{hh}. This process is illustrated below in order to change the plot-level permutation type to \code{"free"}
+<<get-set-eg4>>=
+pl <- getPlots(hh)
+setType(pl) <- "free"
+setPlots(hh) <- pl
+@
+We can confirm this has been changed by extracting the permutation type for the plot level
+<<get-set-eg5>>=
+getType(hh, which = "plots")
+@
+Notice too how the call has been expanded from \code{gl(10, 5)} to an integer vector. This expansion is to avoid the obvious problem of locating the objects referred to in the call should the call be re-evaluated later.
+<<get-set-eg6>>=
+getCall(getPlots(hh))
+@
+
+At the top level, a user can update the design using \code{update()}. Hence the equivalent of the above update is (this time resetting the original type; \code{type = "series"})
+<<get-set-eg7>>=
+hh <- update(hh, plots = update(getPlots(hh), type = "series"))
+getType(hh, which = "plots")
+@
+However, this approach is not assured of working within a function because we do not guarantee that components of the call used to create \code{hh} can be found from the execution frame where \code{update()} is called. To be safe, always use the \code{setFoo<-()} replacement functions to update design objects from within your functions.
\section*{Computational details}
-<<seesionInfo, results=tex>>=
-toLatex(sessionInfo())
+This vignette was built within the following environment:
+<<seesionInfo, results=tex, echo=false>>=
+toLatex(sessionInfo(), locale = FALSE)
@
\bibliography{permute}
\end{document}
diff --git a/vignettes/permute.bib b/vignettes/permute.bib
index 0bb51d0..4b2a545 100644
--- a/vignettes/permute.bib
+++ b/vignettes/permute.bib
@@ -16,3 +16,36 @@
edition = {3rd}
}
+ at Manual{canoco5manual,
+ title = {Canoco Reference Manual and User's Guide: Software for Ordination (Version 5.0)},
+ author = {ter Braak, C.J.F. and \v{S}milauer, P.},
+ organization = {Microcomputer Power},
+ Taddress = {Ithaca, NY, USA},
+ year = {2012}
+}
+
+ at Manual{vegan,
+ title = {vegan: Community Ecology Package},
+ author = {Jari Oksanen and F. Guillaume Blanchet and Roeland Kindt and Pierre Legendre and Peter R. Minchin and R. B. O'Hara and Gavin L. Simpson and Peter Solymos and M. Henry H. Stevens and Helene Wagner},
+ year = {2013},
+ note = {R package version 2.1-33},
+ url = {http://vegan.r-forge.r-project.org/}
+}
+
+ at Manual{canoco31,
+ title = {Update notes: CANOCO version 3.1},
+ author = {ter Braak, C.J.F.},
+ organization = {Wageningen: Agricultural Mathematics Group},
+ year = {1990}
+}
+
+ at Article{besagclifford,
+ author = {Besag, J. and Clifford, P.},
+ title = {Generalized Monte Carlo significance tests},
+ journal = {Biometrika},
+ year = {1989},
+ volume = {76},
+ number = {4},
+ pages = {633--642}
+}
+
--
Alioth's /git/debian-med/git-commit-notice on /srv/git.debian.org/git/debian-med/permute.git
More information about the debian-med-commit
mailing list