[Vegan-commits] r2786 - pkg/vegan/R

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

Author: jarioksa
Date: 2013-12-01 16:57:50 +0100 (Sun, 01 Dec 2013)
New Revision: 2786

Added:
   pkg/vegan/R/howHead.R
Modified:
   pkg/vegan/R/anovacca.R
Log:
anovacca got header from the how object

Modified: pkg/vegan/R/anovacca.R
===================================================================
--- pkg/vegan/R/anovacca.R	2013-11-30 23:32:45 UTC (rev 2785)
+++ pkg/vegan/R/anovacca.R	2013-12-01 15:57:50 UTC (rev 2786)
@@ -79,11 +79,9 @@
     is.rda <- inherits(object, "rda")
     colnames(table) <- c("Df", ifelse(is.rda, "Var", "Chisq"), 
                          "F", "N.Perm", "Pr(>F)")
-    head <- paste("Permutation test for", tst$method, "under", 
-                  tst$model, "model\n")
-    if (!is.null(tst$strata)) 
-        head <- paste(head, "Permutations stratified within '", 
-                      tst$strata, "'\n", sep = "")
+    head <- paste0("Permutation test for ", tst$method, " under ", 
+                  tst$model, " model\n", howHead(control),
+                   "Number of permutations: ", tst$nperm, "\n")
     mod <- paste("Model:", c(object$call))
     structure(table, heading = c(head, mod), Random.seed = seed,
               control = control,

Added: pkg/vegan/R/howHead.R
===================================================================
--- pkg/vegan/R/howHead.R	                        (rev 0)
+++ pkg/vegan/R/howHead.R	2013-12-01 15:57:50 UTC (rev 2786)
@@ -0,0 +1,51 @@
+### Make a compact summary of permutations. This copies Gav Simpson's
+### permute:::print.how, but only displays non-default choices in how().
+`howHead` <- function(x, ...)
+{
+    ## this should always work
+    if (is.null(x) || !inherits(x, "how"))
+        stop("not a 'how' object: contact the package maintainer")
+    ## collect header
+    head <- NULL
+    ## blocks
+    if (!is.null(getBlocks(x))) 
+        head <- paste0(head, paste("Blocks: ", x$blocks.name, "\n"))
+    ## plots
+    plotStr <- getStrata(x, which = "plots")
+    if (!is.null(plotStr)) {
+        plots <- getPlots(x)
+        ptype <- getType(x, which = "plots")
+        head <- paste0(head, paste0("Plots: ", plots$plots.name, ", "))
+        head <- paste0(head, paste("plot permutation:", ptype))
+        if(getMirror(x, which = "plots") == "Yes")
+            head <- paste(head, "mirrored")
+        if (isTRUE(all.equal(ptype, "grid"))) {
+            nr <- getRow(x, which = "plots")
+            nc <- getCol(x, which = "plots")
+            head <- paste0(head, sprintf(ngettext(nr, " %d row", " %d rows"),
+                                        nr))
+            head <- paste0(head, sprintf(ngettext(nc, " %d column",
+                                                 " %d columns"), nc))
+        }
+        head <- paste0(head, "\n")
+    }
+    ## the fine level (within plots if any)
+    type <- getType(x, which = "within")
+    head <- paste0(head, "Permutation: ", type)
+    if (isTRUE(type %in% c("series", "grid"))) {
+        if(getMirror(x, which = "within") == "Yes")
+            head <- paste(head, "mirrored")
+        if(getConstant(x) == "Yes")
+            head <- paste0(head, " constant permutation within each Plot")
+    }
+    if (isTRUE(all.equal(type, "grid"))) {
+        nr <- getRow(x, which = "plots")
+        nc <- getCol(x, which = "plots")
+        head <- paste0(head, sprintf(ngettext(nr, " %d row", " %d rows"),
+                                    nr))
+        head <- paste0(head, sprintf(ngettext(nc, " %d column",
+                                             " %d columns"), nc))
+    }
+    head <- paste0(head, "\n")
+    head
+}