R/bar_plot.R

In wkostelecki/ezplot: Functions for Common Chart Types

#' bar_plot
#' @inheritParams area_plot
#' @param width Width of bar.
#' @param rescale_y Rescaling factor for y-axis limits
#' @param label_cutoff Cutoff size (proportion of y data range) for excluding
#'   labels
#' @param position Either \code{"stack"} (default), \code{"fill"} or \code{"dodge"}
#' @param label_pos Position of labels. Can be "auto", "inside", "top", "both"
#'   or "none".
#' @param label_inside Value to display inside bar segments. Options are "y", "absolute", "percent", "share" or "both".
#' @param coord_flip logical (default is FALSE). If TRUE, flips the x and y
#'   coordinate using ggplot2::coord_flip()
#' @param angle angle for geom_text(_repel)
#' @param repel logical (default if FALSE). If TRUE, uses ggrepel for geom_text
#' @return A ggplot object.
#' @export
#'
#' @examples
#' library(tsibble)
#' library(tsibbledata)
#' library(lubridate)
#'
#' bar_plot(ansett, "year(Week)", "Passengers")
#' bar_plot(ansett, "year(Week)", "Passengers", "Class", label_pos = "both")
#' bar_plot(ansett, "year(Week)", "Passengers", "Class", label_pos = "both", label_inside = "both")
#' bar_plot(ansett, "year(Week)", "Passengers", "Class", coord_flip = TRUE)
bar_plot = function(data,
                    x,
                    y = "1",
                    group = NULL,
                    facet_x = NULL,
                    facet_y = NULL,
                    size = 11,
                    width = NULL,
                    reorder = c("group", "facet_x", "facet_y"),
                    palette = ez_col,
                    labels_y = if (position == "fill") {
                      function(x) ez_labels(100 * x, append = "%")
                    } else {
                      ez_labels
                    },
                    labels_x = identity,
                    label_pos = c("auto", "inside", "top", "both", "none"),
                    label_inside = c("y", "absolute", "share", "percent", "both"),
                    rescale_y = 1.1,
                    label_cutoff = 0.12,
                    use_theme = theme_ez,
                    position = "stack",
                    facet_scales = "fixed",
                    legend_ncol = NULL,
                    coord_flip = FALSE,
                    angle = 0,
                    repel = FALSE) {

  label_pos = match.arg(label_pos)
  label_inside = match.arg(label_inside)

  y = nameifnot(y)

  cols = c(x = unname(x),
           y = unname(y),
           group = unname(group),
           facet_x = unname(facet_x),
           facet_y = unname(facet_y))

  group_vars = intersect(c("x", "group", "facet_x", "facet_y"), names(cols))

  gdata = agg_data(data,
                   cols,
                   group_by = cols[group_vars]) %>%
    mutate(abs = y)%>%
    group_by(!!!syms(setdiff(group_vars, "group"))) %>%
    mutate(p = coalesce(y / sum(abs(y)), 0)) %>%
    ungroup()

  if (any("group" == names(gdata))) gdata[["group"]] = factor(gdata[["group"]])

  gdata = reorder_levels(gdata, cols = reorder)

  if ((exists("group", gdata) & (position != "dodge")) | (exists("group", gdata) & (position == "dodge") & coord_flip)) {
    gdata[["group"]] = forcats::fct_rev(gdata[["group"]])
  }

  if (label_pos == "auto") {
    if (position == "fill") {
      label_pos = "inside"
    } else if (!exists("group", gdata) || length(unique(gdata[["group"]])) == 1) {
      label_pos = "top"
    } else if (position == "dodge") {
      label_pos = "top"
    } else {
      label_pos = "inside"
    }
  }

  if (position == "fill") gdata = gdata  %>% mutate(y = p)

  if (facet_scales == "fixed") {
    facet_groups = intersect(names(gdata), c("facet_x", "facet_y"))
  } else {
    facet_groups = NULL
  }

  gdata = gdata %>%
    mutate(sign = ifelse(y >= 0, 1, -1)) %>%
    group_by(!!!syms(c(setdiff(group_vars, "group"), "sign"))) %>%
    mutate(y_height = sum(y)) %>%
    group_by(!!!syms(setdiff(group_vars, c("group", "x", facet_groups)))) %>%
    mutate(y_span = diff(range(y_height, 0, na.rm = TRUE)),
           y_range = y_span * (1 + (rescale_y - 1) * n_distinct(sign))) %>%
    ungroup

  gdata = gdata  %>%
    arrange(!!!syms(c(group_vars, "sign"))) %>%
    group_by(!!!syms(setdiff(c(group_vars, "sign"), "group"))) %>%
    mutate(ylabel_pos = rev(cumsum(rev(y))) - y / 2,
           ylabel_cutoff = label_cutoff * max(y_span)) %>%
    ungroup()

  if (label_inside == "y") {
    gdata[["ylabel_text"]] = labels_y(signif(gdata[["y"]], 3))
  } else if (label_inside == "absolute") {
    gdata[["ylabel_text"]] = ez_labels(gdata[["abs"]], signif = 3)
  } else if (label_inside %in% c("p", "share")) {
    gdata[["ylabel_text"]] = ez_labels(100 * gdata[["p"]], signif = 3, append = "%")
  } else if (label_inside == "both") {
    gdata[["ylabel_text"]] = paste0(ez_labels(gdata[["abs"]], signif = 3),
                                    "\n",
                                    ez_labels(100 * gdata[["p"]], signif = 3, append = "%"))
  }
  gdata[["ylabel_text"]] = ifelse(abs(gdata[["y"]]) > gdata[["ylabel_cutoff"]], gdata[["ylabel_text"]], "")

  if (coord_flip && (is.factor(gdata[["x"]]) | is.character(gdata[["x"]]))) {
    gdata[["x"]] = forcats::fct_rev(factor(gdata[["x"]]))
  }

  g = ggplot(gdata)


  if (position == "dodge" & exists("group", gdata)) {
    fill_pal = palette(length(unique(gdata[["group"]])))
    g = g +
      geom_col(aes(x, y,
                   fill = group),
               width = width,
               position = position_dodge(0.9),
               orientation = "x") +
      scale_fill_manual(NULL,
                        values = if (coord_flip) rev(fill_pal) else fill_pal,
                        labels = function(x) paste0(x, "   "),
                        breaks = if (coord_flip) rev else identity,
                        guide = guide_legend(ncol = legend_ncol))
  } else if (exists("group", gdata)) {

    fill_pal = rev(palette(length(unique(gdata[["group"]]))))
    g = g +
      geom_col(aes(x, y,
                   fill = group),
               width = width,
               orientation = "x") +
      scale_fill_manual(NULL,
                        values = fill_pal,
                        labels = function(x) paste0(x, "   "),
                        breaks = rev,
                        guide = guide_legend(ncol = legend_ncol))

  } else {
    fill_pal = palette(1)
    g = g +
      geom_col(aes(x, y),
               fill = fill_pal,
               orientation = "x",
               width = width)
  }

  if (repel) {
    g_text = function(...) ggrepel::geom_text_repel(...,
                                                    point.size = NA,
                                                    box.padding = 0,
                                                    point.padding = 0,
                                                    ylim = c(-Inf, Inf),
                                                    xlim = c(-Inf, Inf),
                                                    angle = angle,
                                                    size = size * 0.8 / ggplot2::.pt,
                                                    direction = if (coord_flip) "x" else "y",
                                                    position = if(position == "dodge") position_dodge(0.9) else "identity")
  } else {
    g_text = function(...) geom_text(...,
                                     angle = angle,
                                     size = size * 0.8 / ggplot2::.pt,
                                     position = if(position == "dodge") position_dodge(0.9) else "identity")
  }

  if (label_pos != "none") {

    if (label_pos %in% c("inside", "both") && position != "dodge") {
      if (!exists("group", g[["data"]])) g[["data"]][["group"]] = factor("")
      inside_text = g[["data"]] %>%
        mutate(placement = "inside",
               vjust = if (angle == 0) 0.38 else 0.33,
               hjust = 0.5,
               colour = text_contrast(fill_pal[as.numeric(group)])) %>%
        select(-sign, -y_height, -y_span, -y_range, -group)
    } else {inside_text = data.frame()}

    if (label_pos %in% c("top", "both") & position != "fill") {
      top_vjust = case_when(coord_flip & angle > 0 ~ 1,
                            coord_flip & angle < 0 ~ -0.38,
                            coord_flip ~ 0.38,
                            !coord_flip & angle > 0 ~ 0.33,
                            !coord_flip & angle < 0 ~ 0.33,
                            TRUE ~ -0.2)
      top_hjust = case_when(coord_flip  & angle != 0 ~ 0.5,
                            coord_flip ~ 0,
                            !coord_flip & angle > 0 ~ 0,
                            !coord_flip & angle < 0 ~ 1,
                            TRUE ~ 0.5)
      top_text = gdata %>%
        group_by(!!!syms(intersect(names(gdata),
                                   c("x", "facet_x", "facet_y",
                                     if(position == "dodge") "group" else NULL)))) %>%
        summarize(y_range = y_range[1],
                  ylabel_pos = sum(y[y > 0], na.rm = TRUE) + y_range / 200,
                  y = sum(y, na.rm = TRUE)) %>%
        ungroup %>%
        mutate(ylabel_text = labels_y(signif(y, 3)),
               colour = "black",
               placement = "top",
               vjust = top_vjust,
               hjust = top_hjust) %>%
        select(-y_range)
    } else {top_text = data.frame()}

    all_text = bind_rows(top_text, inside_text)
    # print(all_text)

    g = g + g_text(data = all_text,
                   aes(x, ylabel_pos, label = ylabel_text, group = group),
                   vjust = all_text[["vjust"]],
                   hjust = all_text[["hjust"]],
                   colour = all_text[["colour"]])

  }

  g = quick_facet(g, scales = facet_scales)

  expand = c((rescale_y - 1) * any(gdata[["y"]] < 0) * (position %in% c("stack", "dodge")),
             0,
             (rescale_y - 1) * any(gdata[["y"]] >= 0) * (position %in% c("stack", "dodge")),
             0)

  g = g +
    xlab(names(x)) +
    ylab(names(y)) +
    scale_y_continuous(labels = labels_y,
                       expand = expand) +
    ylab(names(y)) +
    use_theme(size)

  if (coord_flip) {

    g = g +
      coord_flip(clip = "off") +
      theme(axis.line.y = element_line(color = "grey85",
                                       linewidth = if (size > 16) 0.8 else 0.2),
            axis.line.x = element_blank(),
            panel.grid.major.y = element_blank(),
            panel.grid.major.x = element_line(colour = "grey85",
                                              linewidth = if (size > 16) 0.8 else 0.2))

    if (is.numeric(gdata[["x"]])) {
      g = g + scale_x_reverse(labels = labels_x)
    }

  } else {
    g = g + coord_cartesian(clip = "off")
  }

  g

}

globalVariables(c("y_height", "y_range", "y_span", "p",
                  "ylabel_pos", "ylabel_text", "ylabel_cutoff"))