Move from simplevis to successor ggblanket

This commit is contained in:
gnoblet 2022-07-10 11:17:17 -04:00
parent 15ab2819c7
commit c8fdf41521
32 changed files with 227 additions and 446 deletions

154
R/hbar.R
View file

@ -1,131 +1,75 @@
#' @title Simple horizontal bar chart
#'
#' @description with nice percentage x labels
#'
#' @param .tbl Some data
#' @param x Some numeric column on the x scale
#' @param y Some column on the y scale
#' @param group Some grouping categorical column, e.g. administrative areas
#' @param initiative Either "reach" or "agora" or "impact" for the color palette
#' @param pal The color palette from the initiative
#' @param width Width.
#' @param x_title The x scale title. Default to empty string
#' @param y_title The y scale title. Default to empty string
#' @param group_title The group legend title. Defaut to NULL
#' @param font_family The font family. Default to "Leelawadee"
#' @param stack Should the chart be stacked? Default to "FALSE" (dodge)
#' @param scales_percent Should x_labels be scaled to percentages? Default to TRUE.
#' @param position Should the chart be stacked? Default to dodge
#' @param reverse Boolean indicating whether the color palette should be reversed
#' @param ... Other arguments to be passed to "simplevis::gg_hbar" or "simplevis:gg_hbar_col"
#' @param title Plot title. Default to empty string
#' @param subtitle Plot subtitle. Default to empty string
#' @param ... Other arguments to be passed to "ggblanket::gg_col"
#'
#' @return A horizontal bar chart
#'
#' @export
hbar_percent <- function(.tbl, x, y, group = NULL, initiative = "reach", x_title = "", y_title = "", group_title = NULL, font_family = "Leelawadee", stack = FALSE, reverse = FALSE, ...){
hbar <- function(.tbl, x, y, group = NULL, initiative = "reach", pal = "primary", width = 0.5, x_title = "", y_title = "", group_title = NULL, font_family = "Leelawadee", scales_percent = TRUE, position = "dodge", reverse = FALSE, title = "", subtitle = "", ...){
if (!(initiative %in% c("reach", "agora", "impact"))) rlang::abort(c("Wrong `initiative` arg", "*" = paste0("Arg `initiative` cannot be: ", initiative), "i" = "It must be one of 'reach' or 'agora' or 'impact'"))
if (initiative == "reach") main_col <- pal_reach("main", reverse = reverse)
if (initiative == "reach") {
palette <- pal_reach(pal, reverse = reverse)
main_col <- cols_reach("main_grey")
if (initiative == "agora") main_col <- pal_agora("main", reverse = reverse)
if (initiative == "impact") rlang::abort("IMPACT colors are under development")
if (is.null(group)) {
hbar <- .tbl |>
simplevis::gg_hbar(
x_var = {{ x }},
y_var = {{ y }},
theme = simplevis::gg_theme(font = font_family, pal_title = main_col),
x_title = x_title,
y_title = y_title,
alpha_fill = 1,
pal = main_col,
x_labels = scales::percent,
stack = stack,
...)
} else {
group_name <- rlang::as_name(rlang::enquo(group))
if_not_in_stop(.tbl, group_name)
hbar <- .tbl |>
simplevis::gg_hbar_col(
x_var = {{ x }},
y_var = {{ y }},
col_var = {{ group }},
theme = simplevis::gg_theme(font = font_family, pal_title = main_col),
x_title = x_title,
y_title = y_title,
col_title = group_title,
alpha_fill = 1,
pal = main_col,
x_labels = scales::percent,
stack = stack,
...)
}
return(hbar)
}
#' @title Simple horizontal bar chart
#'
#' @description without any change to the x scale
#'
#' @param .tbl Some data
#' @param x Some numeric column on the x scale
#' @param y Some column on the y scale
#' @param group Some grouping categorical column, e.g. administrative areas
#' @param initiative Either "reach" or "agora" or "impact" for the color palette
#' @param x_title The x scale title. Default to empty string
#' @param y_title The y scale title. Default to empty string
#' @param group_title The group legend title. Defaut to NULL
#' @param font_family The font family. Default to "Leelawadee"
#' @param stack Should the chart be stacked? Default to "FALSE" (dodge)
#' @param reverse Boolean indicating whether the color palette should be reversed
#' @param ... Other arguments to be passed to "simplevis::gg_hbar" or "simplevis:gg_hbar_col"
#'
#' @return A horizontal bar chart
#'
#' @export
hbar <- function(.tbl, x, y, group = NULL, initiative = "reach", x_title = "", y_title = "", group_title = NULL, font_family = "Leelawadee", stack = FALSE, reverse = FALSE,...){
if (!(initiative %in% c("reach", "agora", "impact"))) rlang::abort(c("Wrong `initiative` arg", "*" = paste0("Arg `initiative` cannot be: ", initiative), "i" = "It must be one of 'reach' or 'agora' or 'impact'"))
if (initiative == "reach") main_col <- pal_reach("main", reverse = reverse)
if (initiative == "agora") main_col <- pal_agora("main", reverse = reverse)
if (initiative == "impact") rlang::abort("IMPACT colors are under development")
if (is.null(group)) {
hbar <- .tbl |>
simplevis::gg_hbar(
x_var = {{ x }},
y_var = {{ y }},
theme = simplevis::gg_theme(font = font_family, pal_title = main_col),
x_title = x_title,
y_title = y_title,
alpha_fill = 1,
pal = main_col,
...)
} else {
group_name <- rlang::as_name(rlang::enquo(group))
if_not_in_stop(.tbl, group_name)
hbar <- .tbl |>
simplevis::gg_hbar_col(
x_var = {{ x }},
y_var = {{ y }},
col_var = {{ group }},
theme = simplevis::gg_theme(font = font_family, pal_title = main_col),
x_title = x_title,
y_title = y_title,
col_title = group_title,
alpha_fill = 1,
pal = main_col,
stack = stack,
...)
if(is.null(palette)) rlang::warn(
c(paste0("There is no palette '", pal, "' for initiative 'reach'. Fallback to ggblanket's default color palette."),
"i" = paste0("Use `pal_reach(show_palettes = T)` to see the list of availabale palettes.")
)
)
}
if (initiative == "agora") {
palette <- pal_agora(pal, reverse = reverse)
main_col <- cols_agora("main_bordeaux")
if(is.null(palette)) rlang::warn(
c(paste0("There is no palette '", pal, "' for initiative 'agora'. Fallback to ggblanket's default color palette."),
"i" = paste0("Use `pal_agora(show_palettes = T)` to see the list of availabale palettes.")
)
)
}
if (initiative == "impact") rlang::warn("IMPACT colors are under development. Fallback to ggblanket's default.")
hbar <- .tbl |>
ggblanket::gg_col(x = {{ x }},
y = {{ y }},
col = {{ group }},
theme = ggblanket::gg_theme(font = font_family, pal_title = main_col),
x_title = x_title,
y_title = y_title,
col_title = group_title,
alpha_fill = 1,
pal = palette,
width = width,
x_labels = ifelse(scales_percent, scales::percent, NULL),
position = position,
stat = "identity",
title = "",
subtitle = "",
...
)
return(hbar)
}