Update documentation and check arg error in hbar*() functions
This commit is contained in:
parent
7d170d11ba
commit
4811f00b3f
40 changed files with 1057 additions and 51 deletions
39
R/bbox_buffer.R
Normal file
39
R/bbox_buffer.R
Normal file
|
|
@ -0,0 +1,39 @@
|
|||
#' @title Bbbox buffer
|
||||
#'
|
||||
#' @param sf_obj A `sf` object
|
||||
#' @param buffer A buffer, either one value or a vector of 4 values (left, bottom, right, top). Default to 0.
|
||||
#'
|
||||
#' @return A bbox with a buffer
|
||||
#'
|
||||
#' @export
|
||||
buffer_bbox <- function(sf_obj, buffer = 0){
|
||||
|
||||
rlang::check_installed("sf", reason = "Package \"sf\" needed for `buffer_bbox()` to work. Please install it.")
|
||||
|
||||
|
||||
if (!(length(buffer) %in% c(1,4)) | !is.numeric(buffer)) stop("Please provide a numeric buffer of length 1 or 4.")
|
||||
|
||||
bbox <- sf::st_bbox(sf_obj)
|
||||
xrange <- bbox$xmax - bbox$xmin # range of x values
|
||||
yrange <- bbox$ymax - bbox$ymin # range of y values
|
||||
|
||||
|
||||
bbox_with_buffer <- if (length(buffer) == 1) {
|
||||
c(
|
||||
bbox[1] - (buffer * xrange), # xmin - left
|
||||
bbox[2] - (buffer * yrange), # ymin - bottom
|
||||
bbox[3] + (buffer * xrange), # xmax - right
|
||||
bbox[4] + (buffer * yrange) # ymax - top
|
||||
)
|
||||
} else if (length(buffer) == 4) {
|
||||
c(
|
||||
bbox[1] - (buffer[1] * xrange), # xmin - left
|
||||
bbox[2] - (buffer[2] * yrange), # ymin - bottom
|
||||
bbox[3] + (buffer[3] * xrange), # xmax - right
|
||||
bbox[4] + (buffer[4] * yrange) # ymax - top
|
||||
)
|
||||
} else {
|
||||
print("Missed something while writing the funtion.")
|
||||
}
|
||||
|
||||
}
|
||||
30
R/hbar.R
30
R/hbar.R
|
|
@ -12,7 +12,6 @@
|
|||
#' @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
|
||||
|
|
@ -21,7 +20,7 @@
|
|||
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 %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 <- cols_reach("main_grey")
|
||||
|
||||
|
|
@ -30,12 +29,11 @@ hbar_percent <- function(.tbl, x, y, group = NULL, initiative = "reach", x_title
|
|||
if (initiative == "impact") rlang::abort("IMPACT colors are under development")
|
||||
|
||||
if (is.null(group)) {
|
||||
hbar <- data |>
|
||||
hbar <- .tbl |>
|
||||
simplevis::gg_hbar(
|
||||
x_var = {{ x }},
|
||||
y_var = {{ y }},
|
||||
title = title,
|
||||
theme = gg_theme(font = font, pal_title = main_col),
|
||||
theme = simplevis::gg_theme(font = font_family, pal_title = main_col),
|
||||
x_title = x_title,
|
||||
y_title = y_title,
|
||||
alpha_fill = 1,
|
||||
|
|
@ -47,16 +45,15 @@ hbar_percent <- function(.tbl, x, y, group = NULL, initiative = "reach", x_title
|
|||
group_name <- rlang::as_name(rlang::enquo(group))
|
||||
if_not_in_stop(.tbl, group_name)
|
||||
|
||||
hbar <- data |>
|
||||
hbar <- .tbl |>
|
||||
simplevis::gg_hbar_col(
|
||||
x_var = {{ x }},
|
||||
y_var = {{ y }},
|
||||
col_var = {{ group }},
|
||||
title = title,
|
||||
theme = gg_theme(font = font, pal_title = main_col),
|
||||
theme = simplevis::gg_theme(font = font_family, pal_title = main_col),
|
||||
x_title = x_title,
|
||||
y_title = y_title,
|
||||
col_title = col_title,
|
||||
col_title = group_title,
|
||||
alpha_fill = 1,
|
||||
pal = main_col,
|
||||
x_labels = scales::percent,
|
||||
|
|
@ -81,7 +78,6 @@ hbar_percent <- function(.tbl, x, y, group = NULL, initiative = "reach", x_title
|
|||
#' @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
|
||||
|
|
@ -90,7 +86,7 @@ hbar_percent <- function(.tbl, x, y, group = NULL, initiative = "reach", x_title
|
|||
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 %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 <- cols_reach("main_grey")
|
||||
|
||||
|
|
@ -99,12 +95,11 @@ hbar <- function(.tbl, x, y, group = NULL, initiative = "reach", x_title = "", y
|
|||
if (initiative == "impact") rlang::abort("IMPACT colors are under development")
|
||||
|
||||
if (is.null(group)) {
|
||||
hbar <- data |>
|
||||
hbar <- .tbl |>
|
||||
simplevis::gg_hbar(
|
||||
x_var = {{ x }},
|
||||
y_var = {{ y }},
|
||||
title = title,
|
||||
theme = gg_theme(font = font, pal_title = main_col),
|
||||
theme = simplevis::gg_theme(font = font_family, pal_title = main_col),
|
||||
x_title = x_title,
|
||||
y_title = y_title,
|
||||
alpha_fill = 1,
|
||||
|
|
@ -115,16 +110,15 @@ hbar <- function(.tbl, x, y, group = NULL, initiative = "reach", x_title = "", y
|
|||
group_name <- rlang::as_name(rlang::enquo(group))
|
||||
if_not_in_stop(.tbl, group_name)
|
||||
|
||||
hbar <- data |>
|
||||
hbar <- .tbl |>
|
||||
simplevis::gg_hbar_col(
|
||||
x_var = {{ x }},
|
||||
y_var = {{ y }},
|
||||
col_var = {{ group }},
|
||||
title = title,
|
||||
theme = gg_theme(font = font, pal_title = main_col),
|
||||
theme = simplevis::gg_theme(font = font_family, pal_title = main_col),
|
||||
x_title = x_title,
|
||||
y_title = y_title,
|
||||
col_title = col_title,
|
||||
col_title = group_title,
|
||||
alpha_fill = 1,
|
||||
pal = main_col,
|
||||
stack = stack,
|
||||
|
|
|
|||
|
|
@ -85,3 +85,13 @@ if_vec_not_in_stop <- function(vec, cols, vec_name, arg = NULL){
|
|||
)
|
||||
}
|
||||
}
|
||||
|
||||
#' @title Subvec not in
|
||||
#'
|
||||
#' @param vector A vector to subset
|
||||
#' @param set A set-vector
|
||||
#'
|
||||
#' @return A subset of vector not in set
|
||||
subvec_not_in <- function(vector, set){
|
||||
vector[!(vector %in% set)]
|
||||
}
|
||||
|
|
|
|||
|
|
@ -6,6 +6,7 @@
|
|||
#'
|
||||
#' @return The base REACH theme
|
||||
#'
|
||||
#' @export
|
||||
theme_reach <- function(family = "Leelawadee") {
|
||||
|
||||
rlang::check_installed("ggplot2", reason = "Package \"ggplot2\" needed for `theme_reach_*()` to work. Please install it.")
|
||||
|
|
@ -47,7 +48,7 @@ theme_reach_borders <- function(family = "Leelawadee") {
|
|||
|
||||
|
||||
|
||||
#' @title Some reach more minimal theme for ggplot
|
||||
#' @title Some reach more minimal theme for a ggplot histogram
|
||||
#'
|
||||
#' @param family The font family. Default to "Leelawadee"
|
||||
#'
|
||||
|
|
@ -67,7 +68,7 @@ theme_reach_hist <- function(family = "Leelawadee") {
|
|||
}
|
||||
|
||||
|
||||
#' @title Some reach more minimal theme for ggplot
|
||||
#' @title Some reach more minimal theme for a ggplot flipped histogram
|
||||
#'
|
||||
#' @param family The font family. Default to "Leelawadee"
|
||||
#'
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue