visualizeR/R/bar.R

#' @rdname bar
#' 
#' @inheritParams bar
#' 
#' @export
hbar <- function(...) bar(flip = TRUE, theme_fun = theme_bar(flip = TRUE, add_text = FALSE), ...)

#' Simple bar chart
#' 
#' [bar()] is a simple bar chart with some customization allowed, in particular the `theme_fun` argument for theming. [hbar()] uses [bar()] with sane defaults for a horizontal bar chart.
#'
#' @param df A data frame.
#' @param x A quoted numeric column.
#' @param y A quoted character column or coercible as a character column.
#' @param group Some quoted grouping categorical column, e.g. administrative areas or population groups.
#' @param facet Some quoted grouping categorical column, e.g. administrative areas or population groups.
#' @param order Should bars be ordered? "none" if no, "y" if yes based on y, "grouped" if yes based on y and group.
#' @param x_rm_na Remove NAs in x?
#' @param y_rm_na Remove NAs in y?
#' @param group_rm_na Remove NAs in group?
#' @param add_color Add a color to bars (if no grouping).
#' @param flip TRUE or FALSE (default). Default to TRUE or horizontal bar plot.
#' @param wrap Should x-labels be wrapped? Number of characters.
#' @param position Should the chart be stacked? Default to "dodge". Can take "dodge" and "stack".
#' @param alpha Fill transparency.
#' @param x_title The x scale title. Default to NULL.
#' @param y_title The y scale title. Default to NULL.
#' @param group_title The group legend title. Default to NULL.
#' @param title Plot title. Default to NULL.
#' @param subtitle Plot subtitle. Default to NULL.
#' @param caption Plot caption. Default to NULL.
#' @param width Bar width.
#' @param add_text TRUE or FALSE. Add values as text.
#' @param add_text_size Text size.
#' @param add_text_color Text color.
#' @param add_text_font_face Text font_face.
#' @param add_text_threshold_display Minimum value to add the text label.
#' @param add_text_suffix If percent is FALSE, should we add a suffix to the text label?
#' @param add_text_expand_limit Default to adding 10% on top of the bar.
#' @param add_text_round Round the text label.
#' @param theme_fun Whatever theme function. For no custom theme, use theme_fun = NULL.
#'
#' @inheritParams reorder
#'
#' @export
bar <- function(
  df,
  x,
  y,
  group = "",
  facet = "",
  order = "none",
  x_rm_na = TRUE,
  y_rm_na = TRUE,
  group_rm_na = TRUE,
  facet_rm_na = TRUE,
  add_color = color("cat_5_main_1"),
  flip = FALSE,
  wrap = NULL,
  position = "dodge",
  alpha = 1,
  x_title = NULL,
  y_title = NULL,
  group_title = NULL,
  title = NULL,
  subtitle = NULL,
  caption = NULL,
  width = 0.7,
  add_text = FALSE,
  add_text_size = 4,
  add_text_color = color("dark_grey"),
  add_text_font_face = "plain",
  add_text_threshold_display = 0.05,
  add_text_suffix = "%",
  add_text_expand_limit = 1.2,
  add_text_round = 1,
  theme_fun = theme_bar(
    flip = FALSE,
    add_text = FALSE,
    axis_text_x_angle = 45,
    axis_text_x_vjust = 1,
    axis_text_x_hjust = 1
  ),
  scale_fill_fun = scale_fill_impact_discrete,
  scale_color_fun = scale_color_impact_discrete
){

  
#------ Checks
  
# df is a data frame
checkmate::assert_data_frame(df)
  
# x and y and group are character
checkmate::assert_character(x, len = 1)
checkmate::assert_character(y, len = 1)
checkmate::assert_character(group, len = 1)
  
# x and y are columns in df
checkmate::assert_choice(x, colnames(df))
checkmate::assert_choice(y, colnames(df))
if (group != "") checkmate::assert_choice(group, colnames(df))
  
# x_rm_na, y_rm_na and group_rm_na are logical scalar
checkmate::assert_logical(x_rm_na, len = 1)
checkmate::assert_logical(y_rm_na, len = 1)
checkmate::assert_logical(group_rm_na, len = 1)
  
# flip is a logical scalar
checkmate::assert_logical(flip, len = 1)
  
# add_text_threshold_display is a numeric scalar
checkmate::assert_numeric(add_text_threshold_display, len = 1)
  
# add_text_suffix is a character scalar
checkmate::assert_character(add_text_suffix, len = 1)
  
# add_text_expand_limit is a numeric scalar
checkmate::assert_numeric(add_text_expand_limit, len = 1)
  
# add_text_round is a numeric scalar
checkmate::assert_numeric(add_text_round, len = 1)
  
  
# Check if numeric and character
if (class(df[[y]]) %notin% c("integer", "numeric")) rlang::abort(paste0(y, " must be numeric."))
if (!any(class(df[[x]]) %in% c("character", "factor"))) rlang::abort(paste0(x, " must be character or factor"))

# Check if position is stack or dodge
if (position %notin% c("stack", "dodge")) rlang::abort("Position should be either 'stack' or 'dodge'.")

#----- Data wrangling
  
# want to use df as a data.table
if (!checkmate::test_data_table(df)) {
  rlang::warn("Converting df to data.table.")
  data.table::setDT(df)
}
  
# Remove NAs using data.table
if (x_rm_na) df[, (x) := na.omit(get(x))]
if (y_rm_na) df[, (y) := na.omit(get(y))]
if (group != "" && group_rm_na) df[, (group) := na.omit(get(group))]
  
# Reorder
dir_order = ifelse(flip, 1, -1)
df <- reorder(df, x, y, group, order, dir_order)
  
# Prepare aes
if(group != "") {

  g <- ggplot2::ggplot(
    df,
    mapping = ggplot2::aes(
      x = !!rlang::sym(x),
      y = !!rlang::sym(y),
      fill = !!rlang::sym(group),
      color = !!rlang::sym(group)
    )
  )

} else {

  g <- ggplot2::ggplot(
    df,
    mapping = ggplot2::aes(
      x = !!rlang::sym(x),
      y = !!rlang::sym(y)
    )
  )
}

# Add title, subtitle, caption, x_title, y_title
g <- g + ggplot2::labs(
  title = title,
  subtitle = subtitle,
  caption = caption,
  x = y_title,
  y = x_title,
  color = group_title,
  fill = group_title
)

# Width
width <- width
dodge_width <- width

#Facets
if (facet != "") {
  g <- g + ggforce::facet_row(facet, scales = "free_x", space = "free")
}
  
# Guides for legend
# g <- g + ggplot2::guides(
#   fill = ggplot2::guide_legend(
#     title.position = "left",
#     title.hjust = 0,
#     label.hjust = 0.5,
#     #label.position = "bottom",
#     direction = "horizontal"),
#   color = ggplot2::guide_legend(
#     title.position = "left",
#     title.hjust = 0,
#     label.hjust = 0.5,
#     #label.position = "bottom",
#     direction = "horizontal")
# )

# Should the graph use position_fill?
if(group != "") {

  if (position == "stack"){
    g <- g + ggplot2::geom_col(
      alpha    = alpha,
      width    = width,
      position = ggplot2::position_stack()
    )
  } else if (position == "dodge"){
    g <- g + ggplot2::geom_col(
      alpha    = alpha,
      width    = width,
      position = ggplot2::position_dodge2(
        width = dodge_width,
        preserve = "single")
    )
  } else{
    g <- g + ggplot2::geom_col(
      alpha = alpha,
      width = width
    )
  }

} else {

  if (position == "stack"){
    g <- g + ggplot2::geom_col(
      alpha    = alpha,
      width    = width,
      position = ggplot2::position_stack(),
      fill = add_color,
      color = add_color
    )
  } else if (position == "dodge"){
    g <- g + ggplot2::geom_col(
      alpha    = alpha,
      width    = width,
      position = ggplot2::position_dodge2(
        width = dodge_width,
        preserve = "single"),
      fill = add_color,
      color = add_color
    )
  } else {
    g <- g + ggplot2::geom_col(
      alpha = alpha,
      width = width,
      fill = add_color,
      color = add_color
    )
  }
}

# Wrap labels on the x scale?
if (!is.null(wrap)) {
  g <- g + ggplot2::scale_x_discrete(labels = scales::label_wrap(wrap))
}


# Because a text legend should always be horizontal, especially for an horizontal bar graph
if (flip) g <- g + ggplot2::coord_flip()
# Add text to bars
if (flip) hjust_flip <- -0.5 else hjust_flip <- 0.5
if (flip) vjust_flip <- 0.5 else vjust_flip <- -0.5


# Add text labels
if (add_text & position == "dodge") {

  df <- dplyr::mutate(df, "y_threshold" := ifelse(!!rlang::sym(y) >= add_text_threshold_display, !!rlang::sym(y), NA ))

  # Expand limits
  g <- g + ggplot2::geom_blank(
    data = df,
    ggplot2::aes(x = !!rlang::sym(x), y = !!rlang::sym(y) * add_text_expand_limit, group = !!rlang::sym(group))
  )

  g <- g + ggplot2::geom_text(
    data = df,
    ggplot2::aes(
      label = ifelse(is.na(!!rlang::sym("y_threshold")), NA, paste0(round(!!rlang::sym("y_threshold"), add_text_round), add_text_suffix)),
      group = !!rlang::sym(group)),
    hjust = hjust_flip,
    vjust = vjust_flip,
    color = add_text_color,
    fontface = add_text_font_face,
    size = add_text_size,
    position = ggplot2::position_dodge2(width = dodge_width)
    )

  } else if (add_text & position == "stack") {

  df <- dplyr::mutate(df, "y_threshold" := ifelse(!!rlang::sym(y) >= add_text_threshold_display, !!rlang::sym(y), NA ))

  g <- g + ggplot2::geom_text(
    data = df,
    ggplot2::aes(
      label = ifelse(is.na(!!rlang::sym("y_threshold")), NA, paste0(round(!!rlang::sym("y_threshold"), add_text_round), add_text_suffix)),
      group = !!rlang::sym(group)),
    color = add_text_color,
    fontface = add_text_font_face,
    size = add_text_size,
    position = ggplot2::position_stack(vjust = 0.5)
  )

  }

  # y scale tweaks
  g <- g +
    ggplot2::scale_y_continuous(
      # start at 0
      expand = c(0, 0),
      # remove trailing 0 and choose accuracy of y labels
      labels =  scales::label_number(
        accuracy = 0.1,
        drop0trailing = TRUE,
        big.mark = "",
        decimal.mark = "."),
    ) 

  # Add theme fun
  if (!is.null(theme_fun)) g <- g + theme_fun

return(g)
}