[med-svn] [permute] 01/01: New upstream version 0.9-4
Andreas Tille
tille at debian.org
Sun Nov 13 08:14:53 UTC 2016
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to annotated tag upstream/0.9-4
in repository permute.
commit 55b017eef611a55cfdedee9ef916406b034d0120
Author: Andreas Tille <tille at debian.org>
Date: Sun Nov 13 09:03:38 2016 +0100
New upstream version 0.9-4
---
DESCRIPTION | 8 +--
MD5 | 55 ++++++++-------
NAMESPACE | 6 ++
R/allPerms.R | 4 +-
R/as.allPerms.R | 12 ++++
R/getFoo-methods.R | 21 ++++++
R/nobs-methods.R | 4 ++
R/setFoo-methods.R | 5 +-
R/shuffle.R | 11 ++-
R/shuffleSet.R | 6 +-
README.md | 8 +--
build/vignette.rds | Bin 226 -> 225 bytes
inst/ChangeLog | 15 ++++
inst/NEWS | 22 ++++++
inst/doc/permutations.pdf | Bin 312060 -> 312062 bytes
man/allPerms.Rd | 7 +-
man/check.Rd | 2 +-
man/get-methods.Rd | 10 +++
man/nobs.Rd | 9 ++-
man/shuffle.Rd | 4 +-
man/shuffleSet.Rd | 4 +-
tests/Examples/permute-Ex.Rout.save | 14 ++--
tests/testthat/test-allPerms.R | 9 +++
tests/testthat/test-as-methods.R | 7 ++
tests/testthat/test-get-methods.R | 20 ++++++
tests/testthat/test-how.R | 6 ++
tests/testthat/test-nobs.R | 7 ++
tests/testthat/test-shuffle.R | 57 ++++++++++++++-
tests/testthat/test-shuffleSet.R | 136 ++++++++++++++++++++++++++++++++++++
29 files changed, 410 insertions(+), 59 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 0b5d773..fad2a62 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
Package: permute
Title: Functions for Generating Restricted Permutations of Data
-Version: 0.9-0
-Date: 2016-01-24
+Version: 0.9-4
+Date: 2016-08-08
Authors at R: c(person(given = "Gavin L.", family = "Simpson",
email = "ucfagls at gmail.com",
role = c("aut", "cph", "cre")),
@@ -18,11 +18,11 @@ 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
+Packaged: 2016-09-08 23:08:56.064 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
-Date/Publication: 2016-01-24 21:39:11
+Date/Publication: 2016-09-09 10:13:49
diff --git a/MD5 b/MD5
index d6cd925..ccbebb1 100644
--- a/MD5
+++ b/MD5
@@ -1,21 +1,22 @@
-436912ba0ea62e22c5099ab3155e2f67 *DESCRIPTION
-0c18ae4d20cc83a0eea1ccc5227a1aab *NAMESPACE
+1e90feaac44dc113062176960aa71c32 *DESCRIPTION
+449517ec91fe50b7198f2d4a2dc3b1c0 *NAMESPACE
0d94016b600ddfd39087b8d41228ddb7 *R/Plots.R
40da812fd0c1530aa117d1677f707023 *R/Within.R
065086f18b59986e5feb8a6598b78632 *R/allFree.R
af6ec0ff884e97781072c6db2cdeb61b *R/allGrid.R
-eef691f8022c0ca850034f53a6263da8 *R/allPerms.R
+b392efd8273dec8b4da3c218f7e3c813 *R/allPerms.R
ed8d66f8de2f14fdee5ee0b4d7ca450e *R/allSeries.R
648a6fde01b25b284184dc1827c4264f *R/allStrata.R
+8ebbaea5c8da437515b487e1bdbdd8a7 *R/as.allPerms.R
a76f0fdcb2d2f8c776f3846b3c41d26a *R/as.matrix.allPerms.R
23435563d36be42bbd71da36581a78af *R/as.matrix.permutationMatrix.R
0677bca1862f33eb1cc957d9d435a667 *R/blocks.R
8776e79c375b73cb5da9a72d507a6310 *R/cbindAllPerms.R
caaacb60634fb8d89e4e4e38cab9d14f *R/check.R
b425906bbec143e8e99ecce43dddc2af *R/fixupCall.R
-4aca181e15fc6804acd013afaa46deb9 *R/getFoo-methods.R
+dd6f1dc0f61fbb58c9e7ddd97b3a1802 *R/getFoo-methods.R
253585e8aab94e4cec4dac4265591b35 *R/how.R
-756bdc23a5b3e996c3a6b6d9282ccfc4 *R/nobs-methods.R
+408590a068e1f5def74a5d933f402a7f *R/nobs-methods.R
4ecbcd7cf18cfcbfa6d232506ac8522b *R/numPerms.R
b7ffedd8632192ce56b95b15d7c87107 *R/permute.R
21a2adbee470ca86648b7ac0e9fd5d51 *R/print.allPerms.R
@@ -24,50 +25,50 @@ d91d44308c82453d9d2466a70cc7157e *R/print.how.R
ac687a3095ebd55719f7bb5eaf12b51d *R/print.permutationMatrix.R
ad976cbddacaaaebd1e3b5a6f4eba771 *R/print.summary.allPerms.R
eb6d20a84325371ed25f56333a1286f0 *R/print.summary.check.R
-d8dd28f2c0cf92aecb46015553b2a89b *R/setFoo-methods.R
+b0287758362f6910d9afe7245ee5aa6d *R/setFoo-methods.R
52a6d4a315ddca402855225d6c1fef20 *R/shuffle-utils.R
-9f1b7512c6b1941d0b0310203f967e31 *R/shuffle.R
-3739c591e3479196ba5cf86b50a1beba *R/shuffleSet.R
+88046f4904c02b8b54b5c25e8ddcd399 *R/shuffle.R
+20b08942cbf31944f563b15b687a3b37 *R/shuffleSet.R
6c98b1afeb08eef934cc6d25557c8812 *R/summary.allPerms.R
1452820ef3677a4cc68fc27837f67ee3 *R/summary.check.R
33064923b08d1e65469449f32b0f2797 *R/update.Plots.R
3a2a885a7705cee2fd97ecc1a7238b12 *R/update.how.R
-c45f6eabfee9ed95283900f903d42d85 *README.md
-eeffbe21b9603fe1ca94f27efd1eb311 *build/vignette.rds
+b110c8b73a0abf83a2f0194179baf2b6 *README.md
+9b04c6ecc9995a9528ac25f365bae485 *build/vignette.rds
4d966dbdda958c863064462aeb589708 *data/jackal.rda
aa947360198890f9a747920d52cf52c2 *inst/COPYRIGHTS
-715f4709431446f0340a99571e8bfab2 *inst/ChangeLog
-c70448b2af94bb4c2ab538cbd7e2c88d *inst/NEWS
+350cf6f38f920edd803241ff236e1b3a *inst/ChangeLog
+ea0d3fc1f22e76966312234f7d7803d1 *inst/NEWS
bbb242b30032dba5f5a775dc43e91bf7 *inst/TODO.md
9ac113bce6d1568275ed91f8034f202d *inst/doc/permutations.R
fa5e887f5bef256943271e0040cd00fa *inst/doc/permutations.Rnw
-ff7b460b62eaa710be245506060ad800 *inst/doc/permutations.pdf
-d4596abecaf914b74f908a07d22c11f7 *man/allPerms.Rd
+99d8f9f541588db608379e56e1a2f9af *inst/doc/permutations.pdf
+330097c7d0f6ee57d25826bc4c1c64da *man/allPerms.Rd
ae17a2363ef92ad5cfb7c9704b4fc130 *man/allUtils.Rd
-83cd451efb597d331da312f99138653f *man/check.Rd
-1abaaa3ab73cf3f4e3e88eb596a7c57c *man/get-methods.Rd
+b73af948eaa9329248c324d6b56a171c *man/check.Rd
+dba0d68af8e965d9fbee421781f3852e *man/get-methods.Rd
6495971db0de15e8704f4d61cfdb95b0 *man/how.Rd
66c4ad89b8c8035bbc74ed3558e961bb *man/jackal.Rd
-e54c2a3be916e7fa0813b0a5f93f6dc3 *man/nobs.Rd
+e084ef48f99f6e73caeccf87dd4d017f *man/nobs.Rd
3101a045f667b06e45ce829b099d0ec8 *man/numPerms.Rd
e69cb80138b5b21371a7a3719b610949 *man/set-methods.Rd
74e0599d75011a519bd917481f0df308 *man/shuffle-utils.Rd
-eb210047aa7f8feb8bda0d1afc191111 *man/shuffle.Rd
-e30d5d2985c1c813da631b207c88a477 *man/shuffleSet.Rd
-f1fca1527376db805c3ff0d657914e82 *tests/Examples/permute-Ex.Rout.save
+a179be1f1ca210a73e06f8f8e0b699a8 *man/shuffle.Rd
+f340889447744330c7768964c3c24930 *man/shuffleSet.Rd
+96f2d53f79ba8c0b546c61d4fffc815e *tests/Examples/permute-Ex.Rout.save
08783b766dfc54380636442d03904b6d *tests/testthat.R
-5540a364d030860557c56e8cd2bfca00 *tests/testthat/test-allPerms.R
-404c87ce88ee7ca03e004d4ae63f6b61 *tests/testthat/test-as-methods.R
+f3f5795319b26a2f6b2b7be358ea4627 *tests/testthat/test-allPerms.R
+fe12f8d312fb93cd94e3bf6bc18c4f67 *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
+8f50aefc98c44ddb9f8b8c3119703673 *tests/testthat/test-get-methods.R
+01077e2efc42c5837cfd2ba79a1508ef *tests/testthat/test-how.R
+39634017340df520ca0f6a43f5af12f1 *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
+8c342323518a6a16b9a4551cfaf5382b *tests/testthat/test-shuffle.R
+32caa1eedab0e3eb4c79b61827073179 *tests/testthat/test-shuffleSet.R
fa5e887f5bef256943271e0040cd00fa *vignettes/permutations.Rnw
04ffc25b51d75204407f0852dd597bf8 *vignettes/permute.bib
diff --git a/NAMESPACE b/NAMESPACE
index e8f0046..fd2cac7 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,5 +1,6 @@
### Visible functions:
export("allPerms",
+ "as.allPerms",
"Blocks",
"check",
"getBlocks",
@@ -19,6 +20,8 @@ export("allPerms",
"getMake",
"getObserved",
"getAllperms",
+ "getControl",
+ "getHow",
"how",
"numPerms",
"permute",
@@ -82,6 +85,7 @@ S3method("nobs", "integer")
S3method("nobs", "matrix")
S3method("nobs", "data.frame")
S3method("nobs", "factor")
+S3method("nobs", "character")
## getFoo methods
S3method("getBlocks", "default")
S3method("getBlocks", "how")
@@ -129,6 +133,8 @@ S3method("getObserved", "default")
S3method("getObserved", "how")
S3method("getAllperms", "default")
S3method("getAllperms", "how")
+S3method("getControl", "default")
+S3method("getControl", "allPerms")
## setFoo methods
S3method("setBlocks<-", "default")
diff --git a/R/allPerms.R b/R/allPerms.R
index 80eb0a5..c7ebd37 100644
--- a/R/allPerms.R
+++ b/R/allPerms.R
@@ -75,7 +75,9 @@
## observed ordering
setNperm(control) <- getNperm(control) - 1
}
- class(out) <- c("allPerms", "matrix")
+
+ ## as a permutationMatrix we pick up nice print method
+ class(out) <- c("allPerms", "permutationMatrix", "matrix")
attr(out, "control") <- control
attr(out, "observed") <- observed
out
diff --git a/R/as.allPerms.R b/R/as.allPerms.R
new file mode 100644
index 0000000..a492b4b
--- /dev/null
+++ b/R/as.allPerms.R
@@ -0,0 +1,12 @@
+`as.allPerms` <- function(object, control) {
+ object <- as.matrix(object)
+ class(object) <- c("allPerms", "matrix")
+ if (!missing(control)) {
+ attr(object, "control") <- control
+ attr(object, "observed") <- getObserved(control)
+ } else {
+ ## This needs double checking that it is needed!
+ attr(object, "control") <- attr(object, "observed") <- NA
+ }
+ object
+}
diff --git a/R/getFoo-methods.R b/R/getFoo-methods.R
index b39daf8..995010a 100644
--- a/R/getFoo-methods.R
+++ b/R/getFoo-methods.R
@@ -330,3 +330,24 @@
`getAllperms.default` <- function(object, ...) {
stop("No default method for `getAllperms`")
}
+
+## Extractor for control/how objects
+`getControl` <- function(object, ...) {
+ UseMethod("getControl")
+}
+
+`getControl.default` <- function(object, ...) {
+ nams <- names(object)
+ if (!"control" %in% nams) {
+ stop("Failed to find a 'control' component in 'object'.")
+ }
+ object[["control"]]
+}
+
+`getControl.allPerms` <- function(object, ...) {
+ attr(object, "control")
+}
+
+`getHow` <- function(object, ...) {
+ UseMethod("getControl")
+}
diff --git a/R/nobs-methods.R b/R/nobs-methods.R
index f43ab05..f9720a1 100644
--- a/R/nobs-methods.R
+++ b/R/nobs-methods.R
@@ -22,3 +22,7 @@ if (getRversion() < "2.13.0")
`nobs.factor` <- function(object, ...) {
length(object)
}
+
+`nobs.character` <- function(object, ...) {
+ length(object)
+}
diff --git a/R/setFoo-methods.R b/R/setFoo-methods.R
index a73e6cc..ce14298 100644
--- a/R/setFoo-methods.R
+++ b/R/setFoo-methods.R
@@ -67,8 +67,9 @@
}
`setAllperms<-.how` <- function(object, value) {
- if (!is.null(value))
- value <- as.matrix(value)
+ if (!is.null(value)) {
+ value <- as.allPerms(value, control = object)
+ }
object[["all.perms"]] <- value
object <- fixupCall(object, "all.perms", value)
object
diff --git a/R/shuffle.R b/R/shuffle.R
index 4bdc024..f9af896 100644
--- a/R/shuffle.R
+++ b/R/shuffle.R
@@ -1,5 +1,14 @@
## new version of shuffle() that allows for blocking
`shuffle` <- function(n, control = how()) {
+ ## handle a vector, matrix, or data frame input; derive n from it
+ if (((is.numeric(n) || is.integer(n) || is.factor(n) || is.character(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
+
## get blocking, if any
Block <- getStrata(control, which = "blocks")
## If no blocking, put all samples in same block
@@ -12,8 +21,6 @@
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
diff --git a/R/shuffleSet.R b/R/shuffleSet.R
index cc6f4f5..f2d180c 100644
--- a/R/shuffleSet.R
+++ b/R/shuffleSet.R
@@ -20,7 +20,7 @@
}
## handle a vector, matrix, or data frame input; derive n from it
- if (((is.numeric(n) || is.integer(n) || is.factor(n)) &&
+ if (((is.numeric(n) || is.integer(n) || is.factor(n) || is.character(n)) &&
length(n) > 1L) ||
is.matrix(n) ||
is.data.frame(n)) {
@@ -37,7 +37,7 @@
## need to check number of permutations won't blow up
pcheck <- check(sn, control = control, quietly = quietly)
## control possibly now updated
- control <- pcheck$control
+ control <- getControl(pcheck)
}
if(is.null(AP <- getAllperms(control))) {
@@ -74,7 +74,7 @@
## 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), ]
+ out <- out[sample.int(nr, nset), , drop = FALSE]
}
## Attach random seed stored earlier to permutation matrix
diff --git a/README.md b/README.md
index 1c6765e..677d0c7 100644
--- a/README.md
+++ b/README.md
@@ -1,7 +1,7 @@
## Restricted permutations with R
#### Released version
-[](http://cran.rstudio.com/web/packages/permute/index.html) [](http://cran.rstudio.com/web/packages/permute/index.html)
+[](https://cran.r-project.org/package=permute) [](https://cran.r-project.org/package=permute)
#### 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)
@@ -26,8 +26,6 @@ Several types of permutation are available in **permute**:
### References
-Besag, J. and Clifford, P. (1989) Generalized Monte Carlo significance
-tests. *Biometrika* **76**; 633–642.
+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).
+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 427c73a..d486448 100644
Binary files a/build/vignette.rds and b/build/vignette.rds differ
diff --git a/inst/ChangeLog b/inst/ChangeLog
index 44ca861..3302571 100644
--- a/inst/ChangeLog
+++ b/inst/ChangeLog
@@ -1,5 +1,20 @@
permute ChangeLog
+Version 0.9-1
+
+ * setAllperms<-.how() was stripping the "allPerms" class. (#16)
+
+ Reported by: @brendanf
+
+ * nobs: added a `nobs.character` method (#17)
+
+ * get-methods: added a `getControl()` extractor with a default
+ method and a method for class `"check"`. There is an alias in
+ the form of `getHow()` (#18)
+
+ * shuffle: now accepts objects from which we derive the number
+ of observations, bringing is into line with `shuffleSet()`
+
Version 0.9-0
* Release to CRAN 23 Jan 2016
diff --git a/inst/NEWS b/inst/NEWS
index ea97a1d..af06ee5 100644
--- a/inst/NEWS
+++ b/inst/NEWS
@@ -1,5 +1,27 @@
# permute News
+## Changes in version 0.9-4
+
+The example in `?check` was made to suppress package startup messages from vegan.
+
+## Changes in version 0.9-3
+
+This release fixed some non-canonical-form CRAN URLs.
+
+## Changes in version 0.9-2
+
+This release was purely to avoid issues with CRAN as a new release of vegan had been released and the example reference material hadn't been updated to match.
+
+## Changes in version 0.9-1
+
+### General
+
+A minor bug fix release to address a single problem.
+
+### Bug Fixes
+
+ * `shuffleSet()` wasn't returning a matrix if `nset = 1` *and* `allPerms` was invoked because of a low set of possible permutations. [GitHub Issue #19](https://github.com/gavinsimpson/permute/issues/19)
+
## Changes in version 0.9-0
### General
diff --git a/inst/doc/permutations.pdf b/inst/doc/permutations.pdf
index ddda393..dcc7fd1 100644
Binary files a/inst/doc/permutations.pdf and b/inst/doc/permutations.pdf differ
diff --git a/man/allPerms.Rd b/man/allPerms.Rd
index 66494e7..04df257 100644
--- a/man/allPerms.Rd
+++ b/man/allPerms.Rd
@@ -4,6 +4,7 @@
\alias{summary.allPerms}
\alias{print.summary.allPerms}
\alias{as.matrix.allPerms}
+\alias{as.allPerms}
\title{Complete enumeration of all possible permutations}
\description{
@@ -16,6 +17,8 @@ allPerms(n, control = how(), check = TRUE)
\method{summary}{allPerms}(object, \dots)
\method{as.matrix}{allPerms}(x, \dots)
+
+as.allPerms(object, control)
}
\arguments{
\item{n}{the number of observations or an 'object' from which the
@@ -26,7 +29,9 @@ allPerms(n, control = how(), check = TRUE)
\item{check}{logical; should \code{allPerms} check the design? The
default is to check, but this can be skipped, for example if a
function checked the design earlier.}
- \item{object}{an object of class \code{"allPerms"}.}
+ \item{object}{for \code{summary.allPerms}, an object of class
+ \code{"allPerms"}. For \code{as.allPerms} a matrix or something that
+ can be coerced to a matrix by \code{\link{as.matrix}}.}
\item{\dots}{arguments to other methods.}
\item{x}{
an object of class \code{"allPerms"}, as returned by \code{allPerms}.
diff --git a/man/check.Rd b/man/check.Rd
index 7272a08..36fbbdf 100644
--- a/man/check.Rd
+++ b/man/check.Rd
@@ -59,7 +59,7 @@ check(object, control = how(), quietly = FALSE)
\examples{
## only run this example if vegan is available
-if (require("vegan")) {
+if (suppressPackageStartupMessages(require("vegan"))) {
## use example data from ?pyrifos in package vegan
example(pyrifos)
diff --git a/man/get-methods.Rd b/man/get-methods.Rd
index b43f8d6..e621c56 100644
--- a/man/get-methods.Rd
+++ b/man/get-methods.Rd
@@ -77,6 +77,10 @@
\alias{getAllperms}
\alias{getAllperms.default}
\alias{getAllperms.how}
+\alias{getControl}
+\alias{getHow}
+\alias{getControl.default}
+\alias{getControl.allPerms}
\title{Extractor functions to access components of a permutation design}
\description{
@@ -106,6 +110,8 @@ getRow(object, ...)
getStrata(object, ...)
getType(object, ...)
getWithin(object, ...)
+getControl(object, ...)
+getHow(object, ...)
\method{getAllperms}{how}(object, ...)
@@ -154,6 +160,7 @@ getWithin(object, ...)
\method{getWithin}{how}(object, ...)
+\method{getControl}{allPerms}(object, ...)
}
\arguments{
@@ -168,6 +175,9 @@ getWithin(object, ...)
objects created by \code{\link{how}}. They should be used in
preference to directly subsetting the permutation design in case the
internal structure of object changes as \pkg{permute} is developed.
+
+ \code{getHow} is an alias for \code{getControl}; specific methods are
+ implemented for \code{getControl} if you are debugging.
}
\value{
These are simple extractor functions and return the contents of the
diff --git a/man/nobs.Rd b/man/nobs.Rd
index 2874047..141ac90 100644
--- a/man/nobs.Rd
+++ b/man/nobs.Rd
@@ -4,6 +4,8 @@
\alias{nobs.integer}
\alias{nobs.matrix}
\alias{nobs.data.frame}
+\alias{nobs.factor}
+\alias{nobs.character}
\title{Number of observations in a given object}
\description{
@@ -20,9 +22,14 @@
\method{nobs}{matrix}(object, \dots)
\method{nobs}{data.frame}(object, \dots)
+
+\method{nobs}{character}(object, \dots)
+
+\method{nobs}{factor}(object, \dots)
}
\arguments{
- \item{object}{a data frame or matrix, or a numeric or integer vector.}
+ \item{object}{a data frame or matrix, or a numeric, integer,
+ character, or factor vector.}
\item{\dots}{arguments to other methods.}
}
\details{
diff --git a/man/shuffle.Rd b/man/shuffle.Rd
index 49bc2f8..c5e0015 100644
--- a/man/shuffle.Rd
+++ b/man/shuffle.Rd
@@ -15,7 +15,9 @@ permute(i, n, control)
\arguments{
\item{n}{numeric; the length of the returned vector of permuted
- values. Usually the number of observations under consideration.}
+ values. Usually the number of observations under consideration. May
+ also be any object that \code{nobs} knows about; see
+ \code{\link{nobs-methods}}.}
\item{control}{a list of control values describing properties of the
permutation design, as returned by a call to \code{how}.}
\item{i}{integer; row of \code{control$all.perms} to return.}
diff --git a/man/shuffleSet.Rd b/man/shuffleSet.Rd
index fafc0ae..42427fb 100644
--- a/man/shuffleSet.Rd
+++ b/man/shuffleSet.Rd
@@ -19,7 +19,9 @@ shuffleSet(n, nset, control = how(), check = TRUE, quietly = FALSE)
%- maybe also 'usage' for other objects documented here.
\arguments{
\item{n}{
- numeric; the number of observations in the sample set.
+ numeric; the number of observations in the sample set. May also be
+ any object that \code{nobs} knows about; see
+ \code{\link{nobs-methods}}.
}
\item{nset}{
numeric; the number of permutations to generate for the set. Can be
diff --git a/tests/Examples/permute-Ex.Rout.save b/tests/Examples/permute-Ex.Rout.save
index 6193450..5c4643a 100644
--- a/tests/Examples/permute-Ex.Rout.save
+++ b/tests/Examples/permute-Ex.Rout.save
@@ -1,5 +1,5 @@
-R version 3.2.3 Patched (2016-01-03 r69846) -- "Wooden Christmas-Tree"
+R version 3.3.0 Patched (2016-05-12 r70603) -- "Supposedly Educational"
Copyright (C) 2016 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (64-bit)
@@ -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 as.matrix.allPerms
+> ### print.summary.allPerms as.matrix.allPerms as.allPerms
>
> ### ** Examples
>
@@ -204,7 +204,7 @@ Contains observed ordering?: No
> ### ** Examples
>
> ## only run this example if vegan is available
-> if (require("vegan")) {
+> if (suppressPackageStartupMessages(require("vegan"))) {
+ ## use example data from ?pyrifos in package vegan
+ example(pyrifos)
+
@@ -254,9 +254,6 @@ Contains observed ordering?: No
+ 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.3-3
pyrifs> data(pyrifos)
@@ -503,6 +500,7 @@ detaching ‘package:vegan’, ‘package:lattice’
> ### getComplete.default getComplete.how getComplete.permControl getMake
> ### getMake.default getMake.how getObserved getObserved.default
> ### getObserved.how getAllperms getAllperms.default getAllperms.how
+> ### getControl getHow getControl.default getControl.allPerms
> ### Keywords: methods utils
>
> ### ** Examples
@@ -641,7 +639,7 @@ Permutation details:
> ### Name: nobs-methods
> ### Title: Number of observations in a given object
> ### Aliases: nobs-methods nobs.numeric nobs.integer nobs.matrix
-> ### nobs.data.frame
+> ### nobs.data.frame nobs.factor nobs.character
>
> ### ** Examples
>
@@ -1159,7 +1157,7 @@ p4 5 1 2 3 4 10 6 7 8 9 15 11 12 13 14 20 16 17 18 19
> ###
> options(digits = 7L)
> base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed: 3.867 0.043 3.906 0 0
+Time elapsed: 4.459 0.081 4.542 0 0
> grDevices::dev.off()
null device
1
diff --git a/tests/testthat/test-allPerms.R b/tests/testthat/test-allPerms.R
index ceb52ee..ddbf012 100644
--- a/tests/testthat/test-allPerms.R
+++ b/tests/testthat/test-allPerms.R
@@ -287,3 +287,12 @@ test_that("allPerms works with complex, but small, design", {
expect_is(ap, "matrix")
expect_equal(nrow(ap), 10 - 1L)
})
+
+test_that("summary.allPerms works & prints correctly", {
+ a <- c("Ar","Ba","Bl","Bu","Ca")
+ ap <- allPerms(a)
+ ## FIXME: this doesn't work yet in released testthat
+ ## expect_output(print(ap))
+ expect_output(print(summary(ap)),
+ regexp = "Complete enumeration of permutations")
+})
diff --git a/tests/testthat/test-as-methods.R b/tests/testthat/test-as-methods.R
index cbf3f30..dd268b7 100644
--- a/tests/testthat/test-as-methods.R
+++ b/tests/testthat/test-as-methods.R
@@ -16,3 +16,10 @@ test_that("as.matrix permutationMatrix method", {
expect_is(m, "matrix")
expect_false(inherits(m, "permutationMatrix"))
})
+
+test_that("as.allPerms fixes #16", {
+ res1 <- check(4, control = how())
+ ctrl <- getControl(res1)
+ res <- check(4, ctrl)
+ expect_is(res, "check")
+})
diff --git a/tests/testthat/test-get-methods.R b/tests/testthat/test-get-methods.R
index 37ffca5..c721432 100644
--- a/tests/testthat/test-get-methods.R
+++ b/tests/testthat/test-get-methods.R
@@ -19,4 +19,24 @@ test_that("default methods for get functions", {
expect_error(getObserved(v), regexp = "No default method")
expect_error(getAllperms(v), regexp = "No default method")
expect_error(getComplete(v), regexp = "No default method")
+ expect_error(getControl(v), regexp = "Failed to find a 'control' component in 'object'")
+ expect_error(getHow(v), regexp = "Failed to find a 'control' component in 'object'")
+})
+
+test_that("getControl works for allperms", {
+ ctrl <- how()
+ ap <- allPerms(1:6, control = ctrl)
+ CTRL <- getControl(ap)
+ expect_is(CTRL, "how")
+ CTRL <- getHow(ap)
+ expect_is(CTRL, "how")
+})
+
+test_that("getHow works for check()", {
+ ctrl <- how()
+ res <- check(1:4, ctrl)
+ CTRL <- getControl(res)
+ expect_is(CTRL, "how")
+ CTRL <- getHow(res)
+ expect_is(CTRL, "how")
})
diff --git a/tests/testthat/test-how.R b/tests/testthat/test-how.R
index d864299..32eb40b 100644
--- a/tests/testthat/test-how.R
+++ b/tests/testthat/test-how.R
@@ -11,4 +11,10 @@ test_that("how() works with explicit NULL blocks arg", {
test_that("print method for how", {
expect_output(print(how()), regexp = "Permutation Design:")
+
+ ctrl <- how(plots = Plots(strata = gl(4,5)))
+ expect_output(print(how()), regexp = "Plots:")
+
+ ctrl <- how(plots = Plots(strata = gl(4,9), type = "grid", ncol = 3, nrow = 3))
+ expect_output(print(ctrl), regexp = "Grid dimensions:")
})
diff --git a/tests/testthat/test-nobs.R b/tests/testthat/test-nobs.R
index 8c2d635..a4900a6 100644
--- a/tests/testthat/test-nobs.R
+++ b/tests/testthat/test-nobs.R
@@ -32,3 +32,10 @@ test_that("factor nobs method", {
n <- nobs(f)
expect_identical(n, 10L)
})
+
+test_that("character nobs method works", {
+ ch <- c("Ar","Ba","Bl","Bu","Ca")
+ n <- nobs(ch)
+ expect_identical(n, 5L)
+ expect_identical(n, length(ch))
+})
diff --git a/tests/testthat/test-shuffle.R b/tests/testthat/test-shuffle.R
index 3c5fd7c..78c0a5a 100644
--- a/tests/testthat/test-shuffle.R
+++ b/tests/testthat/test-shuffle.R
@@ -48,6 +48,59 @@ test_that("shuffle can permute both plots and within in presence of blocks", {
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"))
+ expect_identical(length(permSet), 28L)
+ expect_is(permSet, "integer")
+})
+
+test_that("constant within plots works", {
+ fac <- gl(4, 5)
+ ## series permutations
+ ctrl <- how(within = Within(type = "series", constant = TRUE),
+ plots = Plots(strata = fac, type = "none"))
+ perm <- shuffle(length(fac), control = ctrl)
+ expect_identical(length(perm), length(fac))
+ expect_identical(length(perm), 20L)
+ expect_is(perm, "integer")
+ ## free/randomisation
+ ctrl <- how(within = Within(type = "free", constant = TRUE),
+ plots = Plots(strata = fac, type = "none"))
+ perm <- shuffle(length(fac), control = ctrl)
+ expect_identical(length(perm), length(fac))
+ expect_identical(length(perm), 20L)
+ expect_is(perm, "integer")
+ ## spatial grid 3x3
+ fac <- gl(4, 9)
+ ctrl <- how(within = Within(type = "grid", nrow = 3, ncol = 3, constant = TRUE),
+ plots = Plots(strata = fac, type = "none"))
+ perm <- shuffle(length(fac), control = ctrl)
+ expect_identical(length(perm), length(fac))
+ expect_identical(length(perm), 36L)
+ expect_is(perm, "integer")
+})
+
+test_that("shuffel works with objects passed to n", {
+ obj <- 1:4
+ p <- shuffle(obj)
+ expect_is(p, "integer")
+ expect_identical(length(p), 4L)
+ obj <- as.integer(1:4)
+ p <- shuffle(obj)
+ expect_is(p, "integer")
+ expect_identical(length(p), 4L)
+ obj <- as.factor(1:4)
+ p <- shuffle(obj)
+ expect_is(p, "integer")
+ expect_identical(length(p), 4L)
+ obj <- letters[1:4]
+ p <- shuffle(obj)
+ expect_is(p, "integer")
+ expect_identical(length(p), 4L)
+ obj <- matrix(1:16, ncol = 4, nrow = 4)
+ p <- shuffle(obj)
+ expect_is(p, "integer")
+ expect_identical(length(p), 4L)
+ obj <- data.frame(A = 1:4, B = letters[1:4])
+ p <- shuffle(obj)
+ expect_is(p, "integer")
+ expect_identical(length(p), 4L)
})
diff --git a/tests/testthat/test-shuffleSet.R b/tests/testthat/test-shuffleSet.R
index d9ffb82..0233076 100644
--- a/tests/testthat/test-shuffleSet.R
+++ b/tests/testthat/test-shuffleSet.R
@@ -83,3 +83,139 @@ test_that("print method for permutationMatrix works", {
perms <- shuffleSet(10, nset = 20, control = h)
expect_output(print(perms), regexp = "; same permutation")
})
+
+test_that("constant within plots works", {
+ ## These need check = FALSE to stop allPerms doing the generation
+ ## which doesn't actually call doShuffleSet. Check using both FALSE
+ ## and the default, default first
+ fac <- gl(4, 5)
+ nset <- 10L
+ ## series permutations
+ ctrl <- how(within = Within(type = "series", constant = TRUE),
+ plots = Plots(strata = fac, type = "none"))
+ perm <- shuffleSet(length(fac), nset, control = ctrl)
+ expect_identical(ncol(perm), length(fac))
+ expect_identical(ncol(perm), 20L)
+ expect_identical(nrow(perm), 4L) ## only 4 permutations!
+ expect_is(perm, "matrix")
+ expect_is(perm, "permutationMatrix")
+ expect_output(print(perm), regexp = "; same permutation")
+ expect_output(print(perm), regexp = "Nested in: plots; Sequence;")
+
+ ## free/randomisation
+ ctrl <- how(within = Within(type = "free", constant = TRUE),
+ plots = Plots(strata = fac, type = "none"))
+ perm <- shuffleSet(length(fac), nset, control = ctrl)
+ expect_identical(ncol(perm), length(fac))
+ expect_identical(ncol(perm), 20L)
+ expect_identical(nrow(perm), nset)
+ expect_identical(nrow(perm), 10L)
+ expect_is(perm, "matrix")
+ expect_is(perm, "permutationMatrix")
+ expect_output(print(perm), regexp = "; same permutation")
+ expect_output(print(perm), regexp = "Nested in: plots; Randomised;")
+
+ ## spatial grid 3x3
+ fac <- gl(4, 9)
+ ctrl <- how(within = Within(type = "grid", nrow = 3, ncol = 3, constant = TRUE),
+ plots = Plots(strata = fac, type = "none"))
+ perm <- shuffleSet(length(fac), nset, control = ctrl)
+ expect_identical(ncol(perm), length(fac))
+ expect_identical(ncol(perm), 36L)
+ expect_identical(nrow(perm), 8L)
+ expect_is(perm, "matrix")
+ expect_is(perm, "permutationMatrix")
+ expect_output(print(perm), regexp = "; same\npermutation")
+ expect_output(print(perm), regexp = "; Spatial grid: 3r, 3c")
+
+ ## now with check = FALSE --- this is going to generate duplicate permutations
+ fac <- gl(4, 5)
+ nset <- 10L
+ ## series permutations
+ ctrl <- how(within = Within(type = "series", constant = TRUE),
+ plots = Plots(strata = fac, type = "none"))
+ perm <- shuffleSet(length(fac), nset, control = ctrl, check = FALSE)
+ expect_identical(ncol(perm), length(fac))
+ expect_identical(ncol(perm), 20L)
+ expect_identical(nrow(perm), nset)
+ expect_identical(nrow(perm), 10L)
+ expect_is(perm, "matrix")
+ expect_is(perm, "permutationMatrix")
+ expect_output(print(perm), regexp = "; same permutation")
+ expect_output(print(perm), regexp = "Nested in: plots; Sequence;")
+
+ ## free/randomisation
+ ctrl <- how(within = Within(type = "free", constant = TRUE),
+ plots = Plots(strata = fac, type = "none"))
+ perm <- shuffleSet(length(fac), nset, control = ctrl, check = FALSE)
+ expect_identical(ncol(perm), length(fac))
+ expect_identical(ncol(perm), 20L)
+ expect_identical(nrow(perm), nset)
+ expect_identical(nrow(perm), 10L)
+ expect_is(perm, "matrix")
+ expect_is(perm, "permutationMatrix")
+ expect_output(print(perm), regexp = "; same permutation")
+ expect_output(print(perm), regexp = "Nested in: plots; Randomised;")
+
+ ## spatial grid 3x3
+ fac <- gl(4, 9)
+ ctrl <- how(within = Within(type = "grid", nrow = 3, ncol = 3, constant = TRUE),
+ plots = Plots(strata = fac, type = "none"))
+ perm <- shuffleSet(length(fac), nset, control = ctrl, check = FALSE)
+ expect_identical(ncol(perm), length(fac))
+ expect_identical(ncol(perm), 36L)
+ expect_identical(nrow(perm), 10L)
+ expect_identical(nrow(perm), nset)
+ expect_is(perm, "matrix")
+ expect_is(perm, "permutationMatrix")
+ expect_output(print(perm), regexp = "; same\npermutation")
+ expect_output(print(perm), regexp = "; Spatial grid: 3r, 3c")
+})
+
+test_that("shuffelSet works with objects passed to n", {
+ obj <- 1:4
+ p <- shuffleSet(obj, 10L)
+ expect_is(p, "permutationMatrix")
+ expect_identical(nrow(p), 10L)
+ obj <- as.integer(1:4)
+ p <- shuffleSet(obj, 10L)
+ expect_is(p, "permutationMatrix")
+ expect_identical(nrow(p), 10L)
+ obj <- as.factor(1:4)
+ p <- shuffleSet(obj, 10L)
+ expect_is(p, "permutationMatrix")
+ expect_identical(nrow(p), 10L)
+ obj <- letters[1:4]
+ p <- shuffleSet(obj, 10L)
+ expect_is(p, "permutationMatrix")
+ expect_identical(nrow(p), 10L)
+ obj <- matrix(1:16, ncol = 4, nrow = 4)
+ p <- shuffleSet(obj, 10L)
+ expect_is(p, "permutationMatrix")
+ expect_identical(nrow(p), 10L)
+ obj <- data.frame(A = 1:4, B = letters[1:4])
+ p <- shuffleSet(obj, 10L)
+ expect_is(p, "permutationMatrix")
+ expect_identical(nrow(p), 10L)
+})
+
+test_that("Issue 19: shuffleSet with nset=1 never regresses", {
+ TreatmentLevels <- 3
+ Animals <- 4
+ TimeSteps <- 5
+ AnimalID <- rep(letters[seq_len(Animals)], each = TreatmentLevels * TimeSteps)
+ Time <- rep(seq_len(TimeSteps), Animals = TreatmentLevels)
+ ## Treatments were given in different order per animal
+ Day <- rep(c(1,2,3,2,3,1,3,2,1,2,3,1), each = TimeSteps)
+ Treatment <- rep(rep(LETTERS[seq_len(TreatmentLevels)], each = TimeSteps), Animals)
+ dataset <- as.data.frame(cbind(AnimalID, Treatment, Day, Time))
+
+ ctrl <- with(dataset,
+ how(blocks = AnimalID, plots = Plots(strata = Day, type = "free"),
+ within = Within(type = "none"), nperm = 999))
+
+ ## This should return a matrix
+ p <- shuffleSet(60, nset = 1, control = ctrl)
+ expect_is(p, "matrix")
+ expect_identical(nrow(p), 1L)
+})
--
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