R/bcat_plt_bar.R

In Rbearcat: University of Cincinnati Themes and Utilities for Econometrics and Data Science

#' Bar plot utility
#'
#' Create a bar plot using ggplot2 graphics. This function is a wrapper to create
#' commonly used styles of bar plots. Additional layers can be added to this plot
#' as needed. More complicated plots can be creating using individual ggplot2 layers.
#'
#' @param df The data to be displayed
#' @param x Categorical variable to map to the x-axis
#' @param y Variable to map to the y-axis. Only applicable if \code{stat = "identity"}
#' @param fill Variable to map to the fill aesthetic
#' @param facet Facetting variable(s). Note: must wrap in \code{vars()}, e.g, \code{facet = vars(var1, var2)}
#' @param stat Statistic to map to y-axis. Default ("freq") calculates frequencies,
#' "identity" plots the data as-is. "sum", "mean", and "median" calculate
#' and display the respective summary stats
#' Must specify \code{y} if using "identity".
#' @param position  For grouped data, either stack bars (\code{position = "stack"}), place bars side-by-side
#' (\code{position = "dodge"}), or stack such that relative proportions within each group sum to 1 (\code{position = "fill"}).
#' @param x_lab Label for x-axis
#' @param y_lab Label for y-axis
#' @param title Plot title
#' @param subtitle Plot subtitle
#' @param caption Plot caption
#' @param legend_lab Legend title
#' @param legend_position legend position. "bottom" or "right"
#' @param legend_hide Set to \code{TRUE} to hide the legend
#' @param x_scale \code{scale_x_} function to apply to x-axis.
#' @param y_scale \code{scale_y_} function to apply to y-axis.
#' @param fill_scale \code{scale_fill_} function to apply to colors.
#' @param facet_scale Shoud facet scales be fixed ("fixed", the default), free ("free"),
#'                    or free in one dimension ("free_x", "free_y")?
#' @param nrow Number of facet rows
#' @param ncol Number of facet columns
#' @param x_refline Vector of x-values at which to draw vertical reference lines
#' @param y_refline Vector of y-values at which to draw horizontal reference lines
#' @param coord_flip Set to \code{TRUE} to flip x and y-axis. Useful if levels of \code{x} have long names.
#' @param order Set to \code{TRUE} to arrange bars by frequency (if \code{stat = "freq"}), values of \code{y}
#' (if \code{stat = "identity"}), or by other provided \code{stat}.
#' Use if levels of \code{x} do not have a natural ordering.
#' @return A \code{ggplot2} plot object.
#' @author Saannidhya Rawat
#' @family plots
#' @export
#' @examples
#' library(ggplot2)
#' library(dplyr)
#' library(scales)
#'
#' # basic plot of frequencies
#' bcat_plt_bar(df = mpg,
#'              x = toupper(class),
#'              order = TRUE,
#'              x_lab = NULL,
#'              y_lab = NULL,
#'              title = "Number of Vehicles by Class and Drive Type",
#'              legend_lab = "Drive Type")
#'
#' # can plot relative frequencies for each `x` by `fill` using `position = "fill"`
#' bcat_plt_bar(df = mpg,
#'              x = toupper(class),
#'              fill = drv,
#'              position = "fill",
#'              x_lab = NULL,
#'              y_lab = NULL,
#'              y_scale = scale_y_continuous(labels = percent_format()),
#'              title = "Percent of Vehicle Class for Each Drive Type",
#'              legend_lab = "Drive Type")
#'
#' # use `stat` to compute and plot other statistics of interest
#' bcat_plt_bar(mpg,
#'              x = toupper(class),
#'              y = hwy,
#'              fill = factor(year),
#'              stat = "mean",
#'              order = TRUE,
#'              position = "dodge",
#'              y_refline = round(mean(mpg$hwy), 2),
#'              coord_flip = TRUE,
#'              x_lab = NULL,
#'              y_lab = "Highway MPG",
#'              title = "Average Highway MPG by Vehicle Class",
#'              legend_lab = NULL)
#'
#' # use `stat = "identity"` to plot data directly from data set
#' mpg %>%
#'   group_by(year, class) %>%
#'   summarise(hwy = mean(hwy)) %>%
#'   bcat_plt_bar(x = toupper(class),
#'                y = hwy,
#'                fill = factor(year),
#'                stat = "identity",
#'                order = TRUE,
#'                position = "dodge",
#'                y_refline = round(mean(mpg$hwy), 2),
#'                coord_flip = TRUE,
#'                x_lab = NULL,
#'                y_lab = "Highway MPG",
#'                title = "Average Highway MPG by Vehicle Class",
#'                legend_lab = NULL)
#'
bcat_plt_bar <- function(df,
                         x = NULL,
                         y = NULL,
                         fill = NULL,
                         facet = NULL,
                         stat = c("freq", "identity", "sum", "mean", "median"),
                         position = c("stack", "dodge", "fill"),
                         x_lab = ggplot2::waiver(),
                         y_lab = ggplot2::waiver(),
                         title = ggplot2::waiver(),
                         subtitle = ggplot2::waiver(),
                         caption = ggplot2::waiver(),
                         legend_lab = ggplot2::waiver(),
                         legend_position = "bottom",
                         legend_hide = FALSE,
                         x_scale = NULL,
                         y_scale = NULL,
                         fill_scale = Rbearcat::scale_fill_UC(),
                         facet_scale = c("fixed", "free_y", "free_x", "free"),
                         nrow = NULL,
                         ncol = NULL,
                         x_refline = NULL,
                         y_refline = NULL,
                         coord_flip = FALSE,
                         order = FALSE){

  # validation --------------------------------------------------------------

  .validate_df(df)

  # prelims -----------------------------------------------------------------

  stat        <- match.arg(stat)
  position    <- match.arg(position)
  facet_scale <- match.arg(facet_scale)

  # plot-base ---------------------------------------------------------------

  p <- ggplot2::ggplot(data = df, mapping = ggplot2::aes(fill = {{fill}}))


  # bar-layer-and-scales ----------------------------------------------------

  if(stat == "freq"){

    # reorder bars by frequency if `order = TRUE`
    if(order){

      if(coord_flip){

        mapping <- ggplot2::aes(x = forcats::fct_reorder({{x}},
                                                         {{x}},
                                                         length))

      } else{

        mapping <- ggplot2::aes(x = forcats::fct_reorder({{x}},
                                                         {{x}},
                                                         function(x) -length(x)))

      }

    } else{

      mapping <- ggplot2::aes(x = {{x}})

    }

    layer <- ggplot2::geom_bar(mapping = mapping,
                               position = position)

  } else if(stat == "identity"){

    # reorder bars by `y` if `order = TRUE`
    if(order){

      if(coord_flip){

        mapping <- ggplot2::aes(x = forcats::fct_reorder({{x}},
                                                         {{y}},
                                                         sum),
                                y = {{y}})

      } else{

        mapping <- ggplot2::aes(x = forcats::fct_reorder({{x}},
                                                         {{y}},
                                                         function(x) -sum(x)),
                                y = {{y}})

      }

    } else {

      mapping <- ggplot2::aes(x = {{x}},
                              y = {{y}})

    }

    layer <- ggplot2::geom_col(mapping = mapping,
                               position = position)

  } else{

    stat_func <- eval(as.name(stat))

    # reorder bars by `stat_func` if `order = TRUE`
    if(order){

      if(coord_flip){

        mapping <- ggplot2::aes(x = forcats::fct_reorder({{x}},
                                                         {{y}},
                                                         stat_func),
                                y = {{y}})

      } else{

        mapping <- ggplot2::aes(x = forcats::fct_reorder({{x}},
                                                         {{y}},
                                                         function(x) -stat_func(x)),
                                y = {{y}})

      }

    } else {

      mapping <- ggplot2::aes(x = {{x}},
                              y = {{y}})

    }

    layer <- ggplot2::geom_bar(mapping = mapping,
                               position = position,
                               stat = "summary",
                               fun = stat)

  }

  p <- p + layer +
    # scale options
    x_scale +
    y_scale +
    fill_scale

  # facets ------------------------------------------------------------------

  if(!is.null(facet)){

    p <- p + ggplot2::facet_wrap(facets = facet,
                                 nrow = nrow,
                                 ncol = ncol,
                                 scales = facet_scale)

  }

  # labels ------------------------------------------------------------------

  p <- p + ggplot2::labs(x = x_lab,
                         y = y_lab,
                         title = title,
                         subtitle = subtitle,
                         caption = caption,
                         fill = legend_lab)

  # reference-lines ---------------------------------------------------------

  if(!is.null(x_refline)){

    p <- p + ggplot2::geom_vline(xintercept = x_refline)

  }

  if(!is.null(y_refline)){

    p <- p + ggplot2::geom_hline(yintercept = y_refline)

  }

  # add-theme-and-print -----------------------------------------------------

  if(coord_flip){

    p + Rbearcat::theme_UC_vgrid(legend_position = legend_position,
                                legend_hide = legend_hide) +
      ggplot2::coord_flip()

  } else{

    p + Rbearcat::theme_UC_hgrid(legend_position = legend_position,
                                legend_hide = legend_hide)

  }

}