[Vegan-commits] r2730 - pkg/permute/R

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

Author: gsimpson
Date: 2013-11-21 17:44:38 +0100 (Thu, 21 Nov 2013)
New Revision: 2730

Modified:
   pkg/permute/R/print.permutationMatrix.R
Log:
changes in the way the design is printed

Modified: pkg/permute/R/print.permutationMatrix.R
===================================================================
--- pkg/permute/R/print.permutationMatrix.R	2013-11-21 16:44:06 UTC (rev 2729)
+++ pkg/permute/R/print.permutationMatrix.R	2013-11-21 16:44:38 UTC (rev 2730)
@@ -2,6 +2,81 @@
 ##  - at the moment, don't print the attributes
 
 `print.permutationMatrix` <- function(x, ...) {
+    ## indicators of plot and block strata
+    pl <- bl <- FALSE
+
+    ## grab the permutation design
+    ctrl <- attr(x, "control") ## gives us the list generated by how()
+
+    ## print out dimensions of permutation matrix
+    msg <- paste("No. of Permutations: ", nrow(x), "; No. of Samples: ",
+                 ncol(x), sep = "")
+    writeLines(strwrap(msg))
+
+    ## print info on blocking, but ONLY if set
+    if (!is.null(blocks <- getBlocks(ctrl))) {
+        bl <- TRUE
+        ll <- length(levels(blocks))
+        msg <- paste("Restricted by Blocks: ", ctrl$blocks.name,
+                     " (", ll, " ", if (ll == 1L) "block" else "blocks",
+                     ")", sep = "")
+        writeLines(strwrap(msg))
+    }
+
+    ## print info on plots, but ONLY if set
+    if (!is.null(strata <- getStrata(ctrl, which = "plots"))) {
+        pl <- TRUE
+        plots <- getPlots(ctrl)
+        pmsg <- switch(pt <- getType(ctrl, which = "plots"),
+                        none = "",
+                        free = "; Randomised",
+                        series = "; Sequence",
+                        grid = paste("; Spatial grid: ",
+                        getRow(ctrl, which = "plots"), "r, ",
+                        getCol(ctrl, which = "plots"), "c", sep = ""))
+        ## add info on mirroring if series or grid
+        if ((pt %in% c("series","grid")) && getMirror(ctrl, which = "plots")) {
+            pmsg <- paste(pmsg, " - mirrored")
+        }
+        ll <- length(levels(strata))
+        msg <- paste("Restricted by Plots: ", plots$plots.name,
+                     " (", ll, " ", if (ll == 1L) "plot" else "plots",
+                     pmsg, ")", sep = "")
+        writeLines(strwrap(msg))
+    }
+
+    ## print info on the within level
+    msg <- "Samples ("
+    if (any(pl, bl)) {
+        msg <- paste(msg, "Nested in: ", sep = "")
+        if (pl && !bl) {
+            nmsg <- "plots; "
+        } else if (bl && !pl) {
+            nmsg <- "blocks; "
+        } else {
+            nmsg <- "plots & blocks; "
+        }
+        msg <- paste(msg, nmsg, sep = "")
+    }
+    wmsg <- switch(wt <- getType(ctrl, which = "within"),
+                   none = "",
+                   free = "Randomised",
+                   series = "Sequence",
+                   grid = paste("Spatial grid: ",
+                   getRow(ctrl, which = "within"), "r, ",
+                   getCol(ctrl, which = "within"), "c", sep = ""))
+    msg <- paste(msg, wmsg, sep = "")
+    ## add info on mirroring if series or grid
+    if ((wt %in% c("series", "grid")) && getMirror(ctrl, which = "within")) {
+        msg <- paste(msg, "; mirrored", sep = "")
+    }
+    ## add info on constant
+    if (getConstant(ctrl, which = "within") && pl) {
+        msg <- paste(msg, "; same permutation in each plot", sep = "")
+    }
+    writeLines(strwrap(paste(msg, ")", sep = "")))
+
+    cat("\n")
     x <- as.matrix(x)
-    print(x)
+    print(x, ...)
 }