[Vegan-commits] r2706 - in pkg/permute: . R inst

[noreply at r-forge.r-project.org]

Author: gsimpson
Date: 2013-11-12 22:06:34 +0100 (Tue, 12 Nov 2013)
New Revision: 2706

Added:
   pkg/permute/R/as.matrix.permutationMatrix.R
   pkg/permute/R/print.permutationMatrix.R
Modified:
   pkg/permute/NAMESPACE
   pkg/permute/R/shuffleSet2.R
   pkg/permute/inst/ChangeLog
   pkg/permute/inst/TODO.md
Log:
shuffleSet returns an object of class 'permutationMatrix' which has S3 methods for 'as.matrix()' and 'print()', which are registered but not exported

Modified: pkg/permute/NAMESPACE
===================================================================
--- pkg/permute/NAMESPACE	2013-11-12 20:54:42 UTC (rev 2705)
+++ pkg/permute/NAMESPACE	2013-11-12 21:06:34 UTC (rev 2706)
@@ -16,11 +16,13 @@
 }
 
 ### S3 Methods
+S3method(`as.matrix`, `permutationMatrix`)
 ## print methods
 S3method(`print`, `allPerms`)
 S3method(`print`, `check`)
 S3method(`print`, `how`)
 S3method(`print`, `permControl`)
+S3method(`print`, `permutationMatrix`)
 S3method(`print`, `summary.allPerms`)
 S3method(`print`, `summary.check`)
 ## summary methods

Added: pkg/permute/R/as.matrix.permutationMatrix.R
===================================================================
--- pkg/permute/R/as.matrix.permutationMatrix.R	                        (rev 0)
+++ pkg/permute/R/as.matrix.permutationMatrix.R	2013-11-12 21:06:34 UTC (rev 2706)
@@ -0,0 +1,10 @@
+## as.matrix.permutationMatrix - an S3 method to convert to the S3
+## matrix class. Essentially this just strips attributes and updates
+## the class to only "matrix"
+
+`as.matrix.permutationMatrix` <- function(x, ...) {
+    attr(x, "seed") <- NULL
+    attr(x, "control") <- NULL
+    class(x) <- "matrix"
+    x
+}

Added: pkg/permute/R/print.permutationMatrix.R
===================================================================
--- pkg/permute/R/print.permutationMatrix.R	                        (rev 0)
+++ pkg/permute/R/print.permutationMatrix.R	2013-11-12 21:06:34 UTC (rev 2706)
@@ -0,0 +1,7 @@
+## Simple print method for objects of class "permutationMatrix"
+##  - at the moment, don't print the attributes
+
+`print.permutationMatrix` <- function(x, ...) {
+    x <- as.matrix(x)
+    print(x)
+}

Modified: pkg/permute/R/shuffleSet2.R
===================================================================
--- pkg/permute/R/shuffleSet2.R	2013-11-12 20:54:42 UTC (rev 2705)
+++ pkg/permute/R/shuffleSet2.R	2013-11-12 21:06:34 UTC (rev 2706)
@@ -1,5 +1,12 @@
 ## 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)
@@ -62,6 +69,16 @@
         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
 }
 

Modified: pkg/permute/inst/ChangeLog
===================================================================
--- pkg/permute/inst/ChangeLog	2013-11-12 20:54:42 UTC (rev 2705)
+++ pkg/permute/inst/ChangeLog	2013-11-12 21:06:34 UTC (rev 2706)
@@ -17,6 +17,9 @@
 	`shuffleSet()`. The `check` argument is retained though, as a way for
 	function writers to skip that part of the permute workflow if desired.
 
+	The permutation matrix returned is now of class `"permutationMatrix"`.
+	This class has `as.matrix()` and `print()` S3 methods.
+
 	* allPerms: gains an argument `check`, which defaults to `TRUE`. This
 	is used to turn off checking within `allPerms` if desired. A use-case
 	for this is in `check()`, which might end up caling `allPerms()` to

Modified: pkg/permute/inst/TODO.md
===================================================================
--- pkg/permute/inst/TODO.md	2013-11-12 20:54:42 UTC (rev 2705)
+++ pkg/permute/inst/TODO.md	2013-11-12 21:06:34 UTC (rev 2706)
@@ -74,3 +74,7 @@
         CTRL <- how(plots = plotStrata,
                     within = Within(type = "free", constant = TRUE))
         shuffleSet(20, 10, CTRL)
+
+ * Write an Rd page for the `"permutationMatrix"` S3 class where I can 
+   describe the object returned by `shuffleSet()` and the methods 
+   available for it.