FreesearchR/R/plot_bar.R

plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fill"), 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
    )
  })

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


#' 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")
plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", "fill"), max_level = 30) {
  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) {
    # browser()
    p_data <- sort_by(
      p_data,
      p_data[["Freq"]],
      decreasing = TRUE
    ) |>
      head(max_level)
    # if (is.null(sec)){
    #   p_data <- sort_by(
    #     p_data,
    #     p_data[["Freq"]],
    #     decreasing=TRUE) |>
    #     head(max_level)
    # } else {
    #   split(p_data,p_data[[sec]]) |>
    #     lapply(\(.x){
    #       # browser()
    #     sort_by(
    #       .x,
    #       .x[["Freq"]],
    #       decreasing=TRUE) |>
    #       head(max_level)
    #   }) |> dplyr::bind_rows()
    # }
  }

  ## 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") +
    ggplot2::scale_y_continuous(labels = scales::percent) +
    ggplot2::ylab("Percentage") +
    ggplot2::xlab(get_label(data,pri))

  ## 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)
      )
  }
  p
}