#' Print method for two-way tables
#' @param x a numeric matrix
#' @param digits number of digits to print
#' @param border if 0, the components \code{"twoway"} object (\code{"overall", "roweff", "coleff", "residuals"}) are printed separately;
#' if 1, the row, column and overall effects are joined to the residuals in a single table.
#' if 2, row, column, overall and residuals are joined, and decorated with horizontal and vertical rules
#' @param zapsmall a logical value; if \code{TRUE} small residuals are printed as 0.
#' @param ... other arguments passed down
#' @author Michael Friendly, Richard Heiberger
#' @examples
#' data(taskRT)
#' task.2way <- twoway(taskRT)
#' print(task.2way)
#' print(task.2way, border=0)
#'
#' data(sentRT)
#' sent.2way <- twoway(sentRT)
#' print(sent.2way)
#' print(sent.2way, border=1)
#'
#' @export
print.twoway <-
function (x, digits = getOption("digits"), border=2, zapsmall=TRUE, ...)
{
title <- switch(x$method,
mean="Mean decomposition ",
median="Median polish decomposition ",
"Initial data ")
cat("\n", title, '(Dataset: "', x$name, '"; Response: ', x$responseName, ')\n', sep="")
if (border < 1) {
cat("\nOverall: ", x$overall, sep="")
cat("\n\nRow Effects: ", x$varNames[1], "\n", sep = "")
print(x$roweff, digits = digits, ...)
cat("\nColumn Effects:\n")
cat("\nColumn Effects: ", x$varNames[2], "\n", sep = "")
print(x$coleff, digits = digits, ...)
cat("\nResiduals:\n")
resids <- if (zapsmall) zapsmall(x$residuals) else x$residuals
print(resids, digits = max(2L, digits - 2L), ...)
}
else if (border == 1){
cat("Residuals bordered by row effects, column effects, and overall\n\n")
resids <- if (zapsmall) zapsmall(x$residuals) else x$residuals
tbl <- rbind(
cbind( resids, roweff=x$roweff ),
coleff= c( x$coleff, x$overall)
)
names(dimnames(tbl)) <- names(dimnames(resids))
print(tbl, digits = max(2L, digits - 2L), ...)
}
else {
cat("Residuals bordered by row effects, column effects, and overall\n\n")
tbl <- rbind(cbind(x$residuals, roweff = x$roweff),
coleff = c(x$coleff,
x$overall))
tblz <- if (zapsmall) zapsmall(tbl) else tbl
tblf <- format(tblz, digits = max(2L, digits - 2L))
nc <- nchar(tblf[1])
hhyphen <- paste0(rep("-", nc), collapse = "")
ddot <- paste0(rep(".", nc), collapse = "")
tblr <- rbind(` ` = hhyphen, tblf[-nrow(tblf), ], ` ` = ddot,
coleff = tblf[nrow(tblf), ])
vvertical <- c("+", rep("|", nrow(tbl) - 1), "+", "|")
ccolon <- c("+", rep(":", nrow(tbl) - 1), "+", ":")
tblc <- cbind(` ` = vvertical, tblr[, -ncol(tblr)], ` ` = ccolon,
roweff = tblr[, ncol(tblr)])
names(dimnames(tblc)) <- names(dimnames(x$residuals))
print(tblc, quote = FALSE, ...)
}
cat("\n")
invisible(x)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.