R/print.permutationMatrix.R

In gavinsimpson/permute: Functions for Generating Restricted Permutations of Data

## Simple print method for objects of class "permutationMatrix"
##  - 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()

    blocks <- getBlocks(ctrl)
    plots <- getPlots(ctrl)
    strata <- getStrata(ctrl)

    ## print out dimensions of permutation matrix
    msg <- paste("No. of Permutations: ", nrow(x), sep = "")
    writeLines(strwrap(msg))

    ## print info on the within level
    msg <- paste("No. of Samples:", ncol(x), "(")
    if (any(pl <- !is.null(strata), bl <- !is.null(blocks))) {
        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 = "")))

    ## print info on blocking, but ONLY if set
    if (!is.null(blocks <- getBlocks(ctrl))) {
        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))
    }


    cat("\n")
    x <- as.matrix(x)
    rownames(x) <- paste0("p", seq_len(nrow(x)))
    colnames(x) <- seq_len(ncol(x))
    print(x, ...)
}