#' Plot percentile bootstrap shift function
#'
#' Plot one or more shift functions generated with \code{\link{shifthd}},
#' \code{\link{shiftdhd}}, \code{\link{shifthd_pbci}} or
#' \code{\link{shiftdhd_pbci}}. Assumes the median was estimated and is the
#' middle value. The function returns a list of ggplot objects, which can be
#' customised using the \href{http://docs.ggplot2.org/current/}{ggplot2}
#' package.
#'
#' Several themes are available:
#' \itemize{
#' \item Theme 1 uses a minimalist design with the same colour for all quantiles.
#' \item Theme 2 colour codes the sign of the differences.
#' \item Theme 3 uses a greyscale gradient to code the quantiles.
#' }
#'
#' @param data A list of data frames generated by \code{shifthd_pbci} or \code{shiftdhd_pbci}.
#' @param plot_theme One of 3 themes - default is 1.
#' @param symb_col Contour colour of quantile symbol.
#' @param symb_fill Fill colour(s) of quantile symbol. Defaults are "white" for theme 1,
#' c("darkviolet","darkorange2") for theme 2, c("white", "grey") for theme 3.
#' @param symb_size Size of quantile symbol - default = 5.
#' @param symb_shape Shape of the quantile symbol - default = 21 (disc).
#' @param diffint_col Colour of the lines marking the quantile difference intervals.
#' @param diffint_size Size of the lines marking the quantile difference intervals
#' - default = .5.
#' @param q_line_col Colour of the line joining the quantiles.
#' @param q_line_alpha Alpha of the line joining the quantiles - default = .5.
#' @param q_line_size Size of the line joining the quantiles - default = 1.5.
#' @param theme2_alpha Alpha transparency for theme 2 - default c(0.4, 1)
#' @examples
#' plot_sf(out) # default plot
#' plot_sf(out, plot_theme = 2) # specify theme
#' plist <- plot_sf(out) # output list of ggplot objects
#'
#' # The plots can then be combined using \href{https://cran.r-project.org/web/packages/gridExtra/index.html}{gridExtra} or \href{https://cran.r-project.org/web/packages/cowplot/index.html}{cowplot} - for instance:
#' library(gridExtra)
#' do.call("grid.arrange", c(plist, ncol=2))
#' # To extract one object and for instance change a label:
#' p <- plist[[1]]
#' p + labs(y = "Difference")
#'
#' @export
plot_sf <- function(data = df,
plot_theme = 1,
symb_col = NULL,
symb_fill = NULL,
symb_size = 5,
symb_shape = 21,
diffint_col = NULL,
diffint_size = .5,
q_line_col = NULL,
q_line_alpha = .5,
q_line_size = 1.5,
theme2_alpha = NULL){
# check input is a list of data frames
if(!is.list(data)){
stop("data must be a list")
}
for (pc in 1:length(data)) {
if(!is.data.frame(data[[pc]])){
stop("input data list must contain data.frames")
}
}
plist <- vector("list", length(data)) # declare list of plot objects
for (pc in 1:length(data)) {
df <- data[[pc]]
ylim <- max(max(abs(df$ci_upper)),max(abs(df$ci_lower)))
ylim <- c(-ylim,ylim)
midpt <- (nrow(df)-1) / 2 + 1
if(df$q[midpt]!=0.5){
warning("plot_sf() expects the middle of the quantiles to be the median")
}
xintercept <- df[midpt,2] # get median of group 1
xplot = names(df)[2]
# -------------------
# get theme specific formatting
if (plot_theme == 1){
if (is.null(symb_col)){
symb_col <- "#009E73"
}
if (is.null(symb_fill)){
symb_fill <- "white"
}
if (is.null(diffint_col)){
diffint_col <- "#009E73"
}
if (is.null(q_line_col)){
q_line_col <- "#009E73"
}
}
# ------
if (plot_theme == 2){
df$sign <- sign(df$difference) # add difference signs to data frame
df$deco <- c(seq(1,midpt),seq(midpt-1,1)) # add code of quantiles to data frame
if (is.null(symb_col)){
symb_col <- "black"
}
if (is.null(symb_fill)){
symb_fill <- c("darkviolet","darkorange2")
if (length(unique(df$sign)) == 3){
symb_fill <- c("darkviolet",q_line_col,"darkorange2")
}
}
if (length(unique(df$sign)) == 1){
if (unique(df$sign) == -1){
symb_fill <- symb_fill[1]
} else {
symb_fill <- symb_fill[2]
}
}
if (is.null(q_line_col)){
q_line_col <- "grey50"
}
if (is.null(theme2_alpha)){
theme2_alpha <- c(0.4, 1)
}
}
# -----
if (plot_theme == 3){ # add code of quantiles to data frame
df$deco <- c(seq(1,midpt),seq(midpt-1,1))
if (is.null(symb_col)){
symb_col <- "black"
}
if (is.null(symb_fill)){
symb_fill <- c("white","grey30")
}
if (is.null(diffint_col)){
diffint_col <- "black"
}
if (is.null(q_line_col)){
q_line_col <- "grey50"
}
}
# -------------------
if (isTRUE(all.equal(df$q, seq(0.1,0.9,0.1)))) {
lab.x <- paste0("Deciles for ",names(df)[2])
lab.y <- paste0("Decile differences:\n",names(df)[2]," - ",names(df)[3])
} else {
lab.x <- paste0("Quantiles for ",names(df)[2])
lab.y <- paste0("Quantile differences:\n",names(df)[2]," - ",names(df)[3])
}
p <- ggplot(df, aes_string(x = xplot, y = "difference")) +
# x=0 reference line
geom_hline(yintercept = 0, linetype = 2, alpha = 0.5) +
# y=median reference line
geom_vline(xintercept = xintercept, linetype = 2, alpha = 0.5) +
xlab(lab.x) +
ylab(lab.y) +
theme_bw() +
theme(axis.text.x = element_text(size=14),
axis.text.y = element_text(size=14),
axis.title.x = element_text(size=16,face="bold"),
axis.title.y = element_text(size=16,face="bold")) +
scale_y_continuous(limits = ylim)
#scale_x_continuous(breaks = xbreaks)
# --------------------
# apply theme
if (plot_theme == 1){ # default with one colour
p <- p +
# vertical bars for uncertainty intervals
geom_linerange(aes(ymin = ci_lower, ymax = ci_upper), colour = diffint_col,
size = diffint_size) +
# line joining the quantiles
geom_line(colour = q_line_col, alpha = q_line_alpha, linetype = "solid",
size = q_line_size) +
# symbols marking the quantiles
geom_point(colour = symb_col, size = symb_size, shape = symb_shape, fill = symb_fill)
}
if (plot_theme == 2){ # colour code the difference sign
p <- p +
# vertical bars for uncertainty intervals
geom_linerange(aes(ymin = ci_lower, ymax = ci_upper), colour = "white",
size = diffint_size) +
geom_linerange(aes(ymin = ci_lower, ymax = ci_upper, colour = factor(sign),
alpha = factor(deco)), size = diffint_size) +
scale_color_manual(values = symb_fill, guide = FALSE) +
scale_alpha_discrete(range = theme2_alpha, guide = FALSE) +
# line joining the quantiles
geom_line(colour = q_line_col, alpha = q_line_alpha, linetype = "solid",
size = q_line_size) +
# symbols marking the quantiles
geom_point(colour = "black", fill = "white", size = symb_size, shape = symb_shape) +
geom_point(aes(fill = factor(sign), alpha = factor(deco)), colour = symb_col,
size = symb_size, shape = symb_shape) +
scale_fill_manual(values = symb_fill, guide = FALSE) +
scale_alpha_discrete(range = theme2_alpha, guide = FALSE)
}
if (plot_theme == 3){ # greyscale gradient for the quantiles
p <- p +
# vertical bars for uncertainty intervals
geom_linerange(aes(ymin = ci_lower, ymax = ci_upper), colour = diffint_col,
size = diffint_size) +
# line joining the quantiles
geom_line(colour = q_line_col, alpha = q_line_alpha, linetype = "solid",
size = q_line_size) +
# symbols marking the quantiles
geom_point(aes(fill = deco), colour="black", size = symb_size, shape = symb_shape) +
scale_fill_gradient(low = symb_fill[1], high = symb_fill[2], guide = FALSE)
}
# print(p)
plist[[pc]] <- p
}
suppressMessages(plist)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.