# --------------------------------------
# Author: Andreas Alfons
# Erasmus Universiteit Rotterdam
# --------------------------------------
#' Plot resampling-based prediction error results
#'
#' Plot results of resampling-based prediction error measures.
#'
#' For objects with multiple columns of prediction error results, conditional
#' plots are produced.
#'
#' @param object,x an object inheriting from class \code{"perry"} or
#' \code{"perrySelect"} that contains prediction error results, or an object of
#' class \code{"setupPerryPlot"} containing all necessary information for
#' plotting (as generated by \code{\link{setupPerryPlot}}).
#' @param which a character string specifying the type of plot. Possible
#' values are \code{"box"} to create a box plot, \code{"density"} to create a
#' smooth density plot, \code{"dot"} to create a dot plot, or \code{"line"} to
#' plot the (average) results for each model as a connected line (for objects
#' inheriting from class \code{"perrySelect"}). Note that the first two plots
#' are only meaningful in case of repeated resampling. The default is to use
#' \code{"box"} in case of repeated resampling and \code{"dot"} otherwise.
#' @param subset a character, integer or logical vector indicating the subset
#' of models for which to plot the prediction error results.
#' @param select a character, integer or logical vector indicating the columns
#' of prediction error results to be plotted.
#' @param seFactor a numeric value giving the multiplication factor of the
#' standard error for displaying error bars in dot plots or line plots. Error
#' bars in those plots can be suppressed by setting this to \code{NA}.
#' @param mapping an aesthetic mapping to override the default behavior (see
#' \code{\link[ggplot2]{aes}} or \code{\link[ggplot2]{aes_string}}).
#' @param facets a faceting formula to override the default behavior. If
#' supplied, \code{\link[ggplot2]{facet_wrap}} or
#' \code{\link[ggplot2]{facet_grid}} is called depending on whether the formula
#' is one-sided or two-sided.
#' @param \dots additional arguments to be passed down, eventually to
#' \code{\link[ggplot2]{geom_boxplot}}, \code{\link[ggplot2]{geom_density}},
#' \code{\link[ggplot2]{geom_pointrange}}, or \code{\link[ggplot2]{geom_line}}.
#'
#' @return
#' An object of class \code{"ggplot"} (see \code{\link[ggplot2]{ggplot}}).
#'
#' @note Duplicate indices in \code{subset} or \code{select} are removed such
#' that all models and prediction error results are unique.
#'
#' @author Andreas Alfons
#'
#' @seealso
#' \code{\link{setupPerryPlot}},
#'
#' \code{\link{perryFit}}, \code{\link{perrySelect}},
#' \code{\link{perryTuning}},
#'
#' \code{\link[ggplot2]{ggplot}}, \code{\link[ggplot2]{autoplot}},
#' \code{\link[graphics]{plot}}
#'
#' @example inst/doc/examples/example-perryPlot.R
#'
#' @keywords hplot
#'
#' @import ggplot2
#' @export
perryPlot <- function(object, ...) UseMethod("perryPlot")
#' @rdname perryPlot
#' @method perryPlot perry
#' @export
perryPlot.perry <- function(object, which = c("box", "density", "dot"),
select = NULL, seFactor = NA, ...) {
# extract information for plotting
setup <- setupPerryPlot(object, select = select, which = which,
seFactor = seFactor)
# call method for object that contains all the necessary information
perryPlot(setup, ...)
}
#' @rdname perryPlot
#' @method perryPlot perrySelect
#' @export
perryPlot.perrySelect <- function(object,
which = c("box", "density", "dot", "line"),
subset = NULL, select = NULL,
seFactor = object$seFactor, ...) {
# extract information for plotting
setup <- setupPerryPlot(object, subset = subset, select = select,
which = which, seFactor = seFactor)
# call method for object that contains all the necessary information
perryPlot(setup, ...)
}
#' @rdname perryPlot
#' @method perryPlot setupPerryPlot
#' @export
perryPlot.setupPerryPlot <- function(object, mapping = object$mapping,
facets = object$facets, ...) {
# initializations
which <- object$which
# call function for selected plot
if (which == "box") {
boxPlot(object, mapping = mapping, facets = facets, ...)
} else if(which == "density") {
densityPlot(object, mapping = mapping, facets = facets, ...)
} else if(which == "line") {
linePlot(object, mapping = mapping, facets = facets, ...)
} else dotPlot(object, mapping = mapping, facets = facets, ...)
}
#' @rdname perryPlot
#' @method autoplot perry
#' @export
autoplot.perry <- function(object, ...) perryPlot(object, ...)
#' @rdname perryPlot
#' @method autoplot perrySelect
#' @export
autoplot.perrySelect <- function(object, ...) perryPlot(object, ...)
#' @rdname perryPlot
#' @method plot perry
#' @export
plot.perry <- function(x, ...) perryPlot(x, ...)
#' @rdname perryPlot
#' @method plot perrySelect
#' @export
plot.perrySelect <- function(x, ...) perryPlot(x, ...)
# ----------
boxPlot <- function(object, mapping = object$mapping,
facets = object$facets, ...) {
# generate plot
p <- ggplot(object$data, mapping) + geom_boxplot(...) +
labs(x = NULL, y = "Prediction error")
if (!is.null(facets)) {
# split plot into different panels
if (length(facets) == 2) p <- p + facet_wrap(facets)
else p <- p + facet_grid(facets)
}
# return plot
p
}
# ----------
densityPlot <- function(object, mapping = object$mapping,
facets = object$facets, ...) {
# initializations
data <- object$data
fits <- data[, "Fit"]
# generate plot
p <- ggplot(data, mapping) + geom_density(...) +
labs(x = "Prediction error", y = NULL)
if (is.numeric(fits)) {
guide <- if (is.integer(fits)) "legend" else "colorbar"
p <- p + scale_color_continuous(breaks = unique(fits), guide = guide)
}
if (!is.null(facets)) {
# split plot into different panels
if (length(facets) == 2) p <- p + facet_wrap(facets)
else p <- p + facet_grid(facets)
}
# return plot
p
}
# ----------
dotPlot <- function(object, mapping = object$mapping,
facets = object$facets, ...) {
# generate plot
p <- ggplot(object$data, mapping) +
geom_pointrange(...) +
labs(x = NULL, y = "Prediction error")
if (!is.null(facets)) {
# split plot into different panels
if (length(facets) == 2) p <- p + facet_wrap(facets)
else p <- p + facet_grid(facets)
}
# return plot
p
}
# ----------
linePlot <- function(object, mapping = object$mapping, facets = object$facets, ...) {
# generate plot
p <- ggplot(object$data, mapping) +
local_geom_line(...) +
geom_pointrange(...) +
labs(x = NULL, y = "Prediction error")
if (!is.null(facets)) {
# split plot into different panels
if (length(facets) == 2) p <- p + facet_wrap(facets)
else p <- p + facet_grid(facets)
}
p
}
## utility functions
# local geom to avoid warning
local_geom_line <- function(..., fatten) {
geom_line(...)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.