#' Bar plots
#'
#' Creates a bar plot with vertical or horizontal bars
#'
#' This function relies on \href{http://ggplot2.org/}{ggplot2} package to
#' create a bar plot with vertical or horizontal bars. The function supports
#' panel plot layout. Counts information can be added to the corresponding
#' bars. By default black-and-white theme is used.
#'
#' @param data Data frame: default dataset to use for plot
#' @param var Character: name of a \code{data} column whose counts provided as
#' the height of bars
#' @param var_levels Vector/List: a named vector/list that specifies the
#' levels and labels of \code{var}
#' @param group Character: name of a \code{data} column mapped to the fill of
#' bars
#' @param group_levels Vector/List: a named vector/list that specifies the
#' levels and labels of \code{group}
#' @param facet_r Character: name of a \code{data} column mapped to the facet
#' row in panel plot layout. Check \code{\link[ggplot2]{facet_grid}} for more
#' details
#' @param facet_c Character: name of a \code{data} column mapped to the facet
#' column in panel plot layout. Check \code{\link[ggplot2]{facet_grid}} for
#' more details
#' @param facet_r_levels Vector/List: a named vector/list that specifies the
#' levels and labels of \code{facet_r}
#' @param facet_c_levels Vector/List: a named vector/list that specifies the
#' levels and labels of \code{facet_c}
#' @param facet_scale Character: Are scales shared across all facets. Refer to
#' the `scale` argument in \code{\link[ggplot2]{facet_grid}}. Default `free`
#' means that scales are not shared
#' @param facet_space Character: Refer to the `space` argument in
#' \code{\link[ggplot2]{facet_grid}}. Default `free` means both height and
#' width will vary
#' @param x_lab Character: x-axis label
#' @param y_lab Character: y-axis label
#' @param group_lab Character: group variable label
#' @param title Character: barplot title
#' @param add_counts Logical: If `TRUE` (default), counts will be added to the
#' bars
#' @param counts_pos Character: position to add counts. If `inside-bar`
#' (default), counts will be inside the bars; if `outside-bar`, counts be
#' placed outside the bars. When \code{group} is present and
#' \code{group_bar_position} is specified as `stack`, counts will be placed
#' in the center of the bars
#' @param bar_label_align Character: alignment of the bar labels. If `left`
#' (default), labels will be left-aligned; if `center`, labels will be
#' center-aligned; if `right`, labels will be right-aligned
#' @param bar_label_angle Numeric: the orientation angle (in [0, 360]) of the
#' bar labels on the axis. By default, the label will be perpendicular to the
#' axis
#' @param group_bar_position Character: position adjustment for bars of same
#' group when \code{group} is present. If `dodge` (default), bars of same
#' group are placed side by side; if `stack`, bars of same group are stacked
#' one on top of another.
#' @param grids Character: control the grids. If `on` (default), grids will be
#' drawn; if `x`, only grids on x-axis will be drawn; if `y`, only grids on
#' y-axis will be drawn; if `off`, no grids will be drawn
#' @param bw_theme Logical: If `TRUE` (default), black-and-white theme will be
#' used. Refer to \code{\link[ggplot2]{theme_bw}} for more details
#' @param horizontal Logical: If `TRUE` (default), horizontal barplot is drawn;
#' if `FALSE`, vertical barplot is drawn
#'
#' @return An object of class ggplot. Can be directly sent to plot with
#' \code{\link{print}}
#'
#' @examples
#' gg_barplot(mpg, var = 'class', x_lab = '', horizontal = FALSE)
#' gg_barplot(mpg, var = 'class', group = 'cyl', group_lab = 'Cylinders')
#' var_levels <- c('Mid-size' = 'midsize', 'Minivan' = 'minivan', 'SUV' = 'suv')
#' gg_barplot(mpg, var = 'class', var_levels = var_levels,
#' group = 'cyl', group_lab = 'Cylinders', add_counts = FALSE)
#' gg_barplot(mpg, var = 'class', group = 'cyl', group_bar_position = 'stack')
#'
#' @import dplyr
#' @export
#'
#' @author Feiyang Niu (Feiyang.Niu@gilead.com)
gg_barplot <- function(data, var, var_levels = NULL,
group = NULL, group_levels = NULL,
facet_r = NULL, facet_c = NULL,
facet_r_levels = NULL, facet_c_levels = NULL,
facet_scale = 'free', facet_space = 'free',
x_lab = NULL, y_lab = NULL, group_lab = group,
title = NULL, add_counts = TRUE, counts_pos = 'inside-bar',
bar_label_align = 'left', bar_label_angle = NULL,
group_bar_position = 'dodge', grids = 'on',
bw_theme = TRUE, horizontal = TRUE) {
#---------------------------
# argument match
#---------------------------
check_var_class(data, is.data.frame)
column_in_dataframe(data, var)
if(!is_blank(group)) column_in_dataframe(data, group)
if(!is_blank(facet_r)) column_in_dataframe(data, facet_r)
if(!is_blank(facet_c)) column_in_dataframe(data, facet_c)
arg_in_choices(facet_scale, c('free', 'free_x', 'free_y', 'fixed'))
arg_in_choices(facet_space, c('free', 'free_x', 'free_y', 'fixed'))
arg_in_choices(counts_pos, c('inside-bar', 'outside-bar'))
arg_in_choices(bar_label_align, c('right', 'center', 'left'))
arg_in_choices(group_bar_position, c('dodge', 'stack'))
arg_in_choices(grids, c('on', 'x', 'y', 'off'))
if(!is.null(bar_label_angle)) check_var_class(bar_label_angle, is.numeric)
add_counts <- isTRUE(add_counts)
bw_theme <- isTRUE(bw_theme)
horizontal <- isTRUE(horizontal)
#---------------------------
# data manipulation
#---------------------------
# sort the data
group_by_vars <- c()
if(!is_blank(facet_r)) group_by_vars <- c(group_by_vars, facet_r)
if(!is_blank(facet_c)) group_by_vars <- c(group_by_vars, facet_c)
group_by_vars <- c(group_by_vars, var)
if(!is_blank(group)) group_by_vars <- c(group_by_vars, group)
group_dots <- lapply(group_by_vars, as.symbol)
data <- group_by_(data, .dots = group_dots)
# make `var` a factor
var_levels <- unlist(var_levels)
if(is.null(var_levels)) var_levels <- sort(unique(data[[var]]))
if(horizontal) var_levels <- rev(var_levels)
data[[var]] <- factor(data[[var]], levels = var_levels)
data <- data[!is.na(data[[var]]), , drop = F]
if(!is.null(names(var_levels))) levels(data[[var]]) <- names(var_levels)
if(is.null(x_lab)) x_lab <- ifelse(horizontal, 'Counts', var)
if(is.null(y_lab)) y_lab <- ifelse(horizontal, var, 'Counts')
if(is.null(title)) title <- paste('Barplot of', var)
if(horizontal) {
temp <- x_lab
x_lab <- y_lab
y_lab <- temp
}
if(!is_blank(facet_r)) {
facet_r_levels <- unlist(facet_r_levels)
if(is.null(facet_r_levels))
facet_r_levels <- sort(unique(data[[facet_r]]))
data[[facet_r]] <- factor(data[[facet_r]], levels = facet_r_levels)
data <- data[!is.na(data[[facet_r]]), , drop = F]
if(!is.null(names(facet_r_levels))) {
levels(data[[facet_r]]) <- names(facet_r_levels)
}
}
if(!is_blank(facet_c)) {
facet_c_levels <- unlist(facet_c_levels)
if(is.null(facet_c_levels))
facet_c_levels <- sort(unique(data[[facet_c]]))
data[[facet_c]] <- factor(data[[facet_c]], levels = facet_c_levels)
data <- data[!is.na(data[[facet_c]]), , drop = F]
if(!is.null(names(facet_c_levels))) {
levels(data[[facet_c]]) <- names(facet_c_levels)
}
}
if(!is_blank(group)) {
group_levels <- unlist(group_levels)
if(is.null(group_levels)) group_levels <- sort(unique(data[[group]]))
data[[group]] <- factor(data[[group]], levels = group_levels)
data <- data[!is.na(data[[group]]), , drop = F]
if(!is.null(names(group_levels))) {
levels(data[[group]]) <- names(group_levels)
}
}
#---------------------------
# make the plot
#---------------------------
plot_ <- gg_wrapper(
data = data, aes_string(x = paste0('`', var, '`')),
facet_r = facet_r, facet_c = facet_c,
facet_scale = facet_scale, facet_space = facet_space,
x_lab = x_lab, y_lab = y_lab, title = title,
fill_var = group, fill_lab = group_lab,
bw_theme = bw_theme, grids = grids
)
if(is_blank(group)) position <- position_identity()
else if(group_bar_position == 'dodge') position <- position_dodge(width=0.9)
else position <- position_stack(reverse = TRUE)
plot_ <- plot_ + geom_bar(position = position)
if(add_counts) {
adjust <- ifelse(counts_pos == 'inside-bar', 1.3, -0.3)
if(is_blank(group) || group_bar_position == 'dodge') {
if(horizontal) {
plot_ <- plot_ +
geom_text(stat = 'count', aes(label = ..count..),
hjust = adjust, position = position)
} else {
plot_ <- plot_ +
geom_text(stat = 'count', aes(label = ..count..),
vjust = adjust, position = position)
}
} else {
label_group_by <- setdiff(group_by_vars, group)
label_data <- data %>%
arrange_(.dots = group_dots) %>%
group_by_(.dots = group_dots) %>%
summarise(counts = n()) %>%
group_by_(.dots = lapply(label_group_by, as.symbol)) %>%
mutate(y = cumsum(counts) - counts / 2)
label_data[[group]] <- factor(label_data[[group]])
if(horizontal) {
plot_ <- plot_ +
geom_text(data = label_data, aes(y = y, label = counts))
} else {
plot_ <- plot_ +
geom_text(data = label_data, aes(y = y, label = counts))
}
}
}
if(!is.null(bar_label_angle)) angle <- bar_label_angle
else angle <- ifelse(horizontal, 0, 90)
adjust <- list('right' = 1, 'center' = 0.5, 'left' = 0)[[bar_label_align]]
if(horizontal) {
plot_ <- plot_ +
theme(axis.text.y = element_text(angle = angle, hjust = adjust)) +
coord_flip()
} else {
plot_ <- plot_ +
theme(axis.text.x = element_text(angle = angle,
hjust = adjust,
vjust = 0.5))
}
return(plot_)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.