From a9afe011605cc0c783ae248cb4b99db000d15c51 Mon Sep 17 00:00:00 2001 From: gnoblet Date: Sun, 8 May 2022 18:00:14 -0400 Subject: [PATCH 1/2] Two horizontal bar chart functions --- R/hbar.R | 136 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 136 insertions(+) create mode 100644 R/hbar.R diff --git a/R/hbar.R b/R/hbar.R new file mode 100644 index 0000000..ef2e453 --- /dev/null +++ b/R/hbar.R @@ -0,0 +1,136 @@ +#' @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 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 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_percent <- function(.tbl, x, y, group = NULL, initiative = "reach", x_title = "", y_title = "", group_title = NULL, font_family = "Leelawadee", stack = FALSE, ...){ + + + if_vec_not_in_stop(initiative, c("reach", "agora", "impact"), "initiative") + + if (initiative == "reach") main_col <- cols_reach("main_grey") + + if (initiative == "agora") main_col <- cols_agora("main_bordeaux") + + if (initiative == "impact") rlang::abort("IMPACT colors are under development") + + if (is.null(group)) { + hbar <- data |> + simplevis::gg_hbar( + x_var = {{ x }}, + y_var = {{ y }}, + title = title, + theme = gg_theme(font = font, 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 <- data |> + simplevis::gg_hbar_col( + x_var = {{ x }}, + y_var = {{ y }}, + col_var = {{ group }}, + title = title, + theme = gg_theme(font = font, pal_title = main_col), + x_title = x_title, + y_title = y_title, + col_title = col_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 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, ...){ + + + if_vec_not_in_stop(initiative, c("reach", "agora", "impact"), "initiative") + + if (initiative == "reach") main_col <- cols_reach("main_grey") + + if (initiative == "agora") main_col <- cols_agora("main_bordeaux") + + if (initiative == "impact") rlang::abort("IMPACT colors are under development") + + if (is.null(group)) { + hbar <- data |> + simplevis::gg_hbar( + x_var = {{ x }}, + y_var = {{ y }}, + title = title, + theme = gg_theme(font = font, pal_title = main_col), + x_title = x_title, + y_title = y_title, + alpha_fill = 1, + pal = main_col, + stack = stack, + ...) + } else { + group_name <- rlang::as_name(rlang::enquo(group)) + if_not_in_stop(.tbl, group_name) + + hbar <- data |> + simplevis::gg_hbar_col( + x_var = {{ x }}, + y_var = {{ y }}, + col_var = {{ group }}, + title = title, + theme = gg_theme(font = font, pal_title = main_col), + x_title = x_title, + y_title = y_title, + col_title = col_title, + alpha_fill = 1, + pal = main_col, + stack = stack, + ...) + } + + return(hbar) +} + From 23acd8f1606a61b46263549971d0c7d73f6c5023 Mon Sep 17 00:00:00 2001 From: gnoblet Date: Sun, 8 May 2022 18:00:52 -0400 Subject: [PATCH 2/2] Add internals for hbar functions --- R/internals.R | 87 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 87 insertions(+) create mode 100644 R/internals.R diff --git a/R/internals.R b/R/internals.R new file mode 100644 index 0000000..3268434 --- /dev/null +++ b/R/internals.R @@ -0,0 +1,87 @@ + + +#' @title Abord bad argument +#' +#' @param arg An argument +#' @param must What arg must be +#' @param not Optional. What arg must not be. +#' +#' @return A stop statement +abort_bad_argument <- function(arg, must, not = NULL) { + msg <- glue::glue("`{arg}` must {must}") + if (!is.null(not)) { + not <- typeof(not) + msg <- glue::glue("{msg}; not {not}.") + } + + rlang::abort("error_bad_argument", + message = msg, + arg = arg, + must = must, + not = not + ) +} + + + +#' @title Stop statement "If not in colnames" with colnames +#' +#' @param .tbl A tibble +#' @param cols A vector of column names (quoted) +#' @param df Provide the tibble name as a character string +#' @param arg Default to NULL. +#' +#' @return A stop statement +if_not_in_stop <- function(.tbl, cols, df, arg = NULL){ + if (is.null(arg)) { + msg <- glue::glue("The following column/s is/are missing in `{df}`:") + } + else { + msg <- glue::glue("The following column/s from `{arg}` is/are missing in `{df}`:") + } + if (!all(cols %in% colnames(.tbl))) { + rlang::abort( + c("Missing columns", + "*" = + paste( + msg, + paste( + subvec_not_in(cols, colnames(.tbl)), + collapse = ", ") + ) + ) + ) + } +} + + + +#' @title Stop statement "If not in vector" +#' +#' @param vec A vector of character strings +#' @param cols A set of character strings +#' @param vec_name Provide the vector name as a character string +#' @param arg Default to NULL. +#' +#' @return A stop statement if some elements of vec are not in cols +if_vec_not_in_stop <- function(vec, cols, vec_name, arg = NULL){ + if (is.null(arg)) { + msg <- glue::glue("The following element/s is/are missing in `{vec_name}`:") + } + else { + msg <- glue::glue("The following element/s from `{arg}` is/are missing in `{vec_name}`:") + } + if (!all(cols %in% vec)) { + rlang::abort( + c("Missing elements", + "*" = + paste( + msg, + paste( + subvec_not_in(cols, vec), + collapse = ", ") + ) + ) + ) + } +}