[med-svn] [permute] 01/07: Imported Upstream version 0.9-0
Andreas Tille
tille at debian.org
Mon Aug 8 07:44:50 UTC 2016
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository permute.
commit 6808f9c9d0ca66569953957b98a403f2b76050eb
Author: Andreas Tille <tille at debian.org>
Date: Mon Aug 8 09:15:47 2016 +0200
Imported Upstream version 0.9-0
---
DESCRIPTION | 21 +-
MD5 | 92 +++----
NAMESPACE | 37 +--
R/Blocks.R | 6 -
R/allPerms.R | 14 +-
R/allStrata.R | 10 +-
R/as.matrix.allPerms.R | 6 +
R/blocks.R | 40 +++
R/check.R | 27 +-
R/fixupCall.R | 10 +-
R/getFoo-methods.R | 129 +--------
R/how.R | 6 +-
R/nobs-methods.R | 3 +
R/numPerms.R | 20 +-
R/permCheck.R | 5 -
R/permuplot.R | 198 --------------
R/permute-deprecated.R | 43 ---
R/permute.R | 15 +-
R/print.how.R | 2 +-
R/print.permutationMatrix.R | 5 +-
R/setFoo-methods.R | 82 +-----
R/shuffle-utils.R | 5 +-
R/shuffle.R | 146 ++++++----
R/shuffle2.R | 122 ---------
R/shuffleSet.R | 216 +++++++++++----
R/shuffleSet2.R | 205 --------------
README.md | 33 +++
build/vignette.rds | Bin 230 -> 226 bytes
data/jackal.rda | Bin 233 -> 233 bytes
inst/ChangeLog | 58 +++-
inst/NEWS | 97 +++++++
inst/NEWS.Rd | 86 ------
inst/doc/permutations.R | 10 +-
inst/doc/permutations.Rnw | 12 +-
inst/doc/permutations.pdf | Bin 315861 -> 312060 bytes
inst/tests/test-allPerms.R | 127 ---------
inst/tests/test-shuffleSet.R | 42 ---
man/allPerms.Rd | 10 +
man/check.Rd | 112 ++++----
man/how.Rd | 10 +-
man/permCheck-deprecated.Rd | 66 -----
man/permControl-deprecated.Rd | 82 ------
man/permute-deprecated.Rd | 25 --
man/shuffleSet.Rd | 20 +-
tests/Examples/permute-Ex.Rout.save | 370 +++++++++++---------------
tests/{test-all.R => testthat.R} | 6 +-
tests/testthat/test-allPerms.R | 289 ++++++++++++++++++++
tests/testthat/test-as-methods.R | 18 ++
tests/testthat/test-blocks.R | 11 +
{inst/tests => tests/testthat}/test-check.R | 15 +-
tests/testthat/test-get-methods.R | 22 ++
tests/testthat/test-how.R | 14 +
tests/testthat/test-nobs.R | 34 +++
tests/testthat/test-numPerms.R | 12 +
tests/testthat/test-permute-fun.R | 35 +++
tests/testthat/test-set-methods.R | 171 ++++++++++++
tests/testthat/test-shuffle-utils.R | 64 +++++
{inst/tests => tests/testthat}/test-shuffle.R | 14 +-
tests/testthat/test-shuffleSet.R | 85 ++++++
vignettes/Z.cls | 247 -----------------
vignettes/permutations.Rnw | 12 +-
61 files changed, 1711 insertions(+), 1963 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index e1f8849..0b5d773 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
Package: permute
-Title: Functions for generating restricted permutations of data
-Version: 0.8-3
-Date: $Date$
+Title: Functions for Generating Restricted Permutations of Data
+Version: 0.9-0
+Date: 2016-01-24
Authors at R: c(person(given = "Gavin L.", family = "Simpson",
email = "ucfagls at gmail.com",
role = c("aut", "cph", "cre")),
@@ -9,21 +9,20 @@ Authors at R: c(person(given = "Gavin L.", family = "Simpson",
person(given = "Douglas M.", family = "Bates", role = "ctb"),
person(given = "Jari", family = "Oksanen", role = "ctb"))
Depends: R (>= 2.14.0)
+Imports: stats
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.
+Description: A set of restricted permutation designs for freely exchangeable, line transects (time series), and spatial grid designs plus permutation of blocks (groups of samples) is provided. '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/
+URL: https://github.com/gavinsimpson/permute
+BugReports: https://github.com/gavinsimpson/permute/issues
Copyright: see file COPYRIGHTS
+NeedsCompilation: no
+Packaged: 2016-01-24 20:09:19 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>
Repository: CRAN
-Repository/R-Forge/Project: vegan
-Repository/R-Forge/Revision: 2847
-Repository/R-Forge/DateTimeStamp: 2014-01-28 04:02:29
-Date/Publication: 2014-01-29 21:24:58
-Packaged: 2014-01-28 07:15:34 UTC; rforge
-NeedsCompilation: no
+Date/Publication: 2016-01-24 21:39:11
diff --git a/MD5 b/MD5
index 58e639d..d6cd925 100644
--- a/MD5
+++ b/MD5
@@ -1,71 +1,73 @@
-c8e7612a0a63f74c04b864ce70dc8103 *DESCRIPTION
-df79e949fde5fcf8262c64f61a36f563 *NAMESPACE
-e868a91139fab764feebbf3590eb46e6 *R/Blocks.R
+436912ba0ea62e22c5099ab3155e2f67 *DESCRIPTION
+0c18ae4d20cc83a0eea1ccc5227a1aab *NAMESPACE
0d94016b600ddfd39087b8d41228ddb7 *R/Plots.R
40da812fd0c1530aa117d1677f707023 *R/Within.R
065086f18b59986e5feb8a6598b78632 *R/allFree.R
af6ec0ff884e97781072c6db2cdeb61b *R/allGrid.R
-8c9de52dc4507f15c1a8713b5544fd2a *R/allPerms.R
+eef691f8022c0ca850034f53a6263da8 *R/allPerms.R
ed8d66f8de2f14fdee5ee0b4d7ca450e *R/allSeries.R
-bfa5e00be181d197cab7b720faf825ef *R/allStrata.R
+648a6fde01b25b284184dc1827c4264f *R/allStrata.R
+a76f0fdcb2d2f8c776f3846b3c41d26a *R/as.matrix.allPerms.R
23435563d36be42bbd71da36581a78af *R/as.matrix.permutationMatrix.R
+0677bca1862f33eb1cc957d9d435a667 *R/blocks.R
8776e79c375b73cb5da9a72d507a6310 *R/cbindAllPerms.R
-0b60312db5f277cc855239bfdf7ca3e1 *R/check.R
-ab185e9fba9867b4e39969b331a7fcbc *R/fixupCall.R
-ea0fed2f27a9ad36ffc707ede2837a00 *R/getFoo-methods.R
-70987c298dc5bd539345d854cff06c71 *R/how.R
-5c0164d1116a52ccac18237646906012 *R/nobs-methods.R
-1bd99a763d1860c56049b1a9dc7100d2 *R/numPerms.R
-ec731b7d6b7ff91448b57b4d82f14237 *R/permCheck.R
-2e888232c4b979f8e69de7ebd971a44f *R/permuplot.R
-49523a7b7e624d90cf2a14eb5db24697 *R/permute-deprecated.R
-1748de64355e7f946768c92431e730d1 *R/permute.R
+caaacb60634fb8d89e4e4e38cab9d14f *R/check.R
+b425906bbec143e8e99ecce43dddc2af *R/fixupCall.R
+4aca181e15fc6804acd013afaa46deb9 *R/getFoo-methods.R
+253585e8aab94e4cec4dac4265591b35 *R/how.R
+756bdc23a5b3e996c3a6b6d9282ccfc4 *R/nobs-methods.R
+4ecbcd7cf18cfcbfa6d232506ac8522b *R/numPerms.R
+b7ffedd8632192ce56b95b15d7c87107 *R/permute.R
21a2adbee470ca86648b7ac0e9fd5d51 *R/print.allPerms.R
4b69356047dd015dd5f7f1018b76bdfb *R/print.check.R
-5c7503adad7720bf6270e9c767b3919d *R/print.how.R
-04a88532586e8f7b20dfca3697444184 *R/print.permutationMatrix.R
+d91d44308c82453d9d2466a70cc7157e *R/print.how.R
+ac687a3095ebd55719f7bb5eaf12b51d *R/print.permutationMatrix.R
ad976cbddacaaaebd1e3b5a6f4eba771 *R/print.summary.allPerms.R
eb6d20a84325371ed25f56333a1286f0 *R/print.summary.check.R
-ba89b1916be6bb7dca85db896f17ed97 *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
+d8dd28f2c0cf92aecb46015553b2a89b *R/setFoo-methods.R
+52a6d4a315ddca402855225d6c1fef20 *R/shuffle-utils.R
+9f1b7512c6b1941d0b0310203f967e31 *R/shuffle.R
+3739c591e3479196ba5cf86b50a1beba *R/shuffleSet.R
6c98b1afeb08eef934cc6d25557c8812 *R/summary.allPerms.R
1452820ef3677a4cc68fc27837f67ee3 *R/summary.check.R
33064923b08d1e65469449f32b0f2797 *R/update.Plots.R
3a2a885a7705cee2fd97ecc1a7238b12 *R/update.how.R
-caa68989ef55fad314f0a42b5404b8ba *build/vignette.rds
-32e245d3377acee42723730435dac8ea *data/jackal.rda
+c45f6eabfee9ed95283900f903d42d85 *README.md
+eeffbe21b9603fe1ca94f27efd1eb311 *build/vignette.rds
+4d966dbdda958c863064462aeb589708 *data/jackal.rda
aa947360198890f9a747920d52cf52c2 *inst/COPYRIGHTS
-981143d625263b8bd8379c18b3eb4500 *inst/ChangeLog
-f18d13fa109c9f1313a2164ee057d358 *inst/NEWS.Rd
+715f4709431446f0340a99571e8bfab2 *inst/ChangeLog
+c70448b2af94bb4c2ab538cbd7e2c88d *inst/NEWS
bbb242b30032dba5f5a775dc43e91bf7 *inst/TODO.md
-37b4278adbb6c6106e2cfe5be5de0840 *inst/doc/permutations.R
-82da16c514a05f417eb5a67d36270221 *inst/doc/permutations.Rnw
-e5d809af130e40a08ba38ff89286e79a *inst/doc/permutations.pdf
-810129beac4ad79366a1936d2b92c331 *inst/tests/test-allPerms.R
-712bed4b9184a5857cb8633574a70a87 *inst/tests/test-check.R
-8714401ccd2ba7fff8f5d423fdb700be *inst/tests/test-shuffle.R
-d0c240b14dca251488275ea5f84e5110 *inst/tests/test-shuffleSet.R
-b18d0e616c9d323942bec8f7fbd63250 *man/allPerms.Rd
+9ac113bce6d1568275ed91f8034f202d *inst/doc/permutations.R
+fa5e887f5bef256943271e0040cd00fa *inst/doc/permutations.Rnw
+ff7b460b62eaa710be245506060ad800 *inst/doc/permutations.pdf
+d4596abecaf914b74f908a07d22c11f7 *man/allPerms.Rd
ae17a2363ef92ad5cfb7c9704b4fc130 *man/allUtils.Rd
-9aed0a0fe3de6e2c9845a70a853e4126 *man/check.Rd
+83cd451efb597d331da312f99138653f *man/check.Rd
1abaaa3ab73cf3f4e3e88eb596a7c57c *man/get-methods.Rd
-18230c2b006cbfa973f4bd825efaff4c *man/how.Rd
+6495971db0de15e8704f4d61cfdb95b0 *man/how.Rd
66c4ad89b8c8035bbc74ed3558e961bb *man/jackal.Rd
e54c2a3be916e7fa0813b0a5f93f6dc3 *man/nobs.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
-74a1cad479e409192c045657b5801607 *tests/Examples/permute-Ex.Rout.save
-8f3e383676a96e96a4f5e56e93c6e131 *tests/test-all.R
-51dfb25079d9f14d40896092d96e277d *vignettes/Z.cls
-82da16c514a05f417eb5a67d36270221 *vignettes/permutations.Rnw
+e30d5d2985c1c813da631b207c88a477 *man/shuffleSet.Rd
+f1fca1527376db805c3ff0d657914e82 *tests/Examples/permute-Ex.Rout.save
+08783b766dfc54380636442d03904b6d *tests/testthat.R
+5540a364d030860557c56e8cd2bfca00 *tests/testthat/test-allPerms.R
+404c87ce88ee7ca03e004d4ae63f6b61 *tests/testthat/test-as-methods.R
+30070f3612c7b30f9c8cb625b6483fc9 *tests/testthat/test-blocks.R
+985bc4c319198c23ffcf50c86d22644e *tests/testthat/test-check.R
+5ffe6bcc3c15be11fe170344e7ee594e *tests/testthat/test-get-methods.R
+c65c4cbe326af9909e073fd8edab589a *tests/testthat/test-how.R
+58903fd04318f75eb58d0fe866527c71 *tests/testthat/test-nobs.R
+ae8b59b15b475c35de5708122c6d76ab *tests/testthat/test-numPerms.R
+300c4b5409a9464a382d2033aff83d36 *tests/testthat/test-permute-fun.R
+76b1d7cab5b4a9e789429ef6d1843c06 *tests/testthat/test-set-methods.R
+066fd0fbc9118a35bb88389754d8690e *tests/testthat/test-shuffle-utils.R
+c2a76189e1a1faf058846c83968c3026 *tests/testthat/test-shuffle.R
+fa0793af2607895b7768f643135b50fb *tests/testthat/test-shuffleSet.R
+fa5e887f5bef256943271e0040cd00fa *vignettes/permutations.Rnw
04ffc25b51d75204407f0852dd597bf8 *vignettes/permute.bib
diff --git a/NAMESPACE b/NAMESPACE
index d80b953..e8f0046 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -21,8 +21,6 @@ export("allPerms",
"getAllperms",
"how",
"numPerms",
- "permCheck",
- "permControl",
"permute",
"Plots",
"setBlocks<-",
@@ -59,7 +57,12 @@ if (getRversion() >= "2.13.0") {
export(nobs)
}
+### After R 3.2.x, R-Devel required all non-Base functions to be
+### imported
+importFrom("stats", "getCall", "runif", "update")
+
### S3 Methods
+S3method("as.matrix", "allPerms")
S3method("as.matrix", "permutationMatrix")
S3method("update", "how")
S3method("update", "Plots")
@@ -67,7 +70,6 @@ S3method("update", "Plots")
S3method("print", "allPerms")
S3method("print", "check")
S3method("print", "how")
-S3method("print", "permControl")
S3method("print", "permutationMatrix")
S3method("print", "summary.allPerms")
S3method("print", "summary.check")
@@ -79,59 +81,46 @@ S3method("nobs", "numeric")
S3method("nobs", "integer")
S3method("nobs", "matrix")
S3method("nobs", "data.frame")
+S3method("nobs", "factor")
## getFoo methods
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")
@@ -144,7 +133,6 @@ S3method("getAllperms", "how")
## setFoo methods
S3method("setBlocks<-", "default")
S3method("setBlocks<-", "how")
-S3method("setBlocks<-", "permControl")
S3method("setPlots<-", "default")
S3method("setPlots<-", "how")
S3method("setWithin<-", "default")
@@ -166,28 +154,27 @@ 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("setRow<-", "Within")
+S3method("setRow<-", "Plots")
S3method("setCol<-", "default")
S3method("setCol<-", "how")
+S3method("setCol<-", "Within")
+S3method("setCol<-", "Plots")
S3method("setDim<-", "default")
S3method("setDim<-", "how")
+S3method("setDim<-", "Within")
+S3method("setDim<-", "Plots")
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
deleted file mode 100644
index 3bc442e..0000000
--- a/R/Blocks.R
+++ /dev/null
@@ -1,6 +0,0 @@
-`Blocks` <- function(strata = NULL) {
- out <- list(strata = strata)
- ## keep as list for now
- ##class(out) <- "Blocks"
- out
-}
diff --git a/R/allPerms.R b/R/allPerms.R
index 985c07e..80eb0a5 100644
--- a/R/allPerms.R
+++ b/R/allPerms.R
@@ -70,7 +70,7 @@
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, ]
+ out <- out[!obs.row, , drop = FALSE]
## reduce the number of permutations to get rid of the
## observed ordering
setNperm(control) <- getNperm(control) - 1
@@ -187,7 +187,7 @@
## permuting blocks AND within blocks
## need a local CONTROL that just permutes blocks
controlP <- how(plots = Plots(strata = strataP, type = typeP),
- within = Within(type = "none"))
+ within = Within(type = "none", constant = constantW))
## FIXME - the above should really only need to update
## within as shown, not fiddle with Plots
@@ -199,11 +199,11 @@
## 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))
+ function(k, wi, bl) {
+ t(apply(wi[[k]], 1,
+ function(x, bl, kk) {
+ x[bl[kk,]]
+ }, bl = bl, kk = k))
},
wi = resP, bl = shuffP)
res <- do.call(rbind, resP)
diff --git a/R/allStrata.R b/R/allStrata.R
index 89fd89a..b423b2c 100644
--- a/R/allStrata.R
+++ b/R/allStrata.R
@@ -32,9 +32,11 @@
return(v)
}
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,]]))
+ ## build permutations by permuting the split indices (as list)
+ ## then undo the original splitting. This respects original indices
+ ## of the samples, even where strata ar not contiguous
+ for(i in seq_len(nrow(perms))) {
+ X[i, ] <- unsplit(sp[perms[i, ]], strata)
+ }
X
}
diff --git a/R/as.matrix.allPerms.R b/R/as.matrix.allPerms.R
new file mode 100644
index 0000000..d0ac1aa
--- /dev/null
+++ b/R/as.matrix.allPerms.R
@@ -0,0 +1,6 @@
+`as.matrix.allPerms` <- function(x, ...) {
+ attr(x, "control") <- NULL
+ attr(x, "observed") <- NULL
+ class(x) <- "matrix"
+ x
+}
diff --git a/R/blocks.R b/R/blocks.R
new file mode 100644
index 0000000..0ba2da8
--- /dev/null
+++ b/R/blocks.R
@@ -0,0 +1,40 @@
+### Extractor, replacement functions for blocks
+
+### Extractor methods
+`blocks` <- function(object, ...) {
+ UseMethod("blocks")
+}
+
+`blocks.default` <- function(object, ...) {
+ stop("No default method for 'blocks()'")
+}
+
+`blocks.how` <- function(object, ...) {
+ object$blocks
+}
+
+### Replacement methods
+`blocks<-` <- function(object, value) {
+ UseMethod("setBlocks<-")
+}
+
+`blocks<-.default` <- function(object, value) {
+ stop("No default method for `setBlocks`")
+}
+
+`blocks<-.how` <- function(object, value) {
+ object[["blocks.name"]] <- deparse(substitute(value))
+ if (!is.null(value))
+ value <- as.factor(value)
+ object["blocks"] <- list(value)
+ object <- fixupCall(object, "blocks", value)
+ object
+}
+
+### Temporarily drop this here
+`Blocks` <- function(strata = NULL) {
+ out <- list(strata = strata)
+ ## keep as list for now
+ ##class(out) <- "Blocks"
+ out
+}
diff --git a/R/check.R b/R/check.R
index 41c28a5..45411d3 100644
--- a/R/check.R
+++ b/R/check.R
@@ -1,5 +1,11 @@
`check` <- function(object, control = how(), quietly = FALSE)
{
+ ## In pricinple we are mainly dealing with integers, but many
+ ## functions do not return integers but double, and the numbers
+ ## can be so large that they overflow integer and they really must be
+ ## double. Therefore we define EPS as a nice value between two
+ ## successive integers
+ EPS <- 0.5
## if object is numeric or integer and of length 1,
## extend the object
if(length(object) == 1 &&
@@ -13,6 +19,11 @@
typeW <- getType(control, which = "within")
typeP <- getType(control, which = "plots")
+ ## check we're actually permuting something
+ if (identical(typeW, typeP) && isTRUE(all.equal(typeW, "none"))) {
+ stop("Permutation 'type' is \"none\" for both 'plots' & 'within'.\nNothing to permute.")
+ }
+
## strata at plot & block levels
plots <- getStrata(control, which = "plots")
blocks <- getStrata(control, which = "blocks")
@@ -65,19 +76,21 @@
## get number of possible permutations
num.pos <- numPerms(object, control)
- ## check if number requested permutations exceeds max possible
- if(getNperm(control) > num.pos) {
+ ## check if number requested permutations exceeds or equals max
+ ## possible
+ nperm <- getNperm(control)
+ if(nperm + EPS > (num.pos - !getObserved(control))) {
setComplete(control) <- TRUE
- setNperm(control) <- num.pos
setMaxperm(control) <- num.pos
+ setNperm(control) <- num.pos - !getObserved(control)
if(!quietly)
- message("'nperm' > set of all permutations; Resetting 'nperm'.")
+ message("'nperm' >= set of all permutations: complete enumeration.")
}
- ## if number of possible perms < minperm turn on complete enumeration
- if((num.pos < getMinperm(control))) {
+ ## if number of possible perms < minperm turn on complete
+ ## enumeration
+ if((num.pos - !getObserved(control)) < getMinperm(control) + EPS) {
setComplete(control) <- TRUE
- setNperm(control) <- num.pos
setMaxperm(control) <- num.pos
if(!quietly)
message("Set of permutations < 'minperm'. Generating entire set.")
diff --git a/R/fixupCall.R b/R/fixupCall.R
index f3a9752..395bfea 100644
--- a/R/fixupCall.R
+++ b/R/fixupCall.R
@@ -5,7 +5,15 @@
.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
+ ## if element not in names need to create it
+ if (! element %in% names(.ll)) {
+ new <- list(value)
+ names(new) <- element
+ .ll <- c(.ll, new)
+ } else {
+ ## otherwise just update it
+ .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 c1e7296..b39daf8 100644
--- a/R/getFoo-methods.R
+++ b/R/getFoo-methods.R
@@ -10,10 +10,6 @@
stop("No default method for 'getBlocks()'")
}
-`getBlocks.permControl` <- function(object, ...) {
- object$blocks
-}
-
`getBlocks.how` <- function(object, ...) {
object$blocks
}
@@ -27,10 +23,6 @@
stop("No default method for 'getPlots()'")
}
-`getPlots.permControl` <- function(object, ...) {
- object$plots
-}
-
`getPlots.how` <- function(object, ...) {
object$plots
}
@@ -44,10 +36,6 @@
stop("No default method for 'getWithin()'")
}
-`getWithin.permControl` <- function(object, ...) {
- object$within
-}
-
`getWithin.how` <- function(object, ...) {
object$within
}
@@ -61,20 +49,6 @@
stop("No default method for 'getStrata()'")
}
-`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, ...) {
@@ -106,18 +80,6 @@
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)
@@ -131,11 +93,11 @@
}
`getType.Within` <- function(object, ...) {
- object$within$type
+ object$type
}
`getType.Plots` <- function(object, ...) {
- object$plots$type
+ object$type
}
## suppose we can also have setBlocks() etc...
@@ -150,18 +112,6 @@
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)
@@ -175,11 +125,11 @@
}
`getMirror.Within` <- function(object, ...) {
- object$within$mirror
+ object$mirror
}
`getMirror.Plots` <- function(object, ...) {
- object$plots$mirror
+ object$mirror
}
## Get constant status - i.e. same permutation in each Plot
@@ -191,16 +141,12 @@
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
+ object$constant
}
## Get the number of rows and colums from grid designs
@@ -212,18 +158,6 @@
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)
@@ -237,11 +171,11 @@
}
`getRow.Within` <- function(object, ...) {
- object$within$nrow
+ object$nrow
}
`getRow.Plots` <- function(object, ...) {
- object$plots$nrow
+ object$nrow
}
`getCol` <- function(object, ...) {
@@ -252,18 +186,6 @@
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)
@@ -277,11 +199,11 @@
}
`getCol.Within` <- function(object, ...) {
- object$within$ncol
+ object$ncol
}
`getCol.Plots` <- function(object, ...) {
- object$plots$ncol
+ object$ncol
}
`getDim` <- function(object, ...) {
@@ -292,23 +214,6 @@
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)
@@ -343,10 +248,6 @@
stop("No default method for `getNperm`")
}
-`getNperm.permControl` <- function(object, ...) {
- object$nperm
-}
-
`getNperm.how` <- function(object, ...) {
object$nperm
}
@@ -360,10 +261,6 @@
stop("No default method for `getMaxperm`")
}
-`getMaxperm.permControl` <- function(object, ...) {
- object$maxperm
-}
-
`getMaxperm.how` <- function(object, ...) {
object$maxperm
}
@@ -377,10 +274,6 @@
stop("No default method for `getMinperm`")
}
-`getMinperm.permControl` <- function(object, ...) {
- object$minperm
-}
-
`getMinperm.how` <- function(object, ...) {
object$minperm
}
@@ -394,10 +287,6 @@
stop("No default method for `getComplete`")
}
-`getComplete.permControl` <- function(object, ...) {
- object$complete
-}
-
`getComplete.how` <- function(object, ...) {
object$complete
}
diff --git a/R/how.R b/R/how.R
index 1e9f299..adf7c35 100644
--- a/R/how.R
+++ b/R/how.R
@@ -4,7 +4,7 @@
nperm = 199,
complete = FALSE,
maxperm = 9999,
- minperm = 99,
+ minperm = 5040,
all.perms = NULL,
make = TRUE,
observed = FALSE) {
@@ -22,7 +22,9 @@
## 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())
+ if(!is.null(.ll[[i]])) {
+ .ll[[i]] <- eval(.ll[[i]], parent.frame())
+ }
}
}
diff --git a/R/nobs-methods.R b/R/nobs-methods.R
index 5432a3e..f43ab05 100644
--- a/R/nobs-methods.R
+++ b/R/nobs-methods.R
@@ -19,3 +19,6 @@ if (getRversion() < "2.13.0")
NROW(object)
}
+`nobs.factor` <- function(object, ...) {
+ length(object)
+}
diff --git a/R/numPerms.R b/R/numPerms.R
index 58e9a11..0f8977d 100644
--- a/R/numPerms.R
+++ b/R/numPerms.R
@@ -69,7 +69,7 @@
if(isTRUE(all.equal(typeP, "grid")) && !is.null(colP) && colP > 2) {
mult.p <- 4
} else {
- if(isTRUE(all.equal(n, 2)))
+ if(isTRUE(all.equal(length(tab), 2))) # was all.equal(n, 2)
mult.p <- 1
}
}
@@ -117,9 +117,9 @@
exp(lfactorial(length(levels(PSTRATA))))
} else if(typeP %in% c("series", "grid")) {
if(isTRUE(mirrorP)) {
- mult.p * n
+ mult.p * length(tab)
} else {
- n
+ length(tab)
}
} else {
1
@@ -151,15 +151,17 @@
}
} else {
if(mirrorW) {
- if(constantW)
- mult.wi * unitab
- else
+ if(constantW) {
+ mult.wi * unitab[1]
+ } else {
prod(mult.wi * tab)
+ }
} else {
- if(constantW)
- unitab ## FIXME: unitab[1]?? (unique(tab)[1])
- else
+ if(constantW) {
+ unitab[1] ## FIXME: unitab[1]?? (unique(tab)[1])
+ } else {
prod(tab)
+ }
}
}
} else {
diff --git a/R/permCheck.R b/R/permCheck.R
deleted file mode 100644
index 673d8f9..0000000
--- a/R/permCheck.R
+++ /dev/null
@@ -1,5 +0,0 @@
-## deprecate check
-`permCheck` <- function(object, control = how()) {
- .Deprecated(new = "check", "permute")
- check(object = object, control = control)
-}
diff --git a/R/permuplot.R b/R/permuplot.R
deleted file mode 100644
index de0a119..0000000
--- a/R/permuplot.R
+++ /dev/null
@@ -1,198 +0,0 @@
-## This is totally wrong and needs updating to match the new
-## code in permute...
-`permuplot` <- function(n, control = how(),
- col = par("col"),
- hcol = "red",
- shade = "lightgrey",
- xlim=NULL, ylim=NULL,
- inset = 0.1,
- main=NULL, sub=NULL,
- 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))
- y <- rev(sin(angle))
- xy <- xy.coords(x, y)
- return(xy)
- }
- xy.free <- function(n) {
- x <- runif(n)
- y <- runif(n)
- xy <- xy.coords(x, y)
- return(xy)
- }
- xy.grid <- function(ncol, nrow) {
- x <- rep(seq_len(ncol), each = nrow)
- y <- rev(rep(seq_len(nrow), times = ncol))
- xy <- xy.coords(x, y)
- return(xy)
- }
- axis.limits <- function(vals, inset) {
- lim <- range(vals[is.finite(vals)])
- lim.range <- lim[2] - lim[1]
- res <- c(lim[1] - (lim.range * inset),
- lim[2] + (lim.range * inset))
- return(res)
- }
- ## currently doesn't support restricted permutations of strata themselves
- if(control$permute.strata && control$type != "free")
- stop("Restricted permutations of strata currently not supported")
- ## check that n and length of strata are equal
- if( use.strata <- !is.null(control$strata) ) {
- tab <- table(control$strata)
- if(!identical(as.integer(sum(tab)), as.integer(n)))
- stop("'n' and length of 'strata' don't match.")
- }
- ## check the control design
- control <- check(n, control = control)$control
- if(use.strata) {
- n.grp <- length(tab)
- opar <- par(no.readonly=TRUE, mar=c(2,2,2,1)+0.1,
- mfrow = n2mfrow(n.grp),
- oma=c(2.1,0,3.1,0))
- on.exit(par(opar))
- ## if permuting strata, only need to draw the sub-plots
- ## in a different order
- if(control$permute.strata) {
- ## expand shade, col
- if(identical(length(col), 1))
- col <- rep(col, n.grp)
- if(identical(length(shade), 1))
- shade <- rep(shade, n.grp)
- ord <- sample(names(tab))
- if(is.null(xlim))
- xlim <- c(0,1)
- if(is.null(ylim))
- ylim <- c(0,1)
- xy <- xy.coords(0.5, 0.5)
- string <- paste("Stratum:\n", ord)
- names(string) <- ord
- strh <- max(strheight(string, cex = cex))
- strw <- max(strwidth(string, cex = cex))
- box.coords <- xy.coords(rep(c(0.5-strw, 0.5+strw), each = 2),
- c(0.5-strh, 0.5+strh,
- 0.5+strh, 0.5-strh))
- for(i in ord) {
- plot.new()
- plot.window(xlim, ylim, asp = 1, ...)
- polygon(box.coords, col = shade, border = hcol, ...)
- text(xy$x, xy$y, labels = string[i],
- col = col, cex = cex, ...)
- box()
- #if(ann) {
- # title(main = paste("Original order:",
- # which(ord == i)))
- #}
- }
- } else {
- ## if free and constant, only need one set of random coords
- xy <- if(control$constant && control$type == "free") {
- ## needs to be a list for the main loop below
- xy <- xy.free(unique(tab))
- res <- vector("list", length = length(tab))
- for(i in seq_along(res)) {
- res[[i]] <- xy
- }
- res
- } else {
- switch(control$type,
- free = lapply(tab, xy.free),
- series = lapply(tab, xy.series),
- grid = lapply(tab, function(x) {
- xy.grid(control$ncol, control$nrow)
- }),
- stop("Unsupport permutation 'type'"))
- }
- perms <- shuffle(n, control = control)
- perms <- tapply(perms, control$strata, function(x) x)
- if(is.null(main))
- main <- paste("Stratum:", names(tab))
- for(i in seq_along(xy)) {
- if(is.null(xlim))
- xlim <- axis.limits(xy[[i]]$x, inset)
- if(is.null(ylim))
- ylim <- axis.limits(xy[[i]]$y, inset)
- plot.new()
- plot.window(xlim, ylim, asp = 1, ...)
- cols <- switch(control$type,
- free = rep(col, tab[i]),
- series = c(hcol, rep(col, tab[i]-1)),
- grid = {cols <- rep(col, tab[i])
- cols[which.min(perms[[i]])] <-
- hcol
- cols})
- text(xy[[i]]$x, xy[[i]]$y, labels = perms[[i]],
- col = cols, ...)
- if(ann) {
- title(main = main[i], ...)
- title(sub = paste("n in stratum:", tab[i]),
- line = 0.5, ...)
- }
- box()
- }
- }
- if(ann) {
- sub <- paste(paste("n: ", n, ";", sep = ""),
- paste("mirror: ", control$mirror, ";",
- sep = ""),
- paste("constant: ", control$constant, ";",
- sep = ""),
- sep = " ")
- if(control$type == "grid")
- sub <- paste(sub, paste("ncol: ",
- control$ncol, ";",
- sep = ""),
- paste("nrow: ", control$nrow, ";",
- sep = ""),
- sep = " ")
- title(main = paste("Permutation type:", control$type),
- outer = TRUE, cex.main = 1.75, ...)
- title(sub = sub, outer = TRUE, line = 0.5,
- cex.sub = 1, ...)
- }
- } else {
- xy <- switch(control$type,
- free = xy.free(n),
- series = xy.series(n),
- grid = xy.grid(control$ncol, control$nrow),
- stop("Unsupport permutation 'type'"))
- if(is.null(xlim)) {
- xlim <- axis.limits(xy$x, inset)
- }
- if(is.null(ylim)) {
- ylim <- axis.limits(xy$y, inset)
- }
- opar <- par(no.readonly=TRUE, mar=c(2,1,3,1)+0.1)
- on.exit(par(opar))
- if(is.null(main))
- main <- paste("Permutation type:", control$type)
- if(is.null(sub))
- sub <- paste(paste("n: ", n, ";", sep = ""),
- paste("mirror: ", control$mirror, ";",
- sep = ""),
- sep = " ")
- plot.new()
- plot.window(xlim, ylim, asp = 1, ...)
- labs <- shuffle(n, control=control)
- cols <- switch(control$type,
- free = rep(col, n),
- series = c(hcol, rep(col, n-1)),
- grid = {cols <- rep(col, n)
- cols[which.min(labs)] <- hcol
- cols})
- text(xy$x, xy$y, labels = labs,
- col = cols, ...)
- if(ann) {
- title(main = main, ...)
- title(sub = sub, line = 0.5, ...)
- }
- box()
- }
- invisible()
-}
diff --git a/R/permute-deprecated.R b/R/permute-deprecated.R
deleted file mode 100644
index 3346def..0000000
--- a/R/permute-deprecated.R
+++ /dev/null
@@ -1,43 +0,0 @@
-`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 516b740..c09264c 100644
--- a/R/permute.R
+++ b/R/permute.R
@@ -1,10 +1,13 @@
-permute <- function(i, n, control) {
- if(control$complete && !is.null(control$all.perms))
- perm <- control$all.perms[i,]
- else {
- if(control$complete)
+`permute` <- function(i, n, control) {
+ complete <- getComplete(control)
+ ap <- getAllperms(control)
+ perm <- if (complete && !is.null(ap)) {
+ ap[i, ] # select ith permutation
+ } else {
+ if (complete) {
warning("'$all.perms' is NULL, yet '$complete = TRUE'.\nReturning a random permutation.")
- perm <- shuffle(n, control)
+ }
+ shuffle(n, control)
}
perm
}
diff --git a/R/print.how.R b/R/print.how.R
index f78c791..ec87529 100644
--- a/R/print.how.R
+++ b/R/print.how.R
@@ -77,7 +77,7 @@
## Meta data
writeLines("Permutation details:")
- writeLines(strwrap(paste("Number of permutations requested:",
+ writeLines(strwrap(paste("Number of permutations:",
getNperm(x)), prefix = pfix))
writeLines(strwrap(paste("Max. number of permutations allowed:",
getMaxperm(x)), prefix = pfix))
diff --git a/R/print.permutationMatrix.R b/R/print.permutationMatrix.R
index 97aaa20..3844cdf 100644
--- a/R/print.permutationMatrix.R
+++ b/R/print.permutationMatrix.R
@@ -10,6 +10,7 @@
blocks <- getBlocks(ctrl)
plots <- getPlots(ctrl)
+ strata <- getStrata(ctrl)
## print out dimensions of permutation matrix
msg <- paste("No. of Permutations: ", nrow(x), sep = "")
@@ -17,7 +18,7 @@
## print info on the within level
msg <- paste("No. of Samples:", ncol(x), "(")
- if (any(pl <- !is.null(plots), bl <- !is.null(blocks))) {
+ if (any(pl <- !is.null(strata), bl <- !is.null(blocks))) {
msg <- paste(msg, "Nested in: ", sep = "")
if (pl && !bl) {
nmsg <- "plots; "
@@ -80,5 +81,7 @@
cat("\n")
x <- as.matrix(x)
+ rownames(x) <- paste0("p", seq_len(nrow(x)))
+ colnames(x) <- seq_len(ncol(x))
print(x, ...)
}
diff --git a/R/setFoo-methods.R b/R/setFoo-methods.R
index 008c7fd..a73e6cc 100644
--- a/R/setFoo-methods.R
+++ b/R/setFoo-methods.R
@@ -14,12 +14,6 @@
object
}
-`setNperm<-.permControl` <- function(object, value) {
- object[["nperm"]] <- value
- object <- fixupCall(object, "nperm", value)
- object
-}
-
`setMaxperm<-` <- function(object, value) {
UseMethod("setMaxperm<-")
}
@@ -34,12 +28,6 @@
object
}
-`setMaxperm<-.permControl` <- function(object, value) {
- object[["maxperm"]] <- value
- object <- fixupCall(object, "maxperm", value)
- object
-}
-
`setMinperm<-` <- function(object, value) {
UseMethod("setMinperm<-")
}
@@ -54,12 +42,6 @@
object
}
-`setMinperm<-.permControl` <- function(object, value) {
- object[["minperm"]] <- value
- object <- fixupCall(object, "minperm", value)
- object
-}
-
`setComplete<-` <- function(object, value) {
UseMethod("setComplete<-")
}
@@ -76,14 +58,6 @@
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<-")
}
@@ -100,14 +74,6 @@
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<-")
}
@@ -124,14 +90,6 @@
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<-")
}
@@ -149,15 +107,6 @@
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<-")
}
@@ -174,14 +123,6 @@
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<-")
@@ -224,10 +165,13 @@
}
`setStrata<-.how` <- function(object, value) {
- if (!is.null(value))
+ if (!is.null(value)) {
value <- as.factor(value)
- object[["blocks"]] <- value
- object <- fixupCall(object, "blocks", getCall(value))
+ }
+ ## get Plots
+ plots <- getPlots(object)
+ setStrata(plots) <- value
+ setPlots(object) <- plots
object
}
@@ -235,7 +179,7 @@
if (!is.null(value))
value <- as.factor(value)
object[["strata"]] <- value
- object <- fixupCall(object, "strata", getCall(value))
+ object <- fixupCall(object, "strata", value) # value was getCall(value))
object
}
@@ -369,16 +313,16 @@
`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[["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[["mirror"]] <- value
+ object <- fixupCall(object, "mirror", value)
object
}
@@ -398,8 +342,8 @@
`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[["constant"]] <- value
+ object <- fixupCall(object, "constant", value)
object
}
diff --git a/R/shuffle-utils.R b/R/shuffle-utils.R
index 78f84a2..43243c0 100644
--- a/R/shuffle-utils.R
+++ b/R/shuffle-utils.R
@@ -2,7 +2,10 @@
`shuffleStrata` <- function(strata, type, mirror = FALSE, start = NULL,
flip = NULL, nrow, ncol, start.row = NULL,
start.col = NULL) {
- lev <- length(LEVS <- levels(strata))
+ ## drop unused levels
+ strata <- droplevels(strata)
+ LEVS <- levels(strata)
+ lev <- nlevels(strata)
ngr <- length(strata) / lev
SEQ <- seq_len(lev)
sp <- split(out <- seq_along(strata), strata)
diff --git a/R/shuffle.R b/R/shuffle.R
index 8260736..4bdc024 100644
--- a/R/shuffle.R
+++ b/R/shuffle.R
@@ -1,78 +1,122 @@
-`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)
+## 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 {
- ## If strata present, either permute samples, strata or both
+ ## 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]
- ## permute strata?
- if(control$blocks$type == "none") {
- out <- seq_len(n)
- } else {
- flip <- runif(1L) < 0.5 ## why are we doing this? Null better?
- out <- shuffleStrata(control$strata,
- type = control$blocks$type,
- mirror = control$blocks$mirror,
- flip = flip,
- nrow = control$blocks$nrow,
- ncol = control$blocks$ncol)
+ 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 strata?
- if(control$within$type != "none") {
- tab <- table(control$strata[out])
- ## the levels of the strata
- inds <- names(tab)
- ## same permutation within each level of strata?
- if(control$within$constant) {
- if(control$within$type == "free") {
- n <- unique(tab)[1L]
- same.rand <- shuffleFree(n, n)
- } else if(control$within$type == "series") {
- start <- shuffleFree(n / length(inds), 1L)
+
+ ## 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(control$within$type == "grid") {
- start.row <- shuffleFree(control$within$nrow, 1L)
- start.col <- shuffleFree(control$within$ncol, 1L)
+ } 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
}
- tmp <- out
- ## for each level of strata, permute
- for (is in inds) {
+
+ ## 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 <- control$strata[out] == is
- gr <- out[MATCH]
- if ((n.gr <- length(gr)) > 1) {
- tmp[which(MATCH)] <-
- switch(control$within$type,
- "free" =
- if(control$within$constant) {
+ MATCH <- Pstrata[perm] == lv
+ gr <- perm[MATCH]
+ if((n.gr <- length(gr)) > 1) {
+ tmp[MATCH] <-
+ switch(typeW,
+ "free" = if(isTRUE(CONSTANT)) {
gr[same.rand]
} else {
- out[gr][shuffleFree(n.gr, n.gr)]
+ gr[shuffleFree(n.gr, n.gr)]
},
"series" =
gr[shuffleSeries(seq_len(n.gr),
- mirror = control$within$mirror,
+ mirror = withinCTRL$mirror,
start = start, flip = flip)],
"grid" =
- gr[shuffleGrid(nrow = control$within$nrow,
- ncol = control$within$ncol,
- mirror = control$within$mirror,
+ gr[shuffleGrid(nrow = withinCTRL$nrow,
+ ncol = withinCTRL$ncol,
+ mirror = withinCTRL$mirror,
start.row = start.row,
start.col = start.col,
flip = flip)]
)
}
}
- out <- tmp
+ perm <- tmp
}
}
- out
+ ind[perm]
}
diff --git a/R/shuffle2.R b/R/shuffle2.R
deleted file mode 100644
index f2a30e2..0000000
--- a/R/shuffle2.R
+++ /dev/null
@@ -1,122 +0,0 @@
-## 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 1178b7e..cc6f4f5 100644
--- a/R/shuffleSet.R
+++ b/R/shuffleSet.R
@@ -1,89 +1,201 @@
-`shuffleSet2` <- function(n, nset = 1, control = how()) {
+## new version of shuffleSet() that allows for blocking
+`shuffleSet` <- function(n, nset, control = how(), check = TRUE,
+ quietly = FALSE) {
+ ## 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!
+ }
+
+ ## handle a vector, matrix, or data frame input; derive n from it
+ if (((is.numeric(n) || is.integer(n) || is.factor(n)) &&
+ length(n) > 1L) ||
+ is.matrix(n) ||
+ is.data.frame(n)) {
+ n <- nobs(n)
+ }
+ 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, quietly = quietly)
+ ## 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)
- WI <- getWithin(control)
- strata <- getStrata(control)
- if(is.null(strata)) {
- ## If no strata then permute all samples using stated scheme
- Args <- switch(WI$type,
+
+ ## 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 = WI$mirror),
- "grid" = list(nrow = WI$nrow, ncol = WI$ncol,
- mirror = WI$mirror))
- FUN <- switch(WI$type,
+ "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(WI$type == "none") {
- Set[] <- rep(seq_len(n), each = nset)
+ 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 present, either permute samples, strata or both
- BL <- getBlocks(control)
+ ## If strata at Plot level present, either permute samples, Plots or both
- ## permute strata?
- if(BL$type == "none") {
- Set[] <- rep(seq_len(n), each = nset)
+ ## 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 = strata, type = BL$type,
- mirror = BL$mirror, flip = NULL,
- nrow = BL$nrow, ncol = BL$ncol))
+ list(strata = Pstrata[ind],
+ type = typeP,
+ mirror = plotCTRL$mirror,
+ flip = NULL, ## runif(1L) < 0.5 ??
+ nrow = plotCTRL$nrow,
+ ncol = plotCTRL$ncol))
}
}
tmp <- Set
- ## permute the samples within strata?
- if(WI$type != "none") {
+
+ ## permute the samples within Plot strata
+ if(!isTRUE(all.equal(typeW, "none"))) {
for(i in seq_len(nset)) {
- tab <- table(strata[Set[i,]])
- ## the levels of the strata
- inds <- names(tab)
- ## same permutation within each level of strata?
- if(WI$constant) {
- if(WI$type == "free") {
+ 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(WI$type == "series") {
- start <- shuffleFree(n / length(inds), 1L)
- flip <- runif(1L) < 0.5
- } else if(WI$type == "grid") {
- start.row <- shuffleFree(WI$nrow, 1L)
- start.col <- shuffleFree(WI$ncol, 1L)
- flip <- runif(2L) < 0.5
+ } 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(is in inds) {
+ for(lv in levs) {
## must re-order strata here on basis of Ser as they
## may have been permuted above
- MATCH <- strata[Set[i,]] == is
+ MATCH <- Pstrata[ind][Set[i,]] == lv
gr <- Set[i,][MATCH]
- if ((n.gr <- length(gr)) > 1) {
- if(WI$constant && WI$type == "free") {
+ if((n.gr <- length(gr)) > 1) {
+ if(withinCTRL$constant && isTRUE(all.equal(typeW, "free"))) {
tmp[i,][which(MATCH)] <- gr[same.rand]
} else {
Args <-
- switch(WI$type,
+ switch(typeW,
"free" = list(x = n.gr, size = n.gr),
"series" = list(x = seq_len(n.gr),
- mirror = WI$mirror,
- start = start,
- flip = flip),
- "grid" = list(nrow = WI$nrow,
- ncol = WI$ncol,
- mirror = WI$mirror,
- start.row = start.row,
- start.col = start.col,
- flip = flip))
+ 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(WI$type,
+ switch(typeW,
"free" = shuffleFree,
"series" = shuffleSeries,
"grid" = shuffleGrid)
@@ -95,5 +207,7 @@
Set <- tmp
}
}
- Set
+ out <- Set ## have to copy or next line fails
+ out[] <- ind[Set]
+ out
}
diff --git a/R/shuffleSet2.R b/R/shuffleSet2.R
deleted file mode 100644
index 17b9195..0000000
--- a/R/shuffleSet2.R
+++ /dev/null
@@ -1,205 +0,0 @@
-## 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/README.md b/README.md
new file mode 100644
index 0000000..1c6765e
--- /dev/null
+++ b/README.md
@@ -0,0 +1,33 @@
+## Restricted permutations with R
+
+#### Released version
+[](http://cran.rstudio.com/web/packages/permute/index.html) [](http://cran.rstudio.com/web/packages/permute/index.html)
+
+#### Build status
+[](https://travis-ci.org/gavinsimpson/permute) [](https://ci.appveyor.com/project/gavinsimpson/permute/branch/master) [](https://codecov.io/github/gavinsimpson/permute?branch=master)
+
+## What is permute?
+
+**permute** generates permutations from a range of restricted
+permutation designs.
+
+Permute provides an R implementation of the permutation schemes
+developed by Cajo ter Braak and made available in the Canoco software,
+version 3.1 (ter Braak, 1990). These permutation schemes draw upon
+ideas from an earlier paper by Besag & Clifford (1989).
+
+Several types of permutation are available in **permute**:
+
+ * Free permutation of objects
+ * Time series or line transect designs, where the temporal or spatial ordering is preserved.
+ * Spatial grid designs, where the spatial ordering is preserved in both coordinate directions
+ * Permutation of plots or groups of samples.
+ * Blocking factors which restrict permutations to within blocks. The preceding designs can be nested within blocks, allowing analysis of hierachical designs (e.g. split plot designs)
+
+### References
+
+Besag, J. and Clifford, P. (1989) Generalized Monte Carlo significance
+tests. *Biometrika* **76**; 633–642.
+
+ter Braak, C. J. F. (1990). *Update notes: CANOCO version 3.1*.
+Wageningen: Agricultural Mathematics Group. (UR).
diff --git a/build/vignette.rds b/build/vignette.rds
index ef8f615..427c73a 100644
Binary files a/build/vignette.rds and b/build/vignette.rds differ
diff --git a/data/jackal.rda b/data/jackal.rda
index a2c6f52..590f391 100644
Binary files a/data/jackal.rda and b/data/jackal.rda differ
diff --git a/inst/ChangeLog b/inst/ChangeLog
index 00406bf..44ca861 100644
--- a/inst/ChangeLog
+++ b/inst/ChangeLog
@@ -1,7 +1,61 @@
-$Date: 2014-01-26 20:21:11 +0100 (Sun, 26 Jan 2014) $
-
permute ChangeLog
+Version 0.9-0
+
+ * Release to CRAN 23 Jan 2016
+
+Version 0.8-5
+
+ * shuffleSet gains new argument `quietly = FALSE`, which is
+ passed on to `check()` to allow control over printing of
+ statements during checking.
+
+ Reported by: (and fixed by) Jari Oksanen
+
+ * allPerms would return a vector instead of a matrix when a
+ single permutation was generated.
+
+ Reported by: (and fixed by) Jari Oksanen
+
+ * Better defaults for `check()` heuristics allow for more
+ reliable (i.e. fewer duplicate permutations) permutations when
+ the set of permutations is small.
+
+ Provided by: Jari Oksanen
+
+ * allStrata did not handle cases where strata were not in
+ contiguous blocks:
+ e.g. `c(1, 2, 3, 1, 2, 3)` vs `c(1, 1, 2, 2, 3, 3)`
+
+ Reported by: David Warton
+
+ * Permutation matrices returned by `shuffleSet()` now print the
+ permutations more compactfully.
+
+ * as.matrix.allPerms: new S3 method for class `allPerms`.
+
+ * Code coverage: permute now has a test suite that covers
+ ~87% of the current code base.
+
+Version 0.8-4
+
+ * Update testthat unit testing to recommended usage.
+
+ Reported by: Hadley Wickham
+
+ * Example using vegan data is now made conditional upon that
+ package being available.
+
+ Reported by: Jari Oksanen
+ Fix suggested by: Uwe Ligges
+
+ * blocks new in-devel extractor and replacement function `blocks`.
+ These are not currently exported so use at your own risk...
+
+ * permute-deprecate.Rd was missing an \alias{}
+
+ Reported by: Kurt Hornik (CRAN)
+
Version 0.8-3
* allPerms: with free permutations *within* plots, `allPerms()`
diff --git a/inst/NEWS b/inst/NEWS
new file mode 100644
index 0000000..ea97a1d
--- /dev/null
+++ b/inst/NEWS
@@ -0,0 +1,97 @@
+# permute News
+
+## Changes in version 0.9-0
+
+### General
+
+This is small update to **permute**, focused mainly on ensuring the
+many combinations of restrictions on permutations allowed by the
+package work. An extensive test suite has been written which covers
+~87% of the package's codebase at the time of release.
+
+### New features
+
+* Permutation matrices produced by `shuffleSet()` are now printed in a
+more compact form.
+
+* Better heuristics in `check()` allow for more reliable permutations
+(i.e. fewer duplicate permutations) when the set is small. This has
+increased the `minperms` setting. Consequently we generate all possible
+permutations up to ~500,000 more often as we now randomly sample from
+the entirely generated set rather than randomly generate permutations.
+This provides a small performance hit in some rare cases.
+
+* `shuffleSet()` has a new argument `quietly = FALSE` which is passed
+on to `check()`.
+
+* A number of bugs were fixed. See the Changelog and the Bug reports on
+github for details.
+
+### Defunct
+
+* `permControl()` and `permuplot()` are defunct and have been removed
+from the package.
+
+## Changes in version 0.8-0
+
+### General
+
+* Version 0.8-0 represents a major update of **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.
+
+### New features
+
+* `how()`, a new function to create permutation designs. This replaces
+the deprecated function `permControl`.
+
+* **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
+ `Plots()` instead of via the old `strata` argument of `how()`.
+ Blocks are specified via a new argument `blocks`, which takes a
+ factor variable.
+
+* A new suite of extractor and replacement functions is provided with
+which to interact with permutation designs created by `how(). Extractor
+functions have names `getFoo()`, where `Foo()` is a component of the
+design. Replacement functions have names `setFoo`. The replacement
+function are especially for use by package authors wishing to alter
+permutation within their functions. The extractor functions are
+recommended for all users wishing to extract features of the permutation
+design.
+
+* As a convenience for users, the \code{update()} function will now
+work with objects of classes `"how"`, `"Plots"` or `"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 `setFoo` replacement functions should be used.
+
+* `shuffleSet()` is enhanced in this version. Firstly, the function now
+returns a classed object which has a `print()` method to allow for
+compact printing of the design elements used to generate the set of
+permutations. Second, `shuffleSet()` will sample `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.
+
+* `allPerms()` no longer assumes that samples are in block and/or plot
+ordering.
+
+* The package vignette is much expanded in this version with new
+sections on using **permute** within functions that will be of interest
+to package authors wishing to use **permute** in their packages.
+
+### Deprecated
+
+* `permControl()` is deprecated in favour of `how()`.
+
+* `permuplot()` is broken and effectively defunct given the changes to
+the way permutation are defined and the addition of blocks.
+`permuplot()` is no longer exported from the package namespace.
diff --git a/inst/NEWS.Rd b/inst/NEWS.Rd
deleted file mode 100644
index 4183d6a..0000000
--- a/inst/NEWS.Rd
+++ /dev/null
@@ -1,86 +0,0 @@
-\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/doc/permutations.R b/inst/doc/permutations.R
index d0b4b2d..8840620 100644
--- a/inst/doc/permutations.R
+++ b/inst/doc/permutations.R
@@ -10,7 +10,7 @@ options(useFancyQuotes="UTF-8")
###################################################
### code chunk number 2: load_jackal
###################################################
-require(permute)
+library("permute")
data(jackal)
jackal
@@ -60,13 +60,13 @@ Djackal[5000] <- with(jackal, meanDif(Length, Sex))
###################################################
-### code chunk number 8: permutations.Rnw:125-126
+### code chunk number 8: permutations.Rnw:121-122
###################################################
(Dbig <- sum(Djackal >= Djackal[5000]))
###################################################
-### code chunk number 9: permutations.Rnw:129-130
+### code chunk number 9: permutations.Rnw:125-126
###################################################
Dbig / length(Djackal)
@@ -80,7 +80,7 @@ rug(Djackal[5000], col = "red", lwd = 2)
###################################################
-### code chunk number 11: permutations.Rnw:142-143
+### code chunk number 11: permutations.Rnw:138-139
###################################################
choose(20, 10)
@@ -165,7 +165,7 @@ pset
###################################################
-### code chunk number 21: permutations.Rnw:256-257
+### code chunk number 21: permutations.Rnw:252-253
###################################################
how(nperm = 999)
diff --git a/inst/doc/permutations.Rnw b/inst/doc/permutations.Rnw
index 8a762df..1121697 100644
--- a/inst/doc/permutations.Rnw
+++ b/inst/doc/permutations.Rnw
@@ -1,12 +1,7 @@
-\documentclass[article,shortnames]{Z}
-\usepackage{thumbpdf}
+\documentclass[article,shortnames,nojss]{jss}
%\VignetteIndexEntry{Restricted permutations; using the permute package}
%\VignettePackage{permute}
-%\VignetteDepends{vegan}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% declarations for jss.cls %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% almost as usual
\author{Gavin L. Simpson\\University of Regina}
@@ -19,6 +14,7 @@
%% an abstract and keywords
\Abstract{
+ TODO
}
\Keywords{permutations, restricted permutations, time series, transects, spatial grids, split-plot designs, Monte Carlo resampling, \proglang{R}}
\Plainkeywords{permutations, restricted permutations, time series, transects, spatial grids, split-plot designs, Monte Carlo resampling, R} %% without formatting
@@ -65,7 +61,7 @@ In many data sets, simply shuffling the data at random is inappropriate; under t
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)
+library("permute")
data(jackal)
jackal
@
@@ -277,7 +273,7 @@ args(Within)
\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 [...]
+ 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 = TRUE} stipulates that each plot should have the same [...]
\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}]
diff --git a/inst/doc/permutations.pdf b/inst/doc/permutations.pdf
index ce6d856..ddda393 100644
Binary files a/inst/doc/permutations.pdf and b/inst/doc/permutations.pdf differ
diff --git a/inst/tests/test-allPerms.R b/inst/tests/test-allPerms.R
deleted file mode 100644
index 28f183f..0000000
--- a/inst/tests/test-allPerms.R
+++ /dev/null
@@ -1,127 +0,0 @@
-library(testthat)
-library_if_available(permute)
-
-context("Testing allPerms()")
-
-test_that("allPerms - blocks - within block free", {
- ## example data from Joris Meys from
- ## http://stackoverflow.com/a/21313632/429846
- thedata <- data.frame(score = c(replicate(4, sample(1:3))),
- judge = rep(1:4, each = 3),
- wine = rep.int(1:3, 4))
-
- ## without the observed permutation included
- hh <- how(within = Within("free"),
- blocks = factor(thedata$judge),
- complete = TRUE, maxperm = 1e9)
- nr <- nrow(thedata)
- np <- numPerms(nr, hh)
- p <- allPerms(nr, control = hh)
- expect_that(nrow(p), equals(np - 1)) ## default is to drop observed
-
- ## check no duplicate indices within rows
- dup <- any(apply(p, 1, function(x) any(duplicated(x))))
- expect_false(dup, info = "Blocks: even; within: free; no observed")
-
- ## with the observed permutation included
- hh <- how(within = Within("free"),
- blocks = factor(thedata$judge),
- complete = TRUE, maxperm = 1e9,
- observed = TRUE)
- p <- allPerms(nr, control = hh)
- expect_that(nrow(p), equals(np)) ## now includes observed
-
- ## check no duplicate indices within rows
- dup <- any(apply(p, 1, function(x) any(duplicated(x))))
- expect_false(dup, info = "Blocks: even; within: free; observed")
-})
-
-test_that("allPerms; blocks: within; block free - uneven block sizes", {
- fac <- factor(rep(1:3, times = c(2,2,4)))
-
- ## without the observed permutation included
- hh <- how(within = Within("free"),
- blocks = fac,
- complete = TRUE, maxperm = 1e9)
- ll <- length(fac)
- np <- numPerms(ll, hh)
- expect_that(np, equals(prod(factorial(2), factorial(2), factorial(4))))
- p <- allPerms(ll, control = hh)
- expect_that(nrow(p), equals(np - 1)) ## default is to drop observed
-
- ## check no duplicate indices within rows
- dup <- any(apply(p, 1, function(x) any(duplicated(x))))
- expect_false(dup, info = "Blocks: uneven; within: free; no observed")
-
- ## with the observed permutation included
- hh <- how(within = Within("free"),
- blocks = fac,
- complete = TRUE, maxperm = 1e9,
- observed = TRUE)
- p <- allPerms(ll, control = hh)
- expect_that(nrow(p), equals(np)) ## now includes observed
-
- ## check no duplicate indices within rows
- dup <- any(apply(p, 1, function(x) any(duplicated(x))))
- expect_false(dup, info = "Blocks: uneven; within: free; observed")
-})
-
-## testing plot-level permutations ------------------------------------
-test_that("allPerms: plots; within: free; even: yes;", {
- fac <- rep(1:3, each = 3)
-
- hh <- how(plots = Plots(strata = fac),
- complete = TRUE, maxperm = 1e9)
- ll <- length(fac)
- np <- numPerms(ll, hh)
- p <- allPerms(ll, control = hh)
- expect_that(nrow(p), equals(np - 1), ## default is to drop observed
- info = "Check n all perms == numPerms output.")
-
- ## check no duplicate indices within rows
- dup <- any(apply(p, 1, function(x) any(duplicated(x))))
- expect_false(dup,
- info = "Unique? Plots: even; within: free; no observed")
-
- ## with the observed permutation included
- hh <- how(within = Within("free"),
- plot = Plots(strata = fac),
- complete = TRUE, maxperm = 1e9,
- observed = TRUE)
- p <- allPerms(ll, control = hh)
- expect_that(nrow(p), equals(np)) ## now includes observed
-
- ## check no duplicate indices within rows
- dup <- any(apply(p, 1, function(x) any(duplicated(x))))
- expect_false(dup, info = "Unique? Plots: even; within: free; inc observed")
-})
-
-test_that("allPerms; plots: within; plot free - uneven plot sizes", {
- fac <- factor(rep(1:3, times = c(2,2,4)))
-
- ## without the observed permutation included
- hh <- how(within = Within("free"),
- plots = Plots(strata = fac),
- complete = TRUE, maxperm = 1e9)
- ll <- length(fac)
- np <- numPerms(ll, hh)
- expect_that(np, equals(prod(factorial(2), factorial(2), factorial(4))))
- p <- allPerms(ll, control = hh)
- expect_that(nrow(p), equals(np - 1)) ## default is to drop observed
-
- ## check no duplicate indices within rows
- dup <- any(apply(p, 1, function(x) any(duplicated(x))))
- expect_false(dup, info = "Plots: uneven; within: free; no observed")
-
- ## with the observed permutation included
- hh <- how(within = Within("free"),
- plots = Plots(strata = fac),
- complete = TRUE, maxperm = 1e9,
- observed = TRUE)
- p <- allPerms(ll, control = hh)
- expect_that(nrow(p), equals(np)) ## now includes observed
-
- ## check no duplicate indices within rows
- dup <- any(apply(p, 1, function(x) any(duplicated(x))))
- expect_false(dup, info = "Plots: uneven; within: free; observed")
-})
diff --git a/inst/tests/test-shuffleSet.R b/inst/tests/test-shuffleSet.R
deleted file mode 100644
index 2df5030..0000000
--- a/inst/tests/test-shuffleSet.R
+++ /dev/null
@@ -1,42 +0,0 @@
-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 3d21daf..66494e7 100644
--- a/man/allPerms.Rd
+++ b/man/allPerms.Rd
@@ -3,6 +3,7 @@
\alias{print.allPerms}
\alias{summary.allPerms}
\alias{print.summary.allPerms}
+\alias{as.matrix.allPerms}
\title{Complete enumeration of all possible permutations}
\description{
@@ -13,6 +14,8 @@
allPerms(n, control = how(), check = TRUE)
\method{summary}{allPerms}(object, \dots)
+
+\method{as.matrix}{allPerms}(x, \dots)
}
\arguments{
\item{n}{the number of observations or an 'object' from which the
@@ -25,6 +28,9 @@ allPerms(n, control = how(), check = TRUE)
function checked the design earlier.}
\item{object}{an object of class \code{"allPerms"}.}
\item{\dots}{arguments to other methods.}
+ \item{x}{
+ an object of class \code{"allPerms"}, as returned by \code{allPerms}.
+ }
}
\details{
Function \code{allPerms} enumerates all possible permutations for the
@@ -43,6 +49,10 @@ allPerms(n, control = how(), check = TRUE)
control this and guard against trying to evaluate too large a number
of permutations, if the number of possible permutations is larger than
\code{getMaxperm(control)}, \code{allPerms} exits with an error.
+
+ The \code{as.matrix} method sets the \code{control} and \code{seed}
+ attributes to \code{NULL} and removes the \code{"permutationMatrix"}
+ class, resulting in a standard matrix object.
}
\value{
For \code{allPerms}, and object of class \code{"allPerms"}, a matrix
diff --git a/man/check.Rd b/man/check.Rd
index 7898bfd..7272a08 100644
--- a/man/check.Rd
+++ b/man/check.Rd
@@ -43,10 +43,12 @@ check(object, control = how(), quietly = FALSE)
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}).
+ 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}). This guarantees that permutations are all unique and
+ there are no duplicates.
}
\value{
For \code{check} a list containing the maximum number of
@@ -56,56 +58,58 @@ check(object, control = how(), quietly = FALSE)
\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")))
-
+## only run this example if vegan is available
+if (require("vegan")) {
+ ## use example data from ?pyrifos in package 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())
diff --git a/man/how.Rd b/man/how.Rd
index 9dd6008..ef8d1d6 100644
--- a/man/how.Rd
+++ b/man/how.Rd
@@ -16,7 +16,7 @@
\usage{
how(within = Within(), plots = Plots(), blocks = NULL,
nperm = 199, complete = FALSE, maxperm = 9999,
- minperm = 99, all.perms = NULL, make = TRUE,
+ minperm = 5040, all.perms = NULL, make = TRUE,
observed = FALSE)
Within(type = c("free","series","grid","none"),
@@ -43,10 +43,12 @@ Plots(strata = NULL, type = c("none","free","series","grid"),
\code{"free"}, \code{"series"}, \code{"grid"} or \code{"none"}. See
Details.}
\item{maxperm}{numeric; the maximum number of permutations to
- perform. Currently unused.}
+ 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.}
+ permutations at which complete enumeration is performed. When
+ \code{nperm} is lower than \code{minperm}, sampling is performed
+ from the set of complete permutations to avoid duplicate
+ permutations. 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
diff --git a/man/permCheck-deprecated.Rd b/man/permCheck-deprecated.Rd
deleted file mode 100644
index cae9681..0000000
--- a/man/permCheck-deprecated.Rd
+++ /dev/null
@@ -1,66 +0,0 @@
-\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/permControl-deprecated.Rd b/man/permControl-deprecated.Rd
deleted file mode 100644
index dcb7802..0000000
--- a/man/permControl-deprecated.Rd
+++ /dev/null
@@ -1,82 +0,0 @@
-\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
deleted file mode 100644
index 94911cf..0000000
--- a/man/permute-deprecated.Rd
+++ /dev/null
@@ -1,25 +0,0 @@
-\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/shuffleSet.Rd b/man/shuffleSet.Rd
index 01d7092..fafc0ae 100644
--- a/man/shuffleSet.Rd
+++ b/man/shuffleSet.Rd
@@ -1,5 +1,6 @@
\name{shuffleSet}
\alias{shuffleSet}
+\alias{as.matrix.permutationMatrix}
\title{
Generate a set of permutations from the specified design.
@@ -11,7 +12,9 @@
set of permutations.
}
\usage{
-shuffleSet(n, nset, control = how(), check = TRUE)
+shuffleSet(n, nset, control = how(), check = TRUE, quietly = FALSE)
+
+\method{as.matrix}{permutationMatrix}(x, \dots)
}
%- maybe also 'usage' for other objects documented here.
\arguments{
@@ -33,6 +36,17 @@ shuffleSet(n, nset, control = how(), check = TRUE)
the stated number of observations and update \code{control}
accordingly. See Details.
}
+ \item{quietly}{
+ logical; should messages by suppressed?
+ }
+ \item{x}{
+ an object of class \code{"permutationMatrix"}, as returned by
+ \code{shuffleSet}.
+ }
+ \item{\dots}{
+ arguments passed to other methods. For the \code{as.matrix} method
+ only.
+ }
}
\details{
\code{shuffleSet} is designed to generate a set of \code{nset}
@@ -61,6 +75,10 @@ shuffleSet(n, nset, control = how(), check = TRUE)
of permutations returned will be unique, especially so for designs and
data sets where there are few possible permutations relative to the
number requested.
+
+ The \code{as.matrix} method sets the \code{control} and \code{seed}
+ attributes to \code{NULL} and removes the \code{"permutationMatrix"}
+ class, resulting in a standard matrix object.
}
\value{
Returns a matrix of permutations, where each row is a separate
diff --git a/tests/Examples/permute-Ex.Rout.save b/tests/Examples/permute-Ex.Rout.save
index 701a614..6193450 100644
--- a/tests/Examples/permute-Ex.Rout.save
+++ b/tests/Examples/permute-Ex.Rout.save
@@ -1,7 +1,7 @@
-R version 3.0.2 Patched (2014-01-14 r64768) -- "Frisbee Sailing"
-Copyright (C) 2014 The R Foundation for Statistical Computing
-Platform: x86_64-unknown-linux-gnu (64-bit)
+R version 3.2.3 Patched (2016-01-03 r69846) -- "Wooden Christmas-Tree"
+Copyright (C) 2016 The R Foundation for Statistical Computing
+Platform: x86_64-pc-linux-gnu (64-bit)
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
@@ -32,7 +32,7 @@ Type 'q()' to quit R.
> ### Name: allPerms
> ### Title: Complete enumeration of all possible permutations
> ### Aliases: allPerms print.allPerms summary.allPerms
-> ### print.summary.allPerms
+> ### print.summary.allPerms as.matrix.allPerms
>
> ### ** Examples
>
@@ -127,9 +127,9 @@ Within Plots:
Grid dimensions: 3 rows 2 cols
Permutation details:
- Number of permutations requested: 199
+ Number of permutations: 199
Max. number of permutations allowed: 9999
- Evaluate all permutations?: No. Activation limit: 99
+ Evaluate all permutations?: No. Activation limit: 5040
All permutations:
Contains observed ordering?: Yes
@@ -168,9 +168,9 @@ Within Plots:
Grid dimensions: 3 rows 2 cols
Permutation details:
- Number of permutations requested: 198
+ Number of permutations: 198
Max. number of permutations allowed: 9999
- Evaluate all permutations?: No. Activation limit: 99
+ Evaluate all permutations?: No. Activation limit: 5040
All permutations:
Contains observed ordering?: No
@@ -203,12 +203,60 @@ Contains observed ordering?: No
>
> ### ** Examples
>
-> ## use example data from ?pyrifos in package vegan
-> require(vegan)
+> ## only run this example if vegan is available
+> if (require("vegan")) {
++ ## use example data from ?pyrifos in package 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")))
++ }
Loading required package: vegan
Loading required package: lattice
-This is vegan 2.0-10
-> example(pyrifos)
+This is vegan 2.3-3
pyrifs> data(pyrifos)
@@ -217,77 +265,28 @@ 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'.
+'nperm' >= set of all permutations: complete enumeration.
+Set of permutations < 'minperm'. Generating entire set.
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'.
+'nperm' >= set of all permutations: complete enumeration.
+Set of permutations < 'minperm'. Generating entire set.
+'nperm' >= set of all permutations: complete enumeration.
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'.
+'nperm' >= set of all permutations: complete enumeration.
+Set of permutations < 'minperm'. Generating entire set.
> all.equal(100, vec3$n)
[1] TRUE
> vec4 <- check(1:100, how(within = Within(type= "series", mirror = TRUE)))
+'nperm' >= set of all permutations: complete enumeration.
+Set of permutations < 'minperm'. Generating entire set.
> all.equal(vec4$n, 200)
[1] TRUE
>
@@ -297,7 +296,7 @@ Set of permutations < 'minperm'. Generating entire set.
+ within = Within(type = "grid", mirror = FALSE,
+ constant = TRUE, nrow = 3, ncol = 2))
> check(1:12, ctrl)
-'nperm' > set of all permutations; Resetting 'nperm'.
+'nperm' >= set of all permutations: complete enumeration.
Set of permutations < 'minperm'. Generating entire set.
[1] 6
>
@@ -373,9 +372,9 @@ Within Plots:
Grid dimensions: 3 rows 2 cols
Permutation details:
- Number of permutations requested: 199
+ Number of permutations: 199
Max. number of permutations allowed: 9999
- Evaluate all permutations?: No. Activation limit: 99
+ Evaluate all permutations?: No. Activation limit: 5040
All permutations:
Contains observed ordering?: Yes
@@ -408,9 +407,9 @@ Within Plots:
Grid dimensions: 3 rows 2 cols
Permutation details:
- Number of permutations requested: 198
+ Number of permutations: 198
Max. number of permutations allowed: 9999
- Evaluate all permutations?: No. Activation limit: 99
+ Evaluate all permutations?: No. Activation limit: 5040
All permutations:
Contains observed ordering?: No
@@ -578,9 +577,9 @@ Within Plots:
Different permutation within each Plot?: Yes
Permutation details:
- Number of permutations requested: 199
+ Number of permutations: 199
Max. number of permutations allowed: 9999
- Evaluate all permutations?: No. Activation limit: 99
+ Evaluate all permutations?: No. Activation limit: 5040
>
> ## ... or switch the type of shuffling at a level:
> #update(h1, plots = update(getPlots(h1), type = "none"))
@@ -603,9 +602,9 @@ Within Plots:
Different permutation within each Plot?: Yes
Permutation details:
- Number of permutations requested: 199
+ Number of permutations: 199
Max. number of permutations allowed: 9999
- Evaluate all permutations?: No. Activation limit: 99
+ Evaluate all permutations?: No. Activation limit: 5040
>
>
>
@@ -908,7 +907,7 @@ Permutation details:
> 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
+ [1] 12 11 13 14 15 16 20 19 17 18 1 2 3 4 5 6 8 10 7 9
>
> ## permuting within blocks
> grp <- gl(2, 10) # 2 groups of 10 samples each
@@ -999,7 +998,7 @@ mean in group Group 1 mean in group Group 2
>
> ### Name: shuffleSet
> ### Title: Generate a set of permutations from the specified design.
-> ### Aliases: shuffleSet
+> ### Aliases: shuffleSet as.matrix.permutationMatrix
> ### Keywords: htest design
>
> ### ** Examples
@@ -1007,27 +1006,27 @@ mean in group Group 1 mean in group Group 2
> ## simple random permutations, 5 permutations in set
> shuffleSet(n = 10, nset = 5)
No. of Permutations: 5
-No. of Samples: 10 (Nested in: plots; Randomised)
+No. of Samples: 10 (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
+ 1 2 3 4 5 6 7 8 9 10
+p1 3 4 5 7 2 8 9 6 10 1
+p2 3 2 6 10 5 7 8 4 1 9
+p3 10 2 6 1 9 8 7 5 3 4
+p4 5 6 4 2 10 8 9 1 7 3
+p5 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)
+No. of Samples: 10 (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
+ 1 2 3 4 5 6 7 8 9 10
+p1 6 7 8 9 10 1 2 3 4 5
+p2 8 9 10 1 2 3 4 5 6 7
+p3 5 6 7 8 9 10 1 2 3 4
+p4 3 4 5 6 7 8 9 10 1 2
+p5 2 3 4 5 6 7 8 9 10 1
>
> ## series random permutations, 10 permutations in set,
> ## with possible mirroring
@@ -1035,19 +1034,19 @@ No. of Samples: 10 (Nested in: plots; Sequence)
> 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
+No. of Samples: 10 (Sequence; mirrored)
+
+ 1 2 3 4 5 6 7 8 9 10
+p1 3 4 5 6 7 8 9 10 1 2
+p2 7 8 9 10 1 2 3 4 5 6
+p3 10 1 2 3 4 5 6 7 8 9
+p4 2 1 10 9 8 7 6 5 4 3
+p5 8 9 10 1 2 3 4 5 6 7
+p6 4 3 2 1 10 9 8 7 6 5
+p7 5 6 7 8 9 10 1 2 3 4
+p8 9 8 7 6 5 4 3 2 1 10
+p9 5 4 3 2 1 10 9 8 7 6
+p10 6 5 4 3 2 1 10 9 8 7
>
> ## Permuting strata
> ## 4 groups of 5 observations
@@ -1059,28 +1058,17 @@ 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
+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
+p1 6 7 8 9 10 1 2 3 4 5 11 12 13 14 15 16 17 18 19 20
+p2 6 7 8 9 10 16 17 18 19 20 11 12 13 14 15 1 2 3 4 5
+p3 11 12 13 14 15 16 17 18 19 20 6 7 8 9 10 1 2 3 4 5
+p4 1 2 3 4 5 11 12 13 14 15 6 7 8 9 10 16 17 18 19 20
+p5 16 17 18 19 20 6 7 8 9 10 11 12 13 14 15 1 2 3 4 5
+p6 6 7 8 9 10 1 2 3 4 5 16 17 18 19 20 11 12 13 14 15
+p7 11 12 13 14 15 6 7 8 9 10 16 17 18 19 20 1 2 3 4 5
+p8 16 17 18 19 20 11 12 13 14 15 6 7 8 9 10 1 2 3 4 5
+p9 11 12 13 14 15 16 17 18 19 20 1 2 3 4 5 6 7 8 9 10
+p10 16 17 18 19 20 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
>
> ## 10 random permutations in presence of Plot-level strata
> plotStrata <- Plots(strata = gl(4,5))
@@ -1093,113 +1081,77 @@ 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
+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
+p1 5 4 2 3 1 8 10 7 6 9 12 13 11 14 15 17 16 20 18 19
+p2 4 2 5 3 1 9 7 6 10 8 12 11 15 13 14 20 18 17 16 19
+p3 1 3 5 4 2 10 7 9 6 8 13 15 11 14 12 18 16 19 17 20
+p4 3 5 2 4 1 9 8 6 10 7 13 11 15 14 12 19 18 16 20 17
+p5 1 3 5 4 2 7 9 10 8 6 13 11 12 15 14 19 20 18 16 17
+p6 5 3 4 2 1 7 6 8 10 9 11 14 13 12 15 19 17 16 20 18
+p7 3 1 5 4 2 7 6 10 9 8 13 15 11 14 12 20 16 18 17 19
+p8 2 3 4 5 1 7 6 9 10 8 13 12 11 15 14 17 16 20 18 19
+p9 4 3 2 1 5 7 8 9 6 10 12 15 11 13 14 19 20 17 18 16
+p10 1 5 2 4 3 8 7 6 9 10 11 15 13 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.
+Set of permutations < 'minperm'. Generating entire set.
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
+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
+p1 1 5 4 3 2 6 10 9 8 7 11 15 14 13 12 16 20 19 18 17
+p2 2 3 1 5 4 7 8 6 10 9 12 13 11 15 14 17 18 16 20 19
+p3 1 5 4 2 3 6 10 9 7 8 11 15 14 12 13 16 20 19 17 18
+p4 3 2 4 1 5 8 7 9 6 10 13 12 14 11 15 18 17 19 16 20
+p5 4 3 5 2 1 9 8 10 7 6 14 13 15 12 11 19 18 20 17 16
+p6 1 2 5 3 4 6 7 10 8 9 11 12 15 13 14 16 17 20 18 19
+p7 3 4 1 2 5 8 9 6 7 10 13 14 11 12 15 18 19 16 17 20
+p8 5 1 3 4 2 10 6 8 9 7 15 11 13 14 12 20 16 18 19 17
+p9 2 5 1 3 4 7 10 6 8 9 12 15 11 13 14 17 20 16 18 19
+p10 1 3 2 4 5 6 8 7 9 10 11 13 12 14 15 16 18 17 19 20
>
> ## time series within each level of Plot strata
> CTRL <- how(plots = plotStrata,
+ within = Within(type = "series"))
> shuffleSet(20, 10, CTRL)
+Set of permutations < 'minperm'. Generating entire set.
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
+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
+p1 2 3 4 5 1 10 6 7 8 9 14 15 11 12 13 18 19 20 16 17
+p2 3 4 5 1 2 10 6 7 8 9 12 13 14 15 11 17 18 19 20 16
+p3 2 3 4 5 1 10 6 7 8 9 11 12 13 14 15 18 19 20 16 17
+p4 2 3 4 5 1 10 6 7 8 9 13 14 15 11 12 19 20 16 17 18
+p5 3 4 5 1 2 7 8 9 10 6 14 15 11 12 13 19 20 16 17 18
+p6 3 4 5 1 2 7 8 9 10 6 15 11 12 13 14 17 18 19 20 16
+p7 2 3 4 5 1 10 6 7 8 9 13 14 15 11 12 18 19 20 16 17
+p8 1 2 3 4 5 6 7 8 9 10 13 14 15 11 12 17 18 19 20 16
+p9 3 4 5 1 2 10 6 7 8 9 12 13 14 15 11 18 19 20 16 17
+p10 4 5 1 2 3 9 10 6 7 8 14 15 11 12 13 18 19 20 16 17
> ## 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'.
+'nperm' >= set of all permutations: complete enumeration.
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
+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
+p1 2 3 4 5 1 7 8 9 10 6 12 13 14 15 11 17 18 19 20 16
+p2 3 4 5 1 2 8 9 10 6 7 13 14 15 11 12 18 19 20 16 17
+p3 4 5 1 2 3 9 10 6 7 8 14 15 11 12 13 19 20 16 17 18
+p4 5 1 2 3 4 10 6 7 8 9 15 11 12 13 14 20 16 17 18 19
>
>
>
@@ -1207,7 +1159,7 @@ Restricted by Plots: gl(4, 5) (4 plots)
> ###
> options(digits = 7L)
> base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed: 2.257 0.042 2.373 0 0
+Time elapsed: 3.867 0.043 3.906 0 0
> grDevices::dev.off()
null device
1
diff --git a/tests/test-all.R b/tests/testthat.R
similarity index 59%
rename from tests/test-all.R
rename to tests/testthat.R
index 4864248..6b5da8d 100644
--- a/tests/test-all.R
+++ b/tests/testthat.R
@@ -1,8 +1,8 @@
## Test `permute` using the `testthat` package
## Setup
-library(testthat)
-library(permute)
+library("testthat")
+library("permute")
## Runs the tests in inst/tests
-test_package("permute")
+test_check("permute")
diff --git a/tests/testthat/test-allPerms.R b/tests/testthat/test-allPerms.R
new file mode 100644
index 0000000..ceb52ee
--- /dev/null
+++ b/tests/testthat/test-allPerms.R
@@ -0,0 +1,289 @@
+library("testthat")
+library("permute")
+
+context("Testing allPerms()")
+
+test_that("allPerms - blocks - within block free", {
+ ## example data from Joris Meys from
+ ## http://stackoverflow.com/a/21313632/429846
+ thedata <- data.frame(score = c(replicate(4, sample(1:3))),
+ judge = rep(1:4, each = 3),
+ wine = rep.int(1:3, 4))
+
+ ## without the observed permutation included
+ hh <- how(within = Within("free"),
+ blocks = factor(thedata$judge),
+ complete = TRUE, maxperm = 1e9)
+ nr <- nrow(thedata)
+ np <- numPerms(nr, hh)
+ p <- allPerms(nr, control = hh)
+ expect_that(nrow(p), equals(np - 1)) ## default is to drop observed
+
+ ## check no duplicate indices within rows
+ dup <- any(apply(p, 1, function(x) any(duplicated(x))))
+ expect_false(dup, info = "Blocks: even; within: free; no observed")
+
+ ## with the observed permutation included
+ hh <- how(within = Within("free"),
+ blocks = factor(thedata$judge),
+ complete = TRUE, maxperm = 1e9,
+ observed = TRUE)
+ p <- allPerms(nr, control = hh)
+ expect_that(nrow(p), equals(np)) ## now includes observed
+
+ ## check no duplicate indices within rows
+ dup <- any(apply(p, 1, function(x) any(duplicated(x))))
+ expect_false(dup, info = "Blocks: even; within: free; observed")
+})
+
+test_that("allPerms; blocks: within; block free - uneven block sizes", {
+ fac <- factor(rep(1:3, times = c(2,2,4)))
+
+ ## without the observed permutation included
+ hh <- how(within = Within("free"),
+ blocks = fac,
+ complete = TRUE, maxperm = 1e9)
+ ll <- length(fac)
+ np <- numPerms(ll, hh)
+ expect_that(np, equals(prod(factorial(2), factorial(2), factorial(4))))
+ p <- allPerms(ll, control = hh)
+ expect_that(nrow(p), equals(np - 1)) ## default is to drop observed
+
+ ## check no duplicate indices within rows
+ dup <- any(apply(p, 1, function(x) any(duplicated(x))))
+ expect_false(dup, info = "Blocks: uneven; within: free; no observed")
+
+ ## with the observed permutation included
+ hh <- how(within = Within("free"),
+ blocks = fac,
+ complete = TRUE, maxperm = 1e9,
+ observed = TRUE)
+ p <- allPerms(ll, control = hh)
+ expect_that(nrow(p), equals(np)) ## now includes observed
+
+ ## check no duplicate indices within rows
+ dup <- any(apply(p, 1, function(x) any(duplicated(x))))
+ expect_false(dup, info = "Blocks: uneven; within: free; observed")
+})
+
+## testing plot-level permutations ------------------------------------
+test_that("allPerms: plots; within: free; even: yes;", {
+ fac <- rep(1:3, each = 3)
+
+ hh <- how(plots = Plots(strata = fac),
+ complete = TRUE, maxperm = 1e9)
+ ll <- length(fac)
+ np <- numPerms(ll, hh)
+ p <- allPerms(ll, control = hh)
+ expect_that(nrow(p), equals(np - 1), ## default is to drop observed
+ info = "Check n all perms == numPerms output.")
+
+ ## check no duplicate indices within rows
+ dup <- any(apply(p, 1, function(x) any(duplicated(x))))
+ expect_false(dup,
+ info = "Unique? Plots: even; within: free; no observed")
+
+ ## with the observed permutation included
+ hh <- how(within = Within("free"),
+ plot = Plots(strata = fac),
+ complete = TRUE, maxperm = 1e9,
+ observed = TRUE)
+ p <- allPerms(ll, control = hh)
+ expect_that(nrow(p), equals(np)) ## now includes observed
+
+ ## check no duplicate indices within rows
+ dup <- any(apply(p, 1, function(x) any(duplicated(x))))
+ expect_false(dup, info = "Unique? Plots: even; within: free; inc observed")
+})
+
+test_that("allPerms; plots: within; plot free - uneven plot sizes", {
+ fac <- factor(rep(1:3, times = c(2,2,4)))
+
+ ## without the observed permutation included
+ hh <- how(within = Within("free"),
+ plots = Plots(strata = fac),
+ complete = TRUE, maxperm = 1e9)
+ ll <- length(fac)
+ np <- numPerms(ll, hh)
+ expect_that(np, equals(prod(factorial(2), factorial(2), factorial(4))))
+ p <- allPerms(ll, control = hh)
+ expect_that(nrow(p), equals(np - 1)) ## default is to drop observed
+
+ ## check no duplicate indices within rows
+ dup <- any(apply(p, 1, function(x) any(duplicated(x))))
+ expect_false(dup, info = "Plots: uneven; within: free; no observed")
+
+ ## with the observed permutation included
+ hh <- how(within = Within("free"),
+ plots = Plots(strata = fac),
+ complete = TRUE, maxperm = 1e9,
+ observed = TRUE)
+ p <- allPerms(ll, control = hh)
+ expect_that(nrow(p), equals(np)) ## now includes observed
+
+ ## check no duplicate indices within rows
+ dup <- any(apply(p, 1, function(x) any(duplicated(x))))
+ expect_false(dup, info = "Plots: uneven; within: free; observed")
+})
+
+test_that("allPerms; permuting plots only -- non-contiguous plots", {
+ transect <- rep(gl(2,2), 2)
+ ll <- length(transect)
+ ctrl <- how(Within(type = "none"), Plots(type = "free", strata = transect))
+
+ ## without observed
+ ref <- matrix(c(3L,4L,1L,2L,7L,8L,5L,6L), nrow = 1, byrow = TRUE)
+ perm <- allPerms(ll, ctrl)
+ attr(perm, "control") <- NULL
+ attr(perm, "observed") <- NULL
+ class(perm) <- "matrix"
+ expect_that(numPerms(ll, control = ctrl), equals(2L),
+ info = "Number of permutations is wrong")
+ expect_that(nrow(perm), equals(1L),
+ info = "Number of rows in permutation matrix != 1")
+ expect_identical(perm, ref)
+
+ ## with observed
+ setObserved(ctrl) <- TRUE
+ ref <- matrix(c(1L,2L,3L,4L,5L,6L,7L,8L,
+ 3L,4L,1L,2L,7L,8L,5L,6L), nrow = 2, byrow = TRUE)
+ perm <- allPerms(ll, ctrl)
+ perm <- as.matrix(perm)
+ expect_that(numPerms(ll, control = ctrl), equals(2L),
+ info = "Number of permutations is wrong")
+ expect_that(nrow(perm), equals(2L),
+ info = "Number of rows in permutation matrix != 2")
+ expect_identical(perm, ref,
+ info = "All permutations doesn't match reference")
+})
+
+## Grid permutations
+test_that("Can generate permutations from a grid design", {
+ ## spatial grids within each level of plot, 3 x (4r x 4c)
+ nr <- 4
+ nc <- 4
+ np <- 3 ## number of plots
+ plots <- Plots(gl(np, prod(nr, nc)))
+ CTRL <- how(plots = plots,
+ within = Within(type = "grid", ncol = nc, nrow = nr))
+ perms <- allPerms(prod(nr, nc, np), control = CTRL)
+ nperms <- numPerms(prod(nr, nc, np), control = CTRL)
+
+ expect_is(perms, "allPerms")
+ expect_is(perms, "matrix")
+ expect_equal(nperms, nrow(perms) + 1L)
+
+ ## mirroring
+ nr <- 3
+ nc <- 3
+ np <- 2 ## number of plots
+ plots <- Plots(gl(np, prod(nr, nc)))
+ CTRL <- how(plots = plots,
+ within = Within(type = "grid", ncol = nc, nrow = nr,
+ mirror = TRUE))
+ perms <- allPerms(prod(nr, nc, np), control = CTRL)
+ nperms <- numPerms(prod(nr, nc, np), control = CTRL)
+
+ expect_is(perms, "allPerms")
+ expect_is(perms, "matrix")
+ expect_equal(nperms, nrow(perms) + 1L)
+})
+
+test_that("grids with 2 columns only work correctly", {
+ ## spatial grids within each level of plot, (4r x 2c)
+ nr <- 4
+ nc <- 2
+ CTRL <- how(within = Within(type = "grid", ncol = nc, nrow = nr))
+ perms <- allPerms(prod(nr, nc), control = CTRL)
+ nperms <- numPerms(prod(nr, nc), control = CTRL)
+
+ expect_is(perms, "allPerms")
+ expect_is(perms, "matrix")
+ expect_equal(nperms, nrow(perms) + 1L)
+
+ ## spatial grids within each level of plot, 3 x (4r x 2c)
+ nr <- 4
+ nc <- 2
+ np <- 3 ## number of plots
+ plots <- Plots(gl(np, prod(nr, nc)))
+ CTRL <- how(plots = plots,
+ within = Within(type = "grid", ncol = nc, nrow = nr))
+ perms <- allPerms(prod(nr, nc, np), control = CTRL)
+ nperms <- numPerms(prod(nr, nc, np), control = CTRL)
+
+ expect_is(perms, "allPerms")
+ expect_is(perms, "matrix")
+ expect_equal(nperms, nrow(perms) + 1L)
+})
+
+
+test_that("grids with mirroring & 2 columns only work correctly", {
+ ## spatial grids within each level of plot, (4r x 2c)
+ nr <- 4
+ nc <- 2
+ CTRL <- how(within = Within(type = "grid", ncol = nc, nrow = nr,
+ mirror = TRUE))
+ perms <- allPerms(prod(nr, nc), control = CTRL)
+ nperms <- numPerms(prod(nr, nc), control = CTRL)
+
+ expect_is(perms, "allPerms")
+ expect_is(perms, "matrix")
+ expect_equal(nperms, nrow(perms) + 1L)
+
+ ## spatial grids within each level of plot, 3 x (4r x 2c)
+ nr <- 4
+ nc <- 2
+ np <- 3 ## number of plots
+ plots <- Plots(gl(np, prod(nr, nc)))
+ CTRL <- how(plots = plots,
+ within = Within(type = "grid", ncol = nc, nrow = nr,
+ mirror = TRUE))
+ perms <- allPerms(prod(nr, nc, np), control = CTRL)
+ nperms <- numPerms(prod(nr, nc, np), control = CTRL)
+
+ expect_is(perms, "allPerms")
+ expect_is(perms, "matrix")
+ expect_equal(nperms, nrow(perms) + 1L)
+})
+
+test_that("same grid permutation within plots", {
+ ## spatial grids within each level of plot, 3 x (4r x 2c)
+ nr <- 4
+ nc <- 2
+ np <- 3 ## number of plots
+ plots <- Plots(gl(np, prod(nr, nc)))
+ CTRL <- how(plots = plots,
+ within = Within(type = "grid", ncol = nc, nrow = nr,
+ constant = TRUE))
+ perms <- allPerms(prod(nr, nc, np), control = CTRL)
+ nperms <- numPerms(prod(nr, nc, np), control = CTRL)
+
+ expect_is(perms, "allPerms")
+ expect_is(perms, "matrix")
+ expect_equal(nperms, nrow(perms) + 1L)
+})
+
+test_that("same grid permutation within plots & mirroring", {
+ ## spatial grids within each level of plot, 3 x (4r x 2c)
+ nr <- 4
+ nc <- 2
+ np <- 3 ## number of plots
+ plots <- Plots(gl(np, prod(nr, nc)))
+ CTRL <- how(plots = plots,
+ within = Within(type = "grid", ncol = nc, nrow = nr,
+ constant = TRUE, mirror = TRUE))
+ perms <- allPerms(prod(nr, nc, np), control = CTRL)
+ nperms <- numPerms(prod(nr, nc, np), control = CTRL)
+
+ expect_is(perms, "allPerms")
+ expect_is(perms, "matrix")
+ expect_equal(nperms, nrow(perms) + 1L)
+})
+
+test_that("allPerms works with complex, but small, design", {
+ h <- how(within = Within(type = "series", constant = TRUE),
+ plots = Plots(strata = gl(2, 5), type = "series", mirror = TRUE))
+ ap <- allPerms(10, control = h)
+ expect_is(ap, "matrix")
+ expect_equal(nrow(ap), 10 - 1L)
+})
diff --git a/tests/testthat/test-as-methods.R b/tests/testthat/test-as-methods.R
new file mode 100644
index 0000000..cbf3f30
--- /dev/null
+++ b/tests/testthat/test-as-methods.R
@@ -0,0 +1,18 @@
+library("testthat")
+library("permute")
+
+context("Testing as.foo() methods")
+
+test_that("as.matrix allPerms method", {
+ ap <- allPerms(1:3)
+ m <- as.matrix(ap)
+ expect_is(m, "matrix")
+ expect_false(inherits(m, "allPerms"))
+})
+
+test_that("as.matrix permutationMatrix method", {
+ perms <- shuffleSet(10, nset = 10)
+ m <- as.matrix(perms)
+ expect_is(m, "matrix")
+ expect_false(inherits(m, "permutationMatrix"))
+})
diff --git a/tests/testthat/test-blocks.R b/tests/testthat/test-blocks.R
new file mode 100644
index 0000000..66fd04a
--- /dev/null
+++ b/tests/testthat/test-blocks.R
@@ -0,0 +1,11 @@
+library("testthat")
+library("permute")
+
+context("Testing blocks() and Blocks()")
+
+test_that("Blocks() returns a list with 'strata'", {
+ f <- gl(4, 10)
+ b <- Blocks(f)
+ expect_is(b, "list")
+ expect_true("strata" %in% names(b))
+})
diff --git a/inst/tests/test-check.R b/tests/testthat/test-check.R
similarity index 61%
rename from inst/tests/test-check.R
rename to tests/testthat/test-check.R
index 6b63801..b55627c 100644
--- a/inst/tests/test-check.R
+++ b/tests/testthat/test-check.R
@@ -1,5 +1,5 @@
-library(testthat)
-library_if_available(permute)
+library("testthat")
+library("permute")
context("Testing check()")
@@ -23,3 +23,14 @@ test_that("check returns observed ordering in set of all permutations *if* asked
pp <- check(vec, control = h)
expect_that(nrow(pp$control$all.perms), equals(n))
})
+
+## test that check throws an error when within and plot permutation
+## type is "none"
+test_that("check detects if nothing to permute", {
+ pl <- gl(4, 3)
+ n <- 12
+ h <- how(within = Within(type = "none"),
+ plots = Plots(strata = pl, type = "none"))
+ expect_error(check(seq_len(n), control = h),
+ regexp = "Permutation 'type' is \"none\" for both 'plots' & 'within'.\nNothing to permute.")
+})
diff --git a/tests/testthat/test-get-methods.R b/tests/testthat/test-get-methods.R
new file mode 100644
index 0000000..37ffca5
--- /dev/null
+++ b/tests/testthat/test-get-methods.R
@@ -0,0 +1,22 @@
+library("testthat")
+library("permute")
+
+context("Testing get methods")
+
+test_that("default methods for get functions", {
+ v <- 1:10
+ expect_error(getBlocks(v), regexp = "No default method")
+ expect_error(getPlots(v), regexp = "No default method")
+ expect_error(getWithin(v), regexp = "No default method")
+ expect_error(getStrata(v), regexp = "No default method")
+ expect_error(getType(v), regexp = "No default method")
+ expect_error(getMirror(v), regexp = "No default method")
+ expect_error(getConstant(v), regexp = "No default method")
+ expect_error(getNperm(v), regexp = "No default method")
+ expect_error(getMaxperm(v), regexp = "No default method")
+ expect_error(getMinperm(v), regexp = "No default method")
+ expect_error(getMake(v), regexp = "No default method")
+ expect_error(getObserved(v), regexp = "No default method")
+ expect_error(getAllperms(v), regexp = "No default method")
+ expect_error(getComplete(v), regexp = "No default method")
+})
diff --git a/tests/testthat/test-how.R b/tests/testthat/test-how.R
new file mode 100644
index 0000000..d864299
--- /dev/null
+++ b/tests/testthat/test-how.R
@@ -0,0 +1,14 @@
+library("testthat")
+library("permute")
+
+context("Testing how()")
+
+test_that("how() works with explicit NULL blocks arg", {
+ ## Example of failure from Jari github #8
+ h <- how(blocks = NULL)
+ expect_that(h, is_a("how"))
+})
+
+test_that("print method for how", {
+ expect_output(print(how()), regexp = "Permutation Design:")
+})
diff --git a/tests/testthat/test-nobs.R b/tests/testthat/test-nobs.R
new file mode 100644
index 0000000..8c2d635
--- /dev/null
+++ b/tests/testthat/test-nobs.R
@@ -0,0 +1,34 @@
+library("testthat")
+library("permute")
+
+context("Testing nobs() methods")
+
+test_that("numeric nobs method", {
+ v <- runif(10)
+ n <- nobs(v)
+ expect_identical(n, 10L)
+})
+
+test_that("integer nobs method", {
+ v <- 1L:10L
+ n <- nobs(v)
+ expect_identical(n, 10L)
+})
+
+test_that("matrix nobs method", {
+ m <- matrix(1:9, nrow = 3)
+ n <- nobs(m)
+ expect_identical(n, 3L)
+})
+
+test_that("data frame nobs method", {
+ df <- as.data.frame(matrix(1:9, nrow = 3))
+ n <- nobs(df)
+ expect_identical(n, 3L)
+})
+
+test_that("factor nobs method", {
+ f <- factor(c(1,2,3,2,1,4,5,2,1,4))
+ n <- nobs(f)
+ expect_identical(n, 10L)
+})
diff --git a/tests/testthat/test-numPerms.R b/tests/testthat/test-numPerms.R
new file mode 100644
index 0000000..5c89b87
--- /dev/null
+++ b/tests/testthat/test-numPerms.R
@@ -0,0 +1,12 @@
+library("testthat")
+library("permute")
+
+context("Testing shuffleSet()")
+
+test_that("numPerms works with complex, but small, design", {
+ h <- how(within = Within(type = "series", constant = TRUE),
+ plots = Plots(strata = gl(2, 5), type = "series", mirror = TRUE))
+ np <- numPerms(10, control = h)
+ expect_is(np, "numeric")
+ expect_equal(np, 10)
+})
diff --git a/tests/testthat/test-permute-fun.R b/tests/testthat/test-permute-fun.R
new file mode 100644
index 0000000..ea45226
--- /dev/null
+++ b/tests/testthat/test-permute-fun.R
@@ -0,0 +1,35 @@
+library("testthat")
+library("permute")
+
+context("Testing permute() function")
+
+test_that("permute() returns ith row of all perms", {
+ h <- how()
+ v <- 1:4
+ ch <- check(v, h, quietly = TRUE)
+ h <- ch$control
+ p1 <- permute(1, n = length(v), control = h)
+ expect_equal(length(p1), 4L)
+ expect_is(p1, "integer")
+ expect_equal(p1, c(1L, 2L, 4L, 3L))
+ expect_equal(p1, getAllperms(h)[1, ])
+
+ p21 <- permute(21, n = length(v), control = h)
+ expect_equal(length(p21), 4L)
+ expect_is(p21, "integer")
+ expect_equal(p21, c(4L, 2L, 3L, 1L))
+ expect_equal(p21, getAllperms(h)[21, ])
+})
+
+test_that("permute() returns a random permutation if no $allperms", {
+ h <- how()
+ v <- 1:10 # want something big so no allperms
+ p <- permute(10, n = length(v), control = h)
+ expect_equal(length(p), length(v))
+ expect_true(all(p >= 1))
+ expect_true(all(p <= 10))
+
+ setComplete(h) <- TRUE
+ expect_warning(permute(10, n = length(v), control = h),
+ regexp = "Returning a random permutation")
+})
diff --git a/tests/testthat/test-set-methods.R b/tests/testthat/test-set-methods.R
new file mode 100644
index 0000000..75782bb
--- /dev/null
+++ b/tests/testthat/test-set-methods.R
@@ -0,0 +1,171 @@
+library("testthat")
+library("permute")
+
+context("Testing set<- methods")
+
+test_that("default methods for get functions", {
+ v <- 1:10
+ expect_error(setNperm(v) <- 10, regexp = "No default method")
+ expect_error(setMaxperm(v) <- 10, regexp = "No default method")
+ expect_error(setMinperm(v) <- 10, regexp = "No default method")
+ expect_error(setComplete(v) <- TRUE, regexp = "No default method")
+ expect_error(setBlocks(v) <- TRUE, regexp = "No default method")
+ expect_error(setAllperms(v) <- 1:10, regexp = "No default method")
+ expect_error(setObserved(v) <- TRUE, regexp = "No default method")
+ expect_error(setPlots(v) <- Plots(), regexp = "No default method")
+ expect_error(setWithin(v) <- Within(), regexp = "No default method")
+ expect_error(setStrata(v) <- gl(2, 5), regexp = "No default method")
+ expect_error(setRow(v) <- 4, regexp = "No default method")
+ expect_error(setCol(v) <- 5, regexp = "No default method")
+ expect_error(setDim(v) <- c(2,3), regexp = "No default method")
+ expect_error(setType(v) <- "series", regexp = "No default method")
+ expect_error(setMirror(v) <- TRUE, regexp = "No default method")
+ expect_error(setMake(v) <- TRUE, regexp = "No default method")
+ expect_error(setConstant(v) <- "series", regexp = "No default method")
+})
+
+test_that("how() set methods throw errors where not appropriate for use", {
+ h <- how()
+ expect_error(setDim(h) <- c(2,3), regexp = "can not be used directly on '\"how\"' objects")
+ expect_error(setMirror(h) <- TRUE, regexp = "can not be used directly on '\"how\"' objects")
+ expect_error(setConstant(h) <- TRUE, regexp = "can not be used directly on '\"how\"' objects")
+ expect_error(setType(h) <- "series", regexp = "can not be used directly on '\"how\"' objects")
+ expect_error(setRow(h) <- 2, regexp = "can not be used directly on '\"how\"' objects")
+ expect_error(setCol(h) <- 3, regexp = "can not be used directly on '\"how\"' objects")
+})
+
+test_that("set within for class how works", {
+ h <- how()
+ setWithin(h) <- Within(type = "series")
+ expect_identical(getType(h, which = "within"), "series")
+})
+
+test_that("set plots for class how works", {
+ h <- how()
+ setPlots(h) <- Plots(type = "series")
+ expect_identical(getType(h, which = "plots"), "series")
+})
+
+test_that("test setMinperm work", {
+ h <- how()
+ setMinperm(h) <- 999
+ expect_is(h, "how")
+ expect_equal(getMinperm(h), 999)
+})
+
+test_that("test setMaxperm work", {
+ h <- how()
+ nperm <- 99999
+ setMaxperm(h) <- nperm
+ expect_is(h, "how")
+ expect_equal(getMaxperm(h), nperm)
+})
+
+test_that("test setStrata works", {
+ h <- how()
+ f <- gl(5,5)
+ setStrata(h) <- f
+ expect_is(h, "how")
+ expect_identical(getStrata(h), f)
+
+ plots <- getPlots(h)
+ f <- gl(4,5)
+ setStrata(plots) <- f
+ expect_identical(getStrata(plots), f)
+ setPlots(h) <- plots
+ expect_identical(getStrata(h), f)
+})
+
+test_that("test setRow<- works", {
+ f <- gl(9, 25)
+ h <- how(within = Within(type = "grid", nrow = 5, ncol = 5),
+ plots = Plots(type = "grid", nrow = 3, ncol = 3,
+ strata = f))
+ w <- getWithin(h)
+ setRow(w) <- 2
+ expect_identical(getRow(w), 2L)
+ expect_is(w, "Within")
+
+ p <- getPlots(h)
+ setRow(p) <- 4
+ expect_identical(getRow(p), 4L)
+ expect_is(p, "Plots")
+})
+
+test_that("test setCol<- works", {
+ f <- gl(9, 25)
+ h <- how(within = Within(type = "grid", nrow = 5, ncol = 5),
+ plots = Plots(type = "grid", nrow = 3, ncol = 3,
+ strata = f))
+ w <- getWithin(h)
+ setCol(w) <- 2
+ expect_identical(getCol(w), 2L)
+ expect_is(w, "Within")
+
+ p <- getPlots(h)
+ setCol(p) <- 4
+ expect_identical(getCol(p), 4L)
+ expect_is(p, "Plots")
+})
+
+test_that("test setDim<- works", {
+ f <- gl(9, 25)
+ h <- how(within = Within(type = "grid", nrow = 5, ncol = 5),
+ plots = Plots(type = "grid", nrow = 3, ncol = 3,
+ strata = f))
+ w <- getWithin(h)
+ setDim(w) <- c(2, 4)
+ expect_identical(getDim(w), c(2L, 4L))
+ expect_is(w, "Within")
+
+ p <- getPlots(h)
+ setDim(p) <- c(4, 3)
+ expect_identical(getDim(p), c(4L, 3L))
+ expect_is(p, "Plots")
+})
+
+test_that("test setType<- works", {
+ f <- gl(9, 25)
+ h <- how(within = Within(type = "grid", nrow = 5, ncol = 5),
+ plots = Plots(type = "series", strata = f))
+ w <- getWithin(h)
+ setType(w) <- "free"
+ expect_is(w, "Within")
+ expect_identical(getType(w), "free")
+
+ p <- getPlots(h)
+ expect_error(setType(p) <- "strata",
+ regexp = "Invalid permutation type")
+ setType(p) <- "none"
+ expect_is(p, "Plots")
+ expect_identical(getType(p), "none")
+})
+
+test_that("test setMirror<- works", {
+ f <- gl(9, 25)
+ h <- how(within = Within(type = "grid", nrow = 5, ncol = 5),
+ plots = Plots(type = "series", strata = f))
+ w <- getWithin(h)
+ setMirror(w) <- TRUE
+ expect_is(w, "Within")
+ expect_true(getMirror(w))
+
+ p <- getPlots(h)
+ setMirror(p) <- TRUE
+ expect_is(p, "Plots")
+ expect_true(getMirror(p))
+})
+
+test_that("test setConstant<- works", {
+ f <- gl(9, 25)
+ h <- how(within = Within(type = "grid", nrow = 5, ncol = 5),
+ plots = Plots(type = "series", strata = f))
+ w <- getWithin(h)
+ setConstant(w) <- TRUE
+ expect_is(w, "Within")
+ expect_true(getConstant(w))
+
+ p <- getPlots(h)
+ expect_error(setConstant(p) <- TRUE,
+ regexp = "setConstant` does not apply to '\"Plots\"' objects.")
+})
diff --git a/tests/testthat/test-shuffle-utils.R b/tests/testthat/test-shuffle-utils.R
new file mode 100644
index 0000000..3f2b5d4
--- /dev/null
+++ b/tests/testthat/test-shuffle-utils.R
@@ -0,0 +1,64 @@
+library("testthat")
+library("permute")
+
+context("Testing shuffle-util functions")
+
+test_that("shuffelStrata works for various 'type's", {
+ f <- gl(4,5)
+ perm <- shuffleStrata(f, type = "free")
+ expect_equal(length(perm), length(f))
+ expect_true(all(perm <= 20))
+ expect_true(all(perm >= 1))
+ perm <- shuffleStrata(f, type = "series")
+ expect_equal(length(perm), length(f))
+ expect_true(all(perm <= 20))
+ expect_true(all(perm >= 1))
+ perm <- shuffleStrata(f, type = "grid", ncol = 2, nrow = 2)
+ expect_equal(length(perm), length(f))
+ expect_true(all(perm <= 20))
+ expect_true(all(perm >= 1))
+ expect_error(shuffleStrata(f, type = "unknown"),
+ regexp = "Invalid permutation type")
+})
+
+test_that("shuffleGrid works with only ncol and nrow args", {
+ nr <- 5
+ nc <- 5
+ perm <- shuffleGrid(ncol = nc, nrow = nr)
+ expect_equal(length(perm), prod(nr, nc))
+})
+
+test_that("shuffleGrid works with mirror & flip combinations", {
+ nr <- 5
+ nc <- 5
+ perm <- shuffleGrid(ncol = nc, nrow = nr, mirror = TRUE)
+ expect_equal(length(perm), prod(nr, nc))
+ perm <- shuffleGrid(ncol = nc, nrow = nr, mirror = TRUE)
+ expect_equal(length(perm), prod(nr, nc))
+ perm <- shuffleGrid(ncol = nc, nrow = nr, mirror = TRUE,
+ flip = c(TRUE, FALSE))
+ expect_equal(length(perm), prod(nr, nc))
+ perm <- shuffleGrid(ncol = nc, nrow = nr, mirror = TRUE,
+ flip = c(FALSE, TRUE))
+ expect_equal(length(perm), prod(nr, nc))
+})
+
+test_that("shuffleGrid works with start.row & start.col", {
+ nr <- 5
+ nc <- 5
+ perm <- shuffleGrid(ncol = nc, nrow = nr,
+ start.row = 2)
+ expect_equal(length(perm), prod(nr, nc))
+ expect_true(all(perm <= 25))
+ expect_true(all(perm >=1))
+ perm <- shuffleGrid(ncol = nc, nrow = nr,
+ start.col = 4)
+ expect_equal(length(perm), prod(nr, nc))
+ expect_true(all(perm <= 25))
+ expect_true(all(perm >=1))
+ perm <- shuffleGrid(ncol = nc, nrow = nr,
+ start.col = 4, start.row = 2)
+ expect_equal(length(perm), prod(nr, nc))
+ expect_true(all(perm <= 25))
+ expect_true(all(perm >=1))
+})
diff --git a/inst/tests/test-shuffle.R b/tests/testthat/test-shuffle.R
similarity index 76%
rename from inst/tests/test-shuffle.R
rename to tests/testthat/test-shuffle.R
index 254f0e1..3c5fd7c 100644
--- a/inst/tests/test-shuffle.R
+++ b/tests/testthat/test-shuffle.R
@@ -1,5 +1,5 @@
-library(testthat)
-library_if_available(permute)
+library("testthat")
+library("permute")
context("Testing shuffle()")
@@ -41,3 +41,13 @@ test_that("shuffle() works for non-contigous blocks of samples", {
out2 <- factor(as.integer(rep(c(3,2,1,4), 5)), levels = 1:4)
expect_that(Plot[result], is_identical_to(out2))
})
+
+test_that("shuffle can permute both plots and within in presence of blocks", {
+ ## Example from @LindsayVass on github #9
+ control <- how(within = Within(type = "free"),
+ plots = Plots(strata = rep(gl(2,7),2), type = "free"),
+ blocks = gl(2, 14))
+ permSet <- shuffle(28, control = control)
+ expect_that(length(permSet), is_identical_to(28L))
+ expect_that(permSet, is_a("integer"))
+})
diff --git a/tests/testthat/test-shuffleSet.R b/tests/testthat/test-shuffleSet.R
new file mode 100644
index 0000000..d9ffb82
--- /dev/null
+++ b/tests/testthat/test-shuffleSet.R
@@ -0,0 +1,85 @@
+library("testthat")
+library("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"))
+})
+
+test_that("shuffle can permute both plots and within in presence of blocks", {
+ ## Example from @LindsayVass on github #9
+ control <- how(within = Within(type = "free"),
+ plots = Plots(strata = rep(gl(2,7),2), type = "free"),
+ blocks = gl(2, 14))
+ permSet <- shuffleSet(28, 100, control = control)
+ expect_that(nrow(permSet), is_identical_to(100L))
+ expect_that(ncol(permSet), is_identical_to(28L))
+ expect_that(permSet, is_a("permutationMatrix"))
+ expect_that(permSet, is_a("matrix"))
+})
+
+test_that("print method for permutationMatrix works", {
+ h <- how()
+ perms <- shuffleSet(10, nset = 10, control = h)
+ expect_output(print(perms), regexp = "No. of Permutations:")
+
+ h <- how(blocks = gl(5,10))
+ perms <- shuffleSet(50, nset = 20, control = h)
+ expect_output(print(perms), regexp = "Restricted by Blocks:")
+ expect_output(print(perms), regexp = "blocks;")
+
+ h <- how(plots = Plots(strata = gl(5,10)))
+ perms <- shuffleSet(50, nset = 20, control = h)
+ expect_output(print(perms), regexp = "Restricted by Plots:")
+ expect_output(print(perms), regexp = "plots;")
+
+ h <- how(plots = Plots(strata = gl(10,10)),
+ blocks = gl(2, 50))
+ perms <- shuffleSet(100, nset = 20, control = h)
+ expect_output(print(perms), regexp = "Restricted by Plots:")
+ expect_output(print(perms), regexp = "plots & blocks;")
+
+ h <- how(within = Within(type = "series", mirror = TRUE))
+ perms <- shuffleSet(10, nset = 20, control = h)
+ expect_output(print(perms), regexp = "; mirrored")
+
+ h <- how(within = Within(type = "series", constant = TRUE),
+ plots = Plots(strata = gl(2, 5), type = "series", mirror = TRUE))
+ perms <- shuffleSet(10, nset = 20, control = h)
+ expect_output(print(perms), regexp = "; same permutation")
+})
diff --git a/vignettes/Z.cls b/vignettes/Z.cls
deleted file mode 100644
index 0adeb55..0000000
--- a/vignettes/Z.cls
+++ /dev/null
@@ -1,247 +0,0 @@
-\def\fileversion{1.2}
-\def\filename{Z}
-\def\filedate{2007/02/12}
-%%
-%% Package `Z' to use with LaTeX2e for Z reports
-%% Copyright (C) 2004 Achim Zeileis
-%%
-\NeedsTeXFormat{LaTeX2e}
-\ProvidesClass{Z}[\filedate\space\fileversion\space Z class by Achim Zeileis]
-
-%% options
-\LoadClass[10pt,a4paper,twoside]{article}
-\newif\if at notitle
-\@notitlefalse
-\newif\if at noheadings
-\@noheadingsfalse
-\newif\if at shortnames
-\@shortnamesfalse
-\DeclareOption{notitle}{\@notitletrue}
-\DeclareOption{noheadings}{\@noheadingstrue}
-\DeclareOption{shortnames}{\@shortnamestrue}
-\ProcessOptions
-
-%% required packages
-\RequirePackage{graphicx,a4wide,color,hyperref,ae,fancyvrb,thumbpdf}
-\RequirePackage[T1]{fontenc}
-%% bibliography
-\if at shortnames
- \usepackage[authoryear,round]{natbib}
-\else
- \usepackage[authoryear,round,longnamesfirst]{natbib}
-\fi
-\bibpunct{(}{)}{;}{a}{}{,}
-\bibliographystyle{jss}
-
-%% paragraphs
-\setlength{\parskip}{0.7ex plus0.1ex minus0.1ex}
-\setlength{\parindent}{0em}
-
-%% for all publications
-\newcommand{\Plaintitle}[1]{\def\@Plaintitle{#1}}
-\newcommand{\Shorttitle}[1]{\def\@Shorttitle{#1}}
-\newcommand{\Plainauthor}[1]{\def\@Plainauthor{#1}}
-\newcommand{\Keywords}[1]{\def\@Keywords{#1}}
-\newcommand{\Plainkeywords}[1]{\def\@Plainkeywords{#1}}
-\newcommand{\Abstract}[1]{\def\@Abstract{#1}}
-
-%% defaults
-\author{Firstname Lastname\\Affiliation}
-\title{Title}
-\Abstract{---!!!---an abstract is required---!!!---}
-\Plainauthor{\@author}
-\Plaintitle{\@title}
-\Shorttitle{\@title}
-\Keywords{---!!!---at least one keyword is required---!!!---}
-\Plainkeywords{\@Keywords}
-
-%% Sweave(-like)
-\DefineVerbatimEnvironment{Sinput}{Verbatim}{fontshape=sl}
-\DefineVerbatimEnvironment{Soutput}{Verbatim}{}
-\DefineVerbatimEnvironment{Scode}{Verbatim}{fontshape=sl}
-\newenvironment{Schunk}{}{}
-\setkeys{Gin}{width=0.8\textwidth}
-
-%% new \maketitle
-\def\maketitle{
- \begingroup
- \def\thefootnote{\fnsymbol{footnote}}
- \def\@makefnmark{\hbox to 0pt{$^{\@thefnmark}$\hss}}
- \long\def\@makefntext##1{\parindent 1em\noindent
- \hbox to1.8em{\hss $\m at th ^{\@thefnmark}$}##1}
- \@maketitle \@thanks
- \endgroup
- \setcounter{footnote}{0}
-
- \if at noheadings
- %% \thispagestyle{empty}
- %% \markboth{\centerline{\@Shorttitle}}{\centerline{\@Plainauthor}}
- %% \pagestyle{myheadings}
- \else
- \thispagestyle{empty}
- \markboth{\centerline{\@Shorttitle}}{\centerline{\@Plainauthor}}
- \pagestyle{myheadings}
- \fi
-
- \let\maketitle\relax \let\@maketitle\relax
- \gdef\@thanks{}\gdef\@author{}\gdef\@title{}\let\thanks\relax
-}
-
-% Author information can be set in various styles:
-% For several authors from the same institution:
-% \author{Author 1 \and ... \and Author n \\
-% Address line \\ ... \\ Address line}
-% if the names do not fit well on one line use
-% Author 1 \\ {\bf Author 2} \\ ... \\ {\bf Author n} \\
-% For authors from different institutions:
-% \author{Author 1 \\ Address line \\ ... \\ Address line
-% \And ... \And
-% Author n \\ Address line \\ ... \\ Address line}
-% To start a seperate ``row'' of authors use \AND, as in
-% \author{Author 1 \\ Address line \\ ... \\ Address line
-% \AND
-% Author 2 \\ Address line \\ ... \\ Address line \And
-% Author 3 \\ Address line \\ ... \\ Address line}
-
-\def\@maketitle{\vbox{\hsize\textwidth \linewidth\hsize
- {\centering
- {\LARGE\bf \@title\par}
- \vskip 0.2in plus 1fil minus 0.1in
- {
- \def\and{\unskip\enspace{\rm and}\enspace}%
- \def\And{\end{tabular}\hss \egroup \hskip 1in plus 2fil
- \hbox to 0pt\bgroup\hss \begin{tabular}[t]{c}\large\bf\rule{\z@}{24pt}\ignorespaces}%
- \def\AND{\end{tabular}\hss\egroup \hfil\hfil\egroup
- \vskip 0.1in plus 1fil minus 0.05in
- \hbox to \linewidth\bgroup\rule{\z@}{10pt} \hfil\hfil
- \hbox to 0pt\bgroup\hss \begin{tabular}[t]{c}\large\bf\rule{\z@}{24pt}\ignorespaces}
- \hbox to \linewidth\bgroup\rule{\z@}{10pt} \hfil\hfil
- \hbox to 0pt\bgroup\hss \begin{tabular}[t]{c}\large\bf\rule{\z@}{24pt}\@author
- \end{tabular}\hss\egroup
- \hfil\hfil\egroup}
- \vskip 0.3in minus 0.1in
- \hrule
- \begin{abstract}
- \@Abstract
- \end{abstract}}
- \textit{Keywords}:~\@Keywords.
- \vskip 0.1in minus 0.05in
- \hrule
- \vskip 0.2in minus 0.1in
-}}
-
-%% \def\@maketitle{\vbox{\hsize\textwidth \linewidth\hsize
-%% {\centering
-%% {\LARGE\bf \@title\par}
-%% \def\And{\end{tabular}\hfil\linebreak[0]\hfil
-%% \begin{tabular}[t]{c}\large\bf\rule{\z@}{24pt}\ignorespaces}%
-%% \begin{tabular}[t]{c}\large\bf\rule{\z@}{24pt}\@author\end{tabular}%
-%% \vskip 0.3in minus 0.1in
-%% \hrule
-%% \begin{abstract}
-%% \@Abstract
-%% \end{abstract}}
-%% \textit{Keywords}:~\@Keywords.
-%% \vskip 0.1in minus 0.05in
-%% \hrule
-%% \vskip 0.2in minus 0.1in
-%% }}
-
-
-%% sections, subsections, and subsubsections
-\newlength{\preXLskip}
-\newlength{\preLskip}
-\newlength{\preMskip}
-\newlength{\preSskip}
-\newlength{\postMskip}
-\newlength{\postSskip}
-\setlength{\preXLskip}{1.8\baselineskip plus 0.5ex minus 0ex}
-\setlength{\preLskip}{1.5\baselineskip plus 0.3ex minus 0ex}
-\setlength{\preMskip}{1\baselineskip plus 0.2ex minus 0ex}
-\setlength{\preSskip}{.8\baselineskip plus 0.2ex minus 0ex}
-\setlength{\postMskip}{.5\baselineskip plus 0ex minus 0.1ex}
-\setlength{\postSskip}{.3\baselineskip plus 0ex minus 0.1ex}
-
-\newcommand{\jsssec}[2][default]{\vskip \preXLskip%
- \pdfbookmark[1]{#1}{Section.\thesection.#1}%
- \refstepcounter{section}%
- \centerline{\textbf{\Large \thesection. #2}} \nopagebreak
- \vskip \postMskip \nopagebreak}
-\newcommand{\jsssecnn}[1]{\vskip \preXLskip%
- \centerline{\textbf{\Large #1}} \nopagebreak
- \vskip \postMskip \nopagebreak}
-
-\newcommand{\jsssubsec}[2][default]{\vskip \preMskip%
- \pdfbookmark[2]{#1}{Subsection.\thesubsection.#1}%
- \refstepcounter{subsection}%
- \textbf{\large \thesubsection. #2} \nopagebreak
- \vskip \postSskip \nopagebreak}
-\newcommand{\jsssubsecnn}[1]{\vskip \preMskip%
- \textbf{\large #1} \nopagebreak
- \vskip \postSskip \nopagebreak}
-
-\newcommand{\jsssubsubsec}[2][default]{\vskip \preSskip%
- \pdfbookmark[3]{#1}{Subsubsection.\thesubsubsection.#1}%
- \refstepcounter{subsubsection}%
- {\large \thesubsubsection. \textit{#2}} \nopagebreak
- \vskip \postSskip \nopagebreak}
-\newcommand{\jsssubsubsecnn}[1]{\vskip \preSskip%
- {\textit{\large #1}} \nopagebreak
- \vskip \postSskip \nopagebreak}
-
-\newcommand{\jsssimplesec}[2][default]{\vskip \preLskip%
-%% \pdfbookmark[1]{#1}{Section.\thesection.#1}%
- \refstepcounter{section}%
- \textbf{\large #1} \nopagebreak
- \vskip \postSskip \nopagebreak}
-\newcommand{\jsssimplesecnn}[1]{\vskip \preLskip%
- \textbf{\large #1} \nopagebreak
- \vskip \postSskip \nopagebreak}
-
-\renewcommand{\section}{\secdef \jsssec \jsssecnn}
-\renewcommand{\subsection}{\secdef \jsssubsec \jsssubsecnn}
-\renewcommand{\subsubsection}{\secdef \jsssubsubsec \jsssubsubsecnn}
-
-%% colors
-\definecolor{Red}{rgb}{0.5,0,0} %%{0.7,0,0}
-\definecolor{Blue}{rgb}{0,0,0.5} %%{0,0,0.8}
-\hypersetup{%
- hyperindex = {true},
- colorlinks = {true},
- linktocpage = {true},
- plainpages = {false},
- linkcolor = {Blue},
- citecolor = {Blue},
- urlcolor = {Red},
- pdfstartview = {Fit},
- pdfpagemode = {UseOutlines},
- pdfview = {XYZ null null null}
-}
-
-\AtBeginDocument{
- \hypersetup{%
- pdfauthor = {\@Plainauthor},
- pdftitle = {\@Plaintitle},
- pdfkeywords = {\@Plainkeywords}
- }
-}
-\if at notitle
- %% \AtBeginDocument{\maketitle}
-\else
- \AtBeginDocument{\maketitle}
-\fi
-
-%% commands
-\makeatletter
-\newcommand\code{\bgroup\@makeother\_\@makeother\~\@makeother\$\@codex}
-\def\@codex#1{{\normalfont\ttfamily\hyphenchar\font=-1 #1}\egroup}
-\makeatother
-%%\let\code=\texttt
-\let\proglang=\textsf
-\newcommand{\pkg}[1]{{\normalfont\fontseries{b}\selectfont #1}}
-\newcommand{\email}[1]{\href{mailto:#1}{\normalfont\texttt{#1}}}
-\newcommand{\doi}[1]{\href{http://dx.doi.org/#1}{\normalfont\texttt{doi:#1}}}
-\newcommand{\E}{\mathsf{E}}
-\newcommand{\VAR}{\mathsf{VAR}}
-\newcommand{\COV}{\mathsf{COV}}
-\newcommand{\Prob}{\mathsf{P}}
diff --git a/vignettes/permutations.Rnw b/vignettes/permutations.Rnw
index 8a762df..1121697 100644
--- a/vignettes/permutations.Rnw
+++ b/vignettes/permutations.Rnw
@@ -1,12 +1,7 @@
-\documentclass[article,shortnames]{Z}
-\usepackage{thumbpdf}
+\documentclass[article,shortnames,nojss]{jss}
%\VignetteIndexEntry{Restricted permutations; using the permute package}
%\VignettePackage{permute}
-%\VignetteDepends{vegan}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% declarations for jss.cls %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% almost as usual
\author{Gavin L. Simpson\\University of Regina}
@@ -19,6 +14,7 @@
%% an abstract and keywords
\Abstract{
+ TODO
}
\Keywords{permutations, restricted permutations, time series, transects, spatial grids, split-plot designs, Monte Carlo resampling, \proglang{R}}
\Plainkeywords{permutations, restricted permutations, time series, transects, spatial grids, split-plot designs, Monte Carlo resampling, R} %% without formatting
@@ -65,7 +61,7 @@ In many data sets, simply shuffling the data at random is inappropriate; under t
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)
+library("permute")
data(jackal)
jackal
@
@@ -277,7 +273,7 @@ args(Within)
\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 [...]
+ 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 = TRUE} stipulates that each plot should have the same [...]
\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}]
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/permute.git
More information about the debian-med-commit
mailing list