FreesearchR/R/plot_bar.R

#' Title
#'
#' @name data-plots
#'
#' @param style barplot style passed to geom_bar position argument.
#' One of c("stack", "dodge", "fill")
#'
#' @returns ggplot list object
#' @export
#'
#' @examples
#' mtcars |>
#'   dplyr::mutate(cyl = factor(cyl), am = factor(am)) |>
#'   plot_bar(pri = "cyl", sec = "am", style = "fill")
#'
#' mtcars |>
#'   dplyr::mutate(dplyr::across(tidyselect::all_of(c("cyl","am","gear")),factor)) |>
#'   plot_bar(pri = "cyl", sec = "gear", ter = "am", style = "stack",color.palette="turbo")
plot_bar <- function(data,
                     pri,
                     sec = NULL,
                     ter = NULL,
                     style = c("stack", "dodge", "fill"),
                     color.palette = "viridis",
                     max_level = 30,
                     ...) {
  style <- match.arg(style)

  if (!is.null(ter)) {
    ds <- split(data, data[ter])
  } else {
    ds <- list(data)
  }

  out <- lapply(ds, \(.ds) {
    plot_bar_single(
      data = .ds,
      pri = pri,
      sec = sec,
      style = style,
      max_level = max_level,
      color.palette = color.palette,
      ...
    )
  })

  wrap_plot_list(out,
                 title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")),
                 y.axis.percentage = TRUE)
}


#' Single vertical barplot
#'
#' @param style barplot style passed to geom_bar position argument.
#' One of c("stack", "dodge", "fill")
#'
#' @name data-plots
#'
#' @returns ggplot object
#' @export
#'
#' @examples
#' mtcars |>
#'   dplyr::mutate(cyl = factor(cyl), am = factor(am)) |>
#'   plot_bar_single(pri = "cyl", sec = "am", style = "fill")
#'
#' mtcars |>
#'   dplyr::mutate(cyl = factor(cyl), am = factor(am)) |>
#'   plot_bar_single(pri = "cyl", style = "stack",color.palette="turbo")
plot_bar_single <- function(data,
                            pri,
                            sec = NULL,
                            style = c("stack", "dodge", "fill"),
                            max_level = 30,
                            color.palette = "viridis") {
  style <- match.arg(style)

  if (identical(sec, "none")) {
    sec <- NULL
  }

  p_data <- as.data.frame(table(data[c(pri, sec)])) |>
    dplyr::mutate(dplyr::across(tidyselect::any_of(c(pri, sec)), forcats::as_factor),
                  p = Freq / NROW(data))


  if (nrow(p_data) > max_level) {
    p_data <- sort_by(p_data, p_data[["Freq"]], decreasing = TRUE) |>
      head(max_level)
  }

  ## Shortens long level names
  p_data[[pri]] <- forcats::as_factor(unique_short(as.character(p_data[[pri]]), max = 20))

  if (!is.null(sec)) {
    fill <- sec
  } else {
    fill <- pri
  }

  p <- ggplot2::ggplot(p_data, ggplot2::aes(x = .data[[pri]], y = p, fill = .data[[fill]])) +
    ggplot2::geom_bar(position = style, stat = "identity") +
    scale_fill_generate(palette = color.palette)  +
    ggplot2::xlab(get_label(data, pri)) +
    ggplot2::guides(fill = ggplot2::guide_legend(title = get_label(data, fill)))

  ## To handle large number of levels and long level names

  if (nrow(p_data) > 10 |
      any(nchar(as.character(p_data[[pri]])) > 6)) {
    p <- p +
      # ggplot2::guides(fill = "none") +
      ggplot2::theme(axis.text.x = ggplot2::element_text(
        angle = 90,
        vjust = 1,
        hjust = 1
      )) +
      ggplot2::theme(axis.text.x = ggplot2::element_text(vjust = 0.5))

    if (is.null(sec)) {
      p <- p +
        ggplot2::guides(fill = "none")
    }
  }
  p +
    ggplot2::scale_y_continuous(labels = scales::percent) +
    ggplot2::ylab("Percentage")
}