R/htest_boot-class.R

In douglasgscofield/nestedRanksTest: Mann-Whitney-Wilcoxon Test for Nested Ranks

#' Print result held in htest_boot object
#'
#' \code{print.htest_boot} prints a return value held in a list of 
#' class \code{'htest_boot'}, as returned by e.g., 
#' \code{\link{nestedRanksTest}}.  Class \code{'htest_boot'}
#' extends class \code{'htest'} by including group weights, the
#' number of bootstrap iterations, and the complete null distribution.
#' The latter is not printed by this function; it may be visualised with
#' \code{\link{plot.htest_boot}}.
#'
#' @param  x      Value of class \code{'htest_boot'} as returned by
#' e.g., \code{nestedRanksTest}.
#'
#' @param digits  Number of digits or significant digits to use in output.
#' Similar to other \code{print} methods, this method pays attention to
#' the \code{"digits"} option.
#'
#' @param prefix  String, passed to \code{\link{print.htest}}
#'
#' @param  \dots  Additional arguments passed to \code{print.htest}.
#'
#' @return The value of x is returned invisibly.
#'
#' @examples
#' data(woodpecker_multiyear)
#' ## n.iter set to 1000 to shorten completion time
#' res <- nestedRanksTest(Distance ~ Year | Granary, n.iter = 1000,
#'                        data = woodpecker_multiyear,
#'                        subset = Species == "agrifolia")
#' class(res)
#' print(res)
#'
#' @seealso \code{\link{plot.htest_boot}} for a graphical plot of test
#'   results, \code{\link{print.htest}} for the print method of
#'   the base class, and \code{\link{nestedRanksTest}} for one test that
#'   returns an object of class \code{'htest_boot'}
#'
#' @export
#'
print.htest_boot <- function(x, digits = getOption("digits"), prefix = "\t", ...)
{
    NextMethod(x, digits = digits, prefix = prefix, ...)
    cat("bootstrap iterations:", x$n.iter, "\ngroup weights:\n")
    print(x$weights, digits = digits, ...)
    invisible(x)
}



#' Diagnostic plot of result held in htest_boot object
#'
#' \code{plot.htest_boot} creates a diagnostic plot of a return value
#' held in a list of class \code{'htest_boot'}, as returned by e.g., 
#' \code{\link{nestedRanksTest}}.  The plot contains a histogram of the
#' null distribution generated by' bootstrapping plotted with
#' \code{\link{hist}}, and a verticle line indicating the observed value
#' plotted with \code{\link{abline}}.
#'
#' If there is no null distribution included in the class, e.g., because 
#' the' options \code{lightweight = TRUE} or \code{n.iter = 1} were given to
#' \code{nestedRanksTest}, this function produces an error.
#'
#' @param  x       Value of class \code{'htest_boot'}
#' @param  breaks  The number of breaks to use when plotting the distribution,
#' the default is calculated from \code{n.iter} of the call to
#' \code{nestedRanksTest}
#' @param  col     Fill color for histogram bars, passed to \code{hist}.
#' @param  border  Border color for histogram bars, passed to \code{hist}
#' @param  digits  Number of digits to use for statistic and p-value, the
#' default is taken from the \code{"digits"} option
#' @param  main    Main title, passed to \code{hist}
#' @param  xlab    X-axis label, passed to \code{hist}
#' @param  ylab    Y-axis label, passed to \code{hist}
#' @param  p.col   Observed value line colour, passed to \code{abline}
#' @param  p.lty   Observed value line type, passed to \code{abline}
#' @param  p.lwd   Observed value line width, passed to \code{abline}
#' @param  \dots   Additional arguments passed to \code{hist} and
#' \code{abline} for plotting
#'
#' @return None
#'
#' @examples
#' require(graphics)
#'
#' data(woodpecker_multiyear)
#'
#' ## n.iter set to 1000 to shorten completion time
#' res.a <- nestedRanksTest(Distance ~ Year | Granary, n.iter = 1000,
#'                          data = woodpecker_multiyear,
#'                          subset = Species == "agrifolia")
#' res.l <- nestedRanksTest(Distance ~ Year | Granary, n.iter = 1000,
#'                          data = woodpecker_multiyear,
#'                          subset = Species == "lobata")
#'
#' opa = par(mfrow = c(2, 1))
#' ## Defaults
#' plot(res.l)
#' ## Modify colours, line type and main title
#' plot(res.a, main = "Quercus agrifolia", col = "lightgreen",
#'      p.col = "brown4", p.lty = 1)
#' par(opa)
#'
#' @seealso \code{\link{print.htest_boot}} for printing test results,
#'   \code{\link{hist}} and \code{\link{abline}} for plotting options,
#'   and \code{\link{nestedRanksTest}} for one test that
#'   returns an object of class \code{'htest_boot'}
#'
#' @keywords hplot
#'
#' @export
#'
plot.htest_boot <- function(x, breaks, col = "lightblue", border = NA,
    digits = getOption("digits"),
    main = paste(sep = "", x$method, ", ", x$data.name, "\n",
                 names(x$statistic), " = ",
                 format(signif(x$statistic, max(1L, digits - 2L))),
                 ", P = ", format.pval(x$p.value, digits = max(1L, digits - 3L))),
   xlab = "Distribution of Z-scores",
   ylab = paste(sep = "", "Frequency (out of ", x$n.iter, ")"),
   p.col = "red", p.lty = 2, p.lwd = 2, ...)
{
    if (is.null(x$null.distribution) || x$n.iter == 1)
        stop(deparse(substitute(x)), " does not contain a null distribution")
    if (missing(breaks))
        breaks <- min(ceiling(x$n.iter / 50), 100)
    hist(x$null.distribution, breaks = breaks, col = col, border = border,
        main = main, xlab = xlab, ylab = ylab, ...)
    abline(v = x$statistic, col = p.col, lty = p.lty, lwd = p.lwd, ...)
}