Merge pull request #4 from gnoblet/3-add-horizontal-bar-chart-functions
3 add horizontal bar chart functions
This commit is contained in:
GitHub
commit
7d170d11ba
2 changed files with 223 additions and 0 deletions
136
R/hbar.R
Normal file
136
R/hbar.R
Normal file
|
|
@ -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)
|
||||||
|
}
|
||||||
|
|
||||||
87
R/internals.R
Normal file
87
R/internals.R
Normal file
|
|
@ -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 = ", ")
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
}
|
||||||
|
}
|
||||||
Loading…
Add table
Reference in a new issue