R/rmd.anova.table.R

In aphanotus/borealis: Tools for reproducible geometric morphometric analysis

#' Format anova output for R markdown
#'
#' This function formats the table generated by \code{anova} for R markdown knitting.
#'
#' Other arguments are passed to \code{knitr::kable}.
#'
#' @param m1 A model
#' @param m2 An optional second model. If provided, then the first model should be a null.
#' @param digits The number of significant digits to report in the table.
#'    Note that this argument differs from the \code{digits} argument in \code{kable},
#'    in that it is applied to significant digits (using \code{signif}).
#'
#' @source   Dave Angelini \email{david.r.angelini@@gmail.com} [aut, cre]
#'
#' @export
#'
#' @examples
#' data("mantis", package = "borealis")
#'
#' x <- align.angle(mantis,
#'                  art.pt = 11,
#'                  angle.pts.1 = 1:10,
#'                  angle.pts.2 = 12:15,
#'                  rot.pts = 12:16,
#'                  show.plot = FALSE)
#'
#' mantis.gpa <- align.procrustes(x, show.plot.gpa = FALSE)
#' mantis.gpa <- listed.gdf(mantis.gpa)
#'
#' mantis.cs.model <- procD.lm(coords ~ log10(Csize), data = mantis.gpa$gdf, print.progress = FALSE)
#' mantis.model <- procD.lm(coords ~ log10(Csize) + sex, data = mantis.gpa$gdf, print.progress = FALSE)
#'
#' rmd.anova.table(mantis.model)
#'
#' rmd.anova.table(mantis.cs.model, mantis.model)
#'

rmd.anova.table <- function (m1, m2 = NULL, digits = 3, ...)
{ # Begin the function

  # Load packages
  if (!require(knitr)) { stop("Package missing. First, try running `install.packages('knitr')`")}

  # Vet the input
  if (!grepl("lm",class(m1)[1])) {
    stop("Error: Input is not a recognized type. (See the help entry: `?rmd.anova.table`.)\n")
  }
  if (!is.null(m2)) {
    if (!grepl("lm",class(m2)[1])) {
      stop("Error: Input is not a recognized type. (See the help entry: `?rmd.anova.table`.)\n")
    }
  }

  # Get the anova table
  if(is.null(m2)) { output <- anova(m1)$table }
  else { output <- anova(m1, m2, print.progress = FALSE)$table }

  # Remove any empty columns
  rm.cols <- NULL
  for (i in 1:(dim(output)[2])) {
    if (all(is.na(output[,i]))) { rm.cols <- c(rm.cols,i) }
  }
  if (!is.null(rm.cols)) { output <- output[,-rm.cols] }

  # Reformat column names
  names(output) <- sub("Rsq","R^2^",names(output))
  names(output) <- sub("Pr\\(>F\\)","p",names(output))
  names(output) <- sub("^P$","p",names(output))

  # Rounding
  output <- apply(output, 2, signif, digits = digits)

  # Generate the kable
  options(knitr.kable.NA = '')
  kable(output, ...)

} # End of function