[Vegan-commits] r2732 - in pkg/permute: R man

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

Author: gsimpson
Date: 2013-11-21 17:50:28 +0100 (Thu, 21 Nov 2013)
New Revision: 2732

Modified:
   pkg/permute/R/Plots.R
   pkg/permute/R/Within.R
   pkg/permute/R/how.R
   pkg/permute/man/how.Rd
Log:
work much harder to preserve blocks and plots names and to update the call

Modified: pkg/permute/R/Plots.R
===================================================================
--- pkg/permute/R/Plots.R	2013-11-21 16:47:13 UTC (rev 2731)
+++ pkg/permute/R/Plots.R	2013-11-21 16:50:28 UTC (rev 2732)
@@ -1,10 +1,24 @@
 `Plots` <- function(strata = NULL, type = c("none","free","series","grid"),
                     mirror = FALSE, ncol = NULL, nrow = NULL) {
+
+    plots.name <- deparse(substitute(strata))
+
     type <- match.arg(type)
+
+    ## process the call to make it standalone
+    .call <- match.call()
+    if (length(.call) > 1L) {
+        .ll <- as.list(.call[-1])
+        for (i in seq_along(.ll))
+            .ll[[i]] <- eval(.ll[[i]], parent.frame())
+        .ll <- c(as.list(.call[[1]]), .ll)
+        names(.ll) <- names(.call)
+        .call <- as.call(.ll)
+    }
+
     out <- list(strata = strata, type = type, mirror = mirror,
                 ncol = ncol, nrow = nrow,
-                plots.name = deparse(substitute(strata)), call = match.call())
-    ## keep as list for now
-    ##class(out) <- "Plots"
+                plots.name = plots.name, call = .call)
+    class(out) <- "Plots"
     out
 }

Modified: pkg/permute/R/Within.R
===================================================================
--- pkg/permute/R/Within.R	2013-11-21 16:47:13 UTC (rev 2731)
+++ pkg/permute/R/Within.R	2013-11-21 16:50:28 UTC (rev 2732)
@@ -2,13 +2,21 @@
                      constant = FALSE, mirror = FALSE,
                      ncol = NULL, nrow = NULL)
 {
-    if(missing(type))
-        type <- "free"
-    else
-        type <- match.arg(type)
+    type <- match.arg(type)
+
+    ## process the call to make it standalone
+    .call <- match.call()
+    if (length(.call) > 1L) {
+        .ll <- as.list(.call[-1])
+        for (i in seq_along(.ll))
+            .ll[[i]] <- eval(.ll[[i]], parent.frame())
+        .ll <- c(as.list(.call[[1]]), .ll)
+        names(.ll) <- names(.call)
+        .call <- as.call(.ll)
+    }
+
     out <- list(type = type, constant = constant, mirror = mirror,
-                ncol = ncol, nrow = nrow, call = match.call())
-    ## keep as default list for now
-    ##class(out) <- "Within"
+                ncol = ncol, nrow = nrow, call = .call)
+    class(out) <- "Within"
     out
 }

Modified: pkg/permute/R/how.R
===================================================================
--- pkg/permute/R/how.R	2013-11-21 16:47:13 UTC (rev 2731)
+++ pkg/permute/R/how.R	2013-11-21 16:50:28 UTC (rev 2732)
@@ -8,13 +8,45 @@
                   all.perms = NULL,
                   make = TRUE,
                   observed = FALSE) {
+
+    blocks.name <- deparse(substitute(blocks))
+
+    ## process the call to make it standalone
+    .call <- match.call()
+    if (length(.call) > 1L) {
+        .ll <- as.list(.call[-1])
+        args <- names(.call)[-1]
+        ## evaluate arguments other than within and plots
+        ## those handled in their respective functions
+        for (i in args[!args %in% c("within","plots")]) {
+            .ll[[i]] <- eval(.ll[[i]], parent.frame())
+        }
+    }
+
     out <- list(within = within, plots = plots, blocks = blocks,
                 nperm = nperm, complete = complete,
                 maxperm = maxperm, minperm = minperm,
                 all.perms = all.perms, make = make,
                 observed = observed,
-                blocks.name = deparse(substitute(blocks)),
-                call = match.call())
+                blocks.name = blocks.name)
+
+    ## process within and plots separately
+    if (length(.call) > 1L && "within" %in% args) {
+        .ll[["within"]] <- getCall(within)
+    }
+    if (length(.call) > 1L && "plots" %in% args) {
+        .ll[["plots"]] <- getCall(plots)
+    }
+
+    ## finsh off
+    if (length(.call) > 1L) {
+        .ll <- c(as.list(.call[[1]]), .ll)
+        names(.ll) <- names(.call)
+        .call <- as.call(.ll)
+    }
+
+    out$call <- .call
+
     class(out) <- "how"
     out
 }

Modified: pkg/permute/man/how.Rd
===================================================================
--- pkg/permute/man/how.Rd	2013-11-21 16:47:13 UTC (rev 2731)
+++ pkg/permute/man/how.Rd	2013-11-21 16:50:28 UTC (rev 2732)
@@ -122,6 +122,8 @@
 update(h1, blocks = NULL)
 
 ## ... or switch the type of shuffling at a level:
-update(h1, plots = update(getPlots(h1), type = "none"))
+#update(h1, plots = update(getPlots(h1), type = "none"))
+plots2 <- update(getPlots(h1), type = "none")
+update(h1, plots = plots2)
 }
 \keyword{ utils  }
\ No newline at end of file