From a9b8b5f708fbda2f795b9118606d6eae241590e9 Mon Sep 17 00:00:00 2001 From: gnoblet Date: Fri, 3 Jan 2025 18:09:59 +0100 Subject: [PATCH] start revamp work --- .Rbuildignore | 2 + .Rprofile | 1 + DESCRIPTION | 5 +- R/alluvial.R | 104 -- R/bar.R | 268 ++-- R/bbox_buffer.R | 39 - R/checks.R | 13 + R/color.R | 145 ++ R/cols_agora.R | 32 - R/cols_impact.R | 30 - R/cols_reach.R | 168 --- R/data.R | 93 -- R/donut.R | 107 -- R/dumbbell.R | 161 -- R/internals.R | 100 +- R/lollipop.R | 121 -- R/map.R | 354 ----- R/pal_agora.R | 34 - R/pal_fallback.R | 30 - R/pal_impact.R | 34 - R/pal_reach.R | 66 - R/palette.R | 66 + R/palette_gen.R | 61 + R/point.R | 83 +- R/scale.R | 321 ++-- R/test-example.R | 22 + R/theme.R | 385 +++++ R/theme_reach.R | 290 ---- R/visualizeR-package.R | 7 - R/waffle.R | 74 - README.Rmd | 192 +-- data-raw/shapefiles.R | 1 - man/abort_bad_argument.Rd | 21 - man/add_admin_boundaries.Rd | 37 - man/add_admin_labels.Rd | 43 - man/add_compass.Rd | 34 - man/add_credits.Rd | 25 - man/add_indicator_layer.Rd | 61 - man/add_layout.Rd | 49 - man/add_scale_bar.Rd | 31 - man/alluvial.Rd | 64 - man/bar.Rd | 42 +- man/border_admin0.Rd | 25 - man/buffer_bbox.Rd | 19 - man/centroid_admin1.Rd | 28 - man/check_vars_in_df.Rd | 19 + man/color.Rd | 33 + man/cols_agora.Rd | 22 - man/cols_impact.Rd | 22 - man/cols_reach.Rd | 22 - man/donut.Rd | 61 - man/dumbbell.Rd | 85 -- man/frontier_admin0.Rd | 27 - man/if_not_in_stop.Rd | 23 - man/if_vec_not_in_stop.Rd | 23 - man/indicator_admin1.Rd | 29 - man/line_admin1.Rd | 26 - man/lollipop.Rd | 88 -- man/pal_agora.Rd | 31 - man/pal_fallback.Rd | 31 - man/pal_impact.Rd | 31 - man/pal_reach.Rd | 31 - man/palette.Rd | 23 + man/palette_gen.Rd | 26 + man/point.Rd | 22 +- man/scale_color.Rd | 35 - man/scale_color_visualizer_discrete.Rd | 49 + man/scale_fill.Rd | 35 - man/subvec_not_in.Rd | 19 - man/theme_reach.Rd | 93 +- man/visualizeR-package.Rd | 25 - man/waffle.Rd | 53 - renv.lock | 1909 ++++++++++++++++++++++++ renv/.gitignore | 7 + renv/activate.R | 1305 ++++++++++++++++ renv/settings.json | 19 + 76 files changed, 4640 insertions(+), 3472 deletions(-) create mode 100644 .Rprofile delete mode 100644 R/alluvial.R delete mode 100644 R/bbox_buffer.R create mode 100644 R/checks.R create mode 100644 R/color.R delete mode 100644 R/cols_agora.R delete mode 100644 R/cols_impact.R delete mode 100644 R/cols_reach.R delete mode 100644 R/data.R delete mode 100644 R/donut.R delete mode 100644 R/dumbbell.R delete mode 100644 R/lollipop.R delete mode 100644 R/map.R delete mode 100644 R/pal_agora.R delete mode 100644 R/pal_fallback.R delete mode 100644 R/pal_impact.R delete mode 100644 R/pal_reach.R create mode 100644 R/palette.R create mode 100644 R/palette_gen.R create mode 100644 R/test-example.R create mode 100644 R/theme.R delete mode 100644 R/theme_reach.R delete mode 100644 R/visualizeR-package.R delete mode 100644 R/waffle.R delete mode 100644 man/abort_bad_argument.Rd delete mode 100644 man/add_admin_boundaries.Rd delete mode 100644 man/add_admin_labels.Rd delete mode 100644 man/add_compass.Rd delete mode 100644 man/add_credits.Rd delete mode 100644 man/add_indicator_layer.Rd delete mode 100644 man/add_layout.Rd delete mode 100644 man/add_scale_bar.Rd delete mode 100644 man/alluvial.Rd delete mode 100644 man/border_admin0.Rd delete mode 100644 man/buffer_bbox.Rd delete mode 100644 man/centroid_admin1.Rd create mode 100644 man/check_vars_in_df.Rd create mode 100644 man/color.Rd delete mode 100644 man/cols_agora.Rd delete mode 100644 man/cols_impact.Rd delete mode 100644 man/cols_reach.Rd delete mode 100644 man/donut.Rd delete mode 100644 man/dumbbell.Rd delete mode 100644 man/frontier_admin0.Rd delete mode 100644 man/if_not_in_stop.Rd delete mode 100644 man/if_vec_not_in_stop.Rd delete mode 100644 man/indicator_admin1.Rd delete mode 100644 man/line_admin1.Rd delete mode 100644 man/lollipop.Rd delete mode 100644 man/pal_agora.Rd delete mode 100644 man/pal_fallback.Rd delete mode 100644 man/pal_impact.Rd delete mode 100644 man/pal_reach.Rd create mode 100644 man/palette.Rd create mode 100644 man/palette_gen.Rd delete mode 100644 man/scale_color.Rd create mode 100644 man/scale_color_visualizer_discrete.Rd delete mode 100644 man/scale_fill.Rd delete mode 100644 man/subvec_not_in.Rd delete mode 100644 man/visualizeR-package.Rd delete mode 100644 man/waffle.Rd create mode 100644 renv.lock create mode 100644 renv/.gitignore create mode 100644 renv/activate.R create mode 100644 renv/settings.json diff --git a/.Rbuildignore b/.Rbuildignore index f529ba5..96ac2c8 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,3 +1,5 @@ +^renv$ +^renv\.lock$ ^.*\.Rproj$ ^\.Rproj\.user$ ^LICENSE\.md$ diff --git a/.Rprofile b/.Rprofile new file mode 100644 index 0000000..81b960f --- /dev/null +++ b/.Rprofile @@ -0,0 +1 @@ +source("renv/activate.R") diff --git a/DESCRIPTION b/DESCRIPTION index 2fed535..646162e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,7 +17,7 @@ Depends: R (>= 4.1.0) License: GPL (>= 3) Encoding: UTF-8 LazyData: true -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.2 Imports: ggplot2, rlang (>= 0.4.11), @@ -30,7 +30,8 @@ Imports: dplyr, ggalluvial, viridisLite, - waffle + waffle, + stringr Suggests: knitr, roxygen2, diff --git a/R/alluvial.R b/R/alluvial.R deleted file mode 100644 index 5665585..0000000 --- a/R/alluvial.R +++ /dev/null @@ -1,104 +0,0 @@ -#' @title Simple alluvial chart -#' -#' @param df A data frame. -#' @param from A character column of upstream stratum. -#' @param to A character column of downstream stratum. -#' @param value A numeric column of values. -#' @param group The grouping column to fill the alluvium with. -#' @param alpha Fill transparency. Default to 0.5. -#' @param from_levels Order by given from levels? -#' @param value_title The value/y scale title. Default to NULL. -#' @param group_title The group title. Default to NULL. -#' @param title Plot title. Default to NULL. -#' @param subtitle Plot subtitle. Default to NULL. -#' @param caption Plot caption. Default to NULL. -#' @param rect_color Stratum rectangles' fill color. -#' @param rect_border_color Stratum rectangles' border color. -#' @param rect_text_color Stratum rectangles' text color. -#' @param theme Whatever theme. Default to theme_reach(). -#' -#' @return A donut chart to be used parsimoniously -#' -#' @export -alluvial <- function( - df, - from, - to, - value, - group = NULL, - alpha = 0.5, - from_levels = NULL, - value_title = NULL, - group_title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - rect_color = cols_reach("white"), - rect_border_color = cols_reach("main_grey"), - rect_text_color = cols_reach("main_grey"), - theme = theme_reach(axis_y = FALSE, - legend_position = "none") -){ - - if(!is.null(from_levels)) df <- dplyr::mutate(df, "{{from}}" := factor({{ from }}, levels = from_levels)) - - # General mapping - g <- ggplot2::ggplot( - data = df, - mapping = ggplot2::aes( - y = {{ value }}, - axis1 = {{ from }}, - axis3 = {{ to }} - ) - ) - - # Add alluvium - g <- g + - ggalluvial::geom_alluvium( - ggplot2::aes( - fill = {{ group }}, - color = {{ group }} - ), - alpha = alpha) - - # Add stratum - g <- g + - ggalluvial::geom_stratum( - fill = rect_color, - color = rect_border_color - ) - - # Add stratum text - - stratum <- ggalluvial::StatStratum - - g <- g + - ggplot2::geom_text( - stat = stratum, - ggplot2::aes(label = ggplot2::after_stat(!!rlang::sym("stratum"))), - color = cols_reach("main_grey") - ) - - - # Add title, subtitle, caption, x_title, y_title - g <- g + ggplot2::labs( - y = value_title, - title = title, - subtitle = subtitle, - caption = caption, - fill = group_title, - color = group_title - ) - - # Remove x-axis - g <- g + ggplot2::theme( - axis.line.x = ggplot2::element_blank(), - axis.ticks.x = ggplot2::element_blank(), - axis.text.x = ggplot2::element_blank(), - axis.title.x = ggplot2::element_blank() - ) - - g <- g + theme - - return(g) -} diff --git a/R/bar.R b/R/bar.R index 895eb92..0c9f827 100644 --- a/R/bar.R +++ b/R/bar.R @@ -1,11 +1,11 @@ -#' @title Simple bar chart +#' Simple bar chart #' #' @param df A data frame. -#' @param x A numeric column. -#' @param y A character column or coercible as a character column. -#' @param group Some grouping categorical column, e.g. administrative areas or population groups. +#' @param x A quoted numeric column. +#' @param y A quoted character column or coercible as a character column. +#' @param group Some quoted grouping categorical column, e.g. administrative areas or population groups. +#' @param add_color Add a color to bars (if no grouping). #' @param flip TRUE or FALSE. Default to TRUE or horizontal bar plot. -#' @param percent TRUE or FALSE. Should the x-labels (and text labels if present) be displayed as percentages? Default to TRUE. #' @param wrap Should x-labels be wrapped? Number of characters. #' @param position Should the chart be stacked? Default to "dodge". Can take "dodge" and "stack". #' @param alpha Fill transparency. @@ -15,46 +15,96 @@ #' @param title Plot title. Default to NULL. #' @param subtitle Plot subtitle. Default to NULL. #' @param caption Plot caption. Default to NULL. -#' @param add_text TRUE or FALSE. Add the value as text. +#' @param width Bar width. +#' @param add_text TRUE or FALSE. Add values as text. +#' @param add_text_size Text size. +#' @param add_text_color Text color. +#' @param add_text_font_face Text font_face. +#' @param add_text_threshold_display Minimum value to add the text label. #' @param add_text_suffix If percent is FALSE, should we add a suffix to the text label? -#' @param theme Whatever theme. Default to theme_reach(). +#' @param add_text_expand_limit Default to adding 10% on top of the bar. +#' @param add_text_round Round the text label. +#' @param theme_fun Whatever theme function. For no custom theme, use theme_fun = NULL. +#' @param scale_impact Use the package custom scales for fill and color. #' -#' @return A bar chart +#' @inheritParams scale_color_impact_discrete +#' +#' @importFrom rlang `%||%` #' #' @export -bar <- function(df, x, y, group = NULL, flip = TRUE, percent = TRUE, wrap = NULL, position = "dodge", alpha = 1, x_title = NULL, y_title = NULL, group_title = NULL, title = NULL, subtitle = NULL, caption = NULL, add_text = FALSE, add_text_suffix = "", theme = theme_reach()){ +bar <- function( + df, + x, + y, + group = "", + add_color = color("dark_grey"), + flip = TRUE, + wrap = NULL, + position = "dodge", + alpha = 1, + x_title = NULL, + y_title = NULL, + group_title = NULL, + title = NULL, + subtitle = NULL, + caption = NULL, + width = 0.5, + add_text = TRUE, + add_text_size = 5, + add_text_color = color("dark_grey"), + add_text_font_face = "plain", + add_text_threshold_display = 0.05, + add_text_suffix = "%", + add_text_expand_limit = 1.2, + add_text_round = 1){ - # To do : - # - automate bar width and text size, or at least give the flexibility and still center text - # - add facet possibility +# Check if numeric and character +if (class(df[[y]]) %notin% c("integer", "numeric")) rlang::abort(paste0(y, " must be numeric.")) +if (!any(class(df[[x]]) %in% c("character", "factor"))) rlang::abort(paste0(x, " must be character or factor")) - # Prepare group, x and y names - # if (is.null(x_title)) x_title <- rlang::as_name(rlang::enquo(x)) - # if (is.null(y_title)) y_title <- rlang::as_name(rlang::enquo(y)) - # if (is.null(group_title)) group_title <- rlang::as_name(rlang::enquo(group)) +# Check if position is stack or dodge +if (position %notin% c("stack", "dodge")) rlang::abort("Position should be either 'stack' or 'dodge'.") + +if(group != "") { - # Mapping g <- ggplot2::ggplot( - df, - mapping = ggplot2::aes(x = {{ x }}, y = {{ y }}, fill = {{ group }}, color = {{ group }} - ) - ) - - # Add title, subtitle, caption, x_title, y_title - g <- g + ggplot2::labs( - title = title, - subtitle = subtitle, - caption = caption, - x = x_title, - y = y_title, - color = group_title, - fill = group_title + df, + mapping = ggplot2::aes( + x = !!rlang::sym(x), + y = !!rlang::sym(y), + fill = !!rlang::sym(group), + color = !!rlang::sym(group) + ) ) - width <- 0.5 - dodge_width <- 0.5 +} else { + + g <- ggplot2::ggplot( + df, + mapping = ggplot2::aes( + x = !!rlang::sym(x), + y = !!rlang::sym(y) + ) + ) +} + +# Add title, subtitle, caption, x_title, y_title +g <- g + ggplot2::labs( + title = title, + subtitle = subtitle, + caption = caption, + x = y_title, + y = x_title, + color = group_title, + fill = group_title +) + +width <- width +dodge_width <- width + +# Should the graph use position_fill? +if(group != "") { - # Should the graph use position_fill? if (position == "stack"){ g <- g + ggplot2::geom_col( alpha = alpha, @@ -75,67 +125,97 @@ bar <- function(df, x, y, group = NULL, flip = TRUE, percent = TRUE, wrap = NULL width = width ) } - # - # Labels to percent and expand scale - if (percent) { - g <- g + ggplot2::scale_y_continuous( - labels = scales::label_percent( - accuracy = 1, - decimal.mark = ",", - suffix = " %"), - expand = c(0.01, 0.1) + +} else { + + if (position == "stack"){ + g <- g + ggplot2::geom_col( + alpha = alpha, + width = width, + position = ggplot2::position_stack(), + fill = add_color, + color = add_color + ) + } else if (position == "dodge"){ + g <- g + ggplot2::geom_col( + alpha = alpha, + width = width, + position = ggplot2::position_dodge2( + width = dodge_width, + preserve = "single"), + fill = add_color, + color = add_color ) } else { - g <- g + ggplot2::scale_y_continuous(expand = c(0.01, 0.1)) + g <- g + ggplot2::geom_col( + alpha = alpha, + width = width, + fill = add_color, + color = add_color + ) } - - if (!is.null(wrap)) { - g <- g + ggplot2::scale_x_discrete(labels = scales::label_wrap(wrap)) - } - - # Because a text legend should always be horizontal, especially for an horizontal bar graph - if (flip){ - g <- g + ggplot2::coord_flip() - } - - # Add text to bars - if (flip) hjust_flip <- 1.5 else hjust_flip <- 0.5 - if (flip) vjust_flip <- 0.5 else vjust_flip <- 1.5 - - if (add_text & position != "dodge") { - rlang::abort("Adding text labels and positions different than dodges as not been implemented yet") - } - - # Add text labels - if (add_text) { - if (percent) { - g <- g + ggplot2::geom_text( - ggplot2::aes( - label = scales::label_percent( - accuracy = 1, - decimal.mark = ",", - suffix = " %")({{ y }}), - group = {{ group }}), - hjust = hjust_flip, - vjust = vjust_flip, - color = "white", - fontface = "bold", - position = ggplot2::position_dodge(width = dodge_width)) - } else { - g <- g + ggplot2::geom_text( - ggplot2::aes( - label = paste0(round({{ y }}), add_text_suffix), - group = {{ group }}), - hjust = hjust_flip, - vjust = vjust_flip, - color = "white", - fontface = "bold", - position = ggplot2::position_dodge(width = dodge_width)) - } - } - - # Add theme - g <- g + theme - - return(g) } + +# Expand scale +g <- g + ggplot2::scale_y_continuous(expand = c(0, 0)) + +if (!is.null(wrap)) { + g <- g + ggplot2::scale_x_discrete(labels = scales::label_wrap(wrap)) +} + + +# Because a text legend should always be horizontal, especially for an horizontal bar graph +if (flip) g <- g + ggplot2::coord_flip() +# Add text to bars +if (flip) hjust_flip <- -0.5 else hjust_flip <- 0.5 +if (flip) vjust_flip <- 0.5 else vjust_flip <- -0.5 + + +# Add text labels +if (add_text & position == "dodge") { + + df <- dplyr::mutate(df, "y_threshold" := ifelse(!!rlang::sym(y) >= add_text_threshold_display, !!rlang::sym(y), NA )) + + # Expand limits + g <- g + ggplot2::geom_blank( + data = df, + ggplot2::aes(x = !!rlang::sym(x), y = !!rlang::sym(y) * add_text_expand_limit, group = !!rlang::sym(group)) + ) + + g <- g + ggplot2::geom_text( + data = df, + ggplot2::aes( + label = ifelse(is.na(!!rlang::sym("y_threshold")), NA, paste0(round(!!rlang::sym("y_threshold"), add_text_round), add_text_suffix)), + group = !!rlang::sym(group)), + hjust = hjust_flip, + vjust = vjust_flip, + color = add_text_color, + fontface = add_text_font_face, + size = add_text_size, + position = ggplot2::position_dodge2(width = dodge_width) + ) + + +} else if (add_text & position == "stack") { + + df <- dplyr::mutate(df, "y_threshold" := ifelse(!!rlang::sym(y) >= add_text_threshold_display, !!rlang::sym(y), NA )) + + g <- g + ggplot2::geom_text( + data = df, + ggplot2::aes( + label = ifelse(is.na(!!rlang::sym("y_threshold")), NA, paste0(round(!!rlang::sym("y_threshold"), add_text_round), add_text_suffix)), + group = !!rlang::sym(group)), + color = add_text_color, + fontface = add_text_font_face, + size = add_text_size, + position = ggplot2::position_stack(vjust = 0.5) + ) + +} + +# Remove trailing 0 + ! no applicable method for 'round_any' applied to an object of class "character" + + +return(g) +} \ No newline at end of file diff --git a/R/bbox_buffer.R b/R/bbox_buffer.R deleted file mode 100644 index be11e5a..0000000 --- a/R/bbox_buffer.R +++ /dev/null @@ -1,39 +0,0 @@ -#' @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.") - } - -} diff --git a/R/checks.R b/R/checks.R new file mode 100644 index 0000000..7cd9978 --- /dev/null +++ b/R/checks.R @@ -0,0 +1,13 @@ +#' @title Check if variables are in data frame +#' +#' @param df A data frame +#' @param vars A vector of variable names +#' +#' @return A stop statement +check_vars_in_df <- function(df, vars) { + vars_nin <- setdiff(vars, colnames(df)) + + if (length(vars_nin) > 0) { + rlang::abort(glue::glue("Variables ", glue::glue_collapse(vars_nin, sep = ", ", last = ", and "), " not found in data frame.")) + } +} diff --git a/R/color.R b/R/color.R new file mode 100644 index 0000000..39cefb9 --- /dev/null +++ b/R/color.R @@ -0,0 +1,145 @@ +#' Helpers to extract defined colors as hex codes +#' +#' [color()] returns the requested columns, returns NA if absent. [color_pattern()] returns all colors that start with the pattern. +#' +#' @param ... Character names of colors. If NULL returns all colors. +#' @param unname Boolean. Should the output vector be unnamed? Default to `TRUE`. +#' @section Naming of colors: +#' * All branding colors start with "branding"; +#' * All , categorical colors start with ", cat_"; +#' * All sequential colors start with "seq_"; +#' +#' Then, a number indi, cates the number of colors that belong to the palettes, a string the name of the palette, and, finally, a number the position of the color. E.g., "seq_5_red_4" would be the 4th color of a continuous palettes of 5 colors in the red band. Exception is made for white, light_grey, dark_grey, and black. +#' +#' +#' @return Hex codes named or unnamed. +#' +#' @export +color <- function(..., unname = TRUE) { + + #------ Prep + + # Retrieve colors + cols <- c(...) + + # Defined colors + colors <- c( + white = "#FFFFFF" + , light_grey = "#E3E3E3" + , dark_grey = "#464647" + , black = "#000000" + , cat_2_yellow_1 = "#ffc20a" + , cat_2_yellow_2 = "#0c7bdc" + , cat_2_light_1 = "#fefe62" + , cat_2_light_2 = "#d35fb7" + , cat_2_green_1 = "#1aff1a" + , cat_2_green_2 = "#4b0092" + , cat_2_blue_1 = "#1a85ff" + , cat_2_blue_2 = "#d41159" + , cat_5_main_1 = "#083d77" # yale blue + , cat_5_main_2 = "#4ecdc4" # robin egg blue + , cat_5_main_3 = "#f4c095" # peach + , cat_5_main_4 = "#b47eb3" # african violet + , cat_5_main_5 = "#ffd5ff" # mimi pink + , seq_5_main_1 = "#083d77" # yale blue + , seq_5_main_2 = "##396492" + , seq_5_main_3 = "#6b8bad" + , seq_5_main_4 = "#9cb1c9" + , seq_5_main_5 = "#ced8e4" + , cat_5_ibm_1 = "#648fff" + , cat_5_ibm_2 = "#785ef0" + , cat_5_ibm_3 = "#dc267f" + , cat_5_ibm_4 = "#fe6100" + , cat_5_ibm_5 = "#ffb000" + , cat_3_aquamarine_1 = "aquamarine2" + , cat_3_aquamarine_2 = "cornflowerblue" + , cat_3_aquamarine_3 = "brown1" + , cat_3_tol_high_contrast_1 = "#215589" + , cat_3_tol_high_contrast_2 = "#cfaa34" + , cat_3_tol_high_contrast_3 = "#a35364" + , cat_8_tol_adapted_1 = "#332e86" + , cat_8_tol_adapted_2 = "#50504f" + , cat_8_tol_adapted_3 = "#3dab9a" + , cat_8_tol_adapted_4 = "#86ccee" + , cat_8_tol_adapted_5 = "#ddcb77" + , cat_8_tol_adapted_6 = "#ee5859" + , cat_8_tol_adapted_7 = "#aa4599" + , cat_8_tol_adapted_8 = "#721220" + , div_5_orange_blue_1 = "#c85200" + , div_5_orange_blue_2 = "#e48646" + , div_5_orange_blue_3 = "#cccccc" + , div_5_orange_blue_4 = "#6b8ea4" + , div_5_orange_blue_5 = "#366785" + , div_5_green_purple_1 = "#c85200" + , div_5_green_purple_2 = "#e48646" + , div_5_green_purple_3 = "#cccccc" + , div_5_green_purple_4 = "#6b8ea4" + , div_5_green_purple_5 = "#366785" + ) + + + #------ Checks + + # Check that if ... is not null, all colors are defined + if (!is.null(cols)) { + if (cols %notallin% names(colors)) { + rlang::abort(c( + "Some colors not defined", + "*" = glue::glue_collapse(...[which(!... %in% names(cols))], sep = ", ", last = ", and "), + "i" = "Use `color(unname = FALSE)` to see all named available colors." + ) + ) + } + } + + # ------ Return + + if (is.null(cols)) { + cols_to_return <- colors + } else { + cols_to_return <- colors[cols] + } + + if (unname) { + cols_to_return <- unname(cols_to_return) + } + + return(cols_to_return) +} + +#' @rdname color +#' +#' @param pattern Pattern of the start of colors' name. +#' +#' @export +color_pattern <- function(pattern, unname = TRUE){ + + #------ Checks + + # Check that pattern is a character scalar + checkmate::assert_character(pattern, len = 1) + + # Check that unname is a logical scalar + checkmate::assert_logical(unname, len = 1) + + #------ Get colors + + # Get colors + col <- color(unname = FALSE) + col <- col[startsWith(names(col), pattern)] + + if (unname) { + col <- unname(col) + } + + # If col is of length 0, warn + if (length(col) == 0) { + rlang::warn(c( + "No colors match the pattern", + "*" = glue::glue("Pattern used is:'{pattern}'"), + "i" = "Use `color(unname = FALSE)` to see all named available colors." + )) + } + + return(col) +} diff --git a/R/cols_agora.R b/R/cols_agora.R deleted file mode 100644 index 5b2333f..0000000 --- a/R/cols_agora.R +++ /dev/null @@ -1,32 +0,0 @@ -#' @title Function to extract AGORA colors as hex codes -#' -#' @param ... Character names of reach colors. If NULL returns all colors -#' @param unnamed Should the output vector be unnamed? Default to `TRUE` -#' -#' @return An hex code or hex codes named or unnamed -#' -#' @details This function needs to be modified to add colors -#' -#' @export -cols_agora <- function(..., unnamed = TRUE) { - cols <- c(...) - - colors_agora <- c(white = "#FFFFFF", - black = "#000000", - main_bordeaux = "#581522", - main_lt_beige = "#DDD8C4", - main_dk_beige = "#B7AD99", - main_lt_grey = "#BCB8B1") - - if (is.null(cols)) { - cols_to_return <- colors_agora - } else { - cols_to_return <- colors_agora[cols] - } - - if(unnamed){ - cols_to_return <- unname(cols_to_return) - } - - return(cols_to_return) -} diff --git a/R/cols_impact.R b/R/cols_impact.R deleted file mode 100644 index c74bdaf..0000000 --- a/R/cols_impact.R +++ /dev/null @@ -1,30 +0,0 @@ -#' @title Function to extract IMPACT colors as hex codes -#' -#' @param ... Character names of reach colors. If NULL returns all colors -#' @param unnamed Should the output vector be unnamed? Default to `TRUE` -#' -#' @return An hex code or hex codes named or unnamed -#' -#' @details This function needs to be modified to add colors -#' -#' @export -cols_impact <- function(..., unnamed = TRUE) { - cols <- c(...) - - colors_impact <- c(white = "#FFFFFF", - black = "#000000", - main_blue = "#315975", - main_gray = "#58585A") - - if (is.null(cols)) { - cols_to_return <- colors_impact - } else { - cols_to_return <- colors_impact[cols] - } - - if(unnamed){ - cols_to_return <- unname(cols_to_return) - } - - return(cols_to_return) -} diff --git a/R/cols_reach.R b/R/cols_reach.R deleted file mode 100644 index efb1c54..0000000 --- a/R/cols_reach.R +++ /dev/null @@ -1,168 +0,0 @@ -#' @title Function to extract REACH colors as hex codes -#' -#' @param ... Character names of reach colors. If NULL returns all colors -#' @param unnamed Should the output vector be unnamed? Default to `TRUE` -#' -#' @return An hex code or hex codes named or unnamed -#' -#' @details This function needs to be modified to add colors -#' -#' @export -cols_reach <- function(..., unnamed = TRUE) { - cols <- c(...) - - colors_reach <- c( - white = "#FFFFFF", - black = "#000000", - main_grey = "#58585A", - main_red = "#EE5859", - main_lt_grey = "#C7C8CA", - main_beige = "#D2CBB8", - iroise_1 = "#DFECEF", - iroise_2 = "#B1D7E0", - iroise_3 = "#699DA3", - iroise_4 = "#236A7A", - iroise_5 = "#0C3842", - red_main_1 = "#AE2829", - red_main_2 = "#D05E5F", - red_main_3 = "#DB9797", - red_main_4 = "#EBC7C8", - red_main_5 = "#FAF2F2", - red_alt_1 = "#792a2e", - red_alt_2 = "#c0474a", - red_alt_3 = "#ee5859", - red_alt_4 = "#f49695", - red_alt_5 = "#f8d6d6", - red_alt_na = "#f8f4f4", - lt_grey_1 = "#C6C6C6", - lt_grey_2 = "#818183", - grey3 = "#E3E3E3", - dk_grey = "#464647", - two_dots_1 = "#706441", - two_dots_2 = "#56b4e9", - two_dots_flashy_1 = "gold1", - two_dots_flashy_2 = "blue2", - three_dots_1 = "aquamarine2", - three_dots_2 = "cornflowerblue", - three_dots_3 = "brown1", - orpink = "#f8aa9b", - pink = "#f5a6a7", - lt_pink = "#F9C6C7", - hot_pink = "#ef6d6f", - mddk_red = "#bf4749", - dk_red = "#782c2e", - orange = "#F69E61", - lt_green = "#B0CFAC", - green = "#84A181", - dk_green = "#526450", - red_less_4_1 = "#f6e3e3", - red_less_4_2 = "#f3b5b6", - red_less_4_3 = "#ee5a59", - red_less_4_4 = "#9d393c", - red_5_1 = "#f6e3e3", - red_5_2 = "#f3b5b6", - red_5_3 = "#ee5a59", - red_5_4 = "#c0474a", - red_5_5 = "#792a2e", - red_less_7_1 = "#f8f4f4", - red_less_7_2 = "#f8d6d6", - red_less_7_3 = "#f49695", - red_less_7_4 = "#ee5a59", - red_less_7_5 = "#c0474a", - red_less_7_6 = "#792a2e", - red_less_7_7 = "#471119", - green_2_1 = "#cce5c9", - green_2_2 = "#55a065", - green_3_1 = "#e6f2e0", - green_3_2 = "#7ebf85", - green_3_3 = "#2d8246", - green_4_1 = "#e6f2e1", - green_4_2 = "#b0d3ab", - green_4_3 = "#4bab5e", - green_4_4 = "#0c592e", - green_5_1 = "#e6f2e1", - green_5_2 = "#b0d3ab", - green_5_3 = "#6bb26a", - green_5_4 = "#229346", - green_5_5 = "#0c592e", - green_6_1 = "#e6f2e0", - green_6_2 = "#b0d3ab", - green_6_3 = "#75c376", - green_6_4 = "#086d38", - green_6_5 = "#0c592e", - green_6_6 = "#0d4420", - green_7_1 = "#fafafa", - green_7_2 = "#e6f2e0", - green_7_3 = "#b0d3ab", - green_7_4 = "#75c376", - green_7_5 = "#40ab5d", - green_7_6 = "#086d38", - green_7_7 = "#0d4420", - artichoke_2_1 = "#b6c8b1", - artichoke_2_2 = "#53755f", - artichoke_3_1 = "#e4f1db", - artichoke_3_2 = "#89a087", - artichoke_3_3 = "#455843", - artichoke_4_1 = "#e4f1db", - artichoke_4_2 = "#b5ceb2", - artichoke_4_3 = "#89a087", - artichoke_4_4 = "#465944", - artichoke_5_1 = "#e4f1db", - artichoke_5_2 = "#b5ceb2", - artichoke_5_3 = "#89a087", - artichoke_5_4 = "#60755f", - artichoke_5_5 = "#465944", - artichoke_6_1 = "#fafafa", - artichoke_6_2 = "#e4f1db", - artichoke_6_3 = "#b5ceb2", - artichoke_6_4 = "#89a087", - artichoke_6_5 = "#60755f", - artichoke_6_6 = "#455843", - artichoke_7_1 = "#fafafa", - artichoke_7_2 = "#e4f1db", - artichoke_7_3 = "#b5ceb2", - artichoke_7_4 = "#9fb89c", - artichoke_7_5 = "#89a087", - artichoke_7_6 = "#60755f", - artichoke_7_7 = "#455843", - blue_2_1 = "#7cb6c4", - blue_2_2 = "#286877 ", - blue_3_1 = "#b9d7de", - blue_3_2 = "#5ca4b4", - blue_3_3 = "#286877", - blue_4_1 = "#dfecef", - blue_4_2 = "#8fc1cc", - blue_4_3 = "#3f96aa", - blue_4_4 = "#286877", - blue_5_1 = "#dfecef", - blue_5_2 = "#8fc1cc", - blue_5_3 = "#3f96aa", - blue_5_4 = "#256a7a", - blue_5_5 = "#0c3842", - blue_6_1 = "#f4fbfe", - blue_6_2 = "#cfe4e9", - blue_6_3 = "#77b2bf", - blue_6_4 = "#4096aa", - blue_6_5 = "#256a7a", - blue_6_6 = "#0c3842", - blue_7_1 = "#f4fbfe", - blue_7_2 = "#b3d5de", - blue_7_3 = "#77b2bf", - blue_7_4 = "#4096aa", - blue_7_5 = "#27768a", - blue_7_6 = "#0c596b", - blue_7_7 = "#0c3842" - ) - - if (is.null(cols)) { - cols_to_return <- colors_reach - } else { - cols_to_return <- colors_reach[cols] - } - - if (unnamed) { - cols_to_return <- unname(cols_to_return) - } - - return(cols_to_return) -} diff --git a/R/data.R b/R/data.R deleted file mode 100644 index 8101ff4..0000000 --- a/R/data.R +++ /dev/null @@ -1,93 +0,0 @@ -#' Haïti admin 1 centroids shapefile. -#' -#' A multipoint shapefile of Haiti's admin 1. -#' -#' @format A sf multipoint object with 10 features and 9 fields: -#' \describe{ -#' \item{ADM1_PC}{Admin 1 postal code.} -#' \item{ADM1_EN}{Full name in English.} -#' \item{ADM1_FR}{Full name in French.} -#' \item{ADM1_HT}{Full name in Haitian Creole.} -#' \item{ADM0_EN}{Country name in English.} -#' \item{ADM0_FR}{Country name in French.} -#' \item{ADM0_HT}{Country name in Haitian Creole.} -#' \item{ADM0_PC}{Country postal code.} -#' \item{ADM1_FR_UPPER}{Admin 1 French name - uppercase.} -#' \item{geometry}{Multipoint geometry.} -#' } -"centroid_admin1" - - -#' Indicator admin 1 polygons shapefile. -#' -#' A multipolygon shapefile of Haiti's admin 1 with an indicator column 'opn_dfc'. -#' -#' @format A sf multipoint object with 10 features and 10 fields: -#' \describe{ -#' \item{ADM1_PC}{Admin 1 postal code.} -#' \item{admin1}{Admin 1 unique id.} -#' \item{opn_dfc}{Proportion of HHs that reported open defecation as sanitation facility.} -#' \item{ADM1_EN}{Full name in English.} -#' \item{ADM1_FR}{Full name in French.} -#' \item{ADM1_HT}{Full name in Haitian Creole.} -#' \item{ADM0_EN}{Country name in English.} -#' \item{ADM0_FR}{Country name in French.} -#' \item{ADM0_HT}{Country name in Haitian Creole.} -#' \item{ADM0_PC}{Country postal code.} -#' \item{geometry}{Multipolygon geometry.} -#' } -"indicator_admin1" - - -#' Haïti admin 1 lines shapefile. -#' -#' A multiline shapefile of Haiti's admin 1. -#' -#' @format A sf multiline object with 10 features and 8 fields: -#' \describe{ -#' \item{ADM1_EN}{Full name in English.} -#' \item{ADM1_FR}{Full name in French.} -#' \item{ADM1_HT}{Full name in Haitian Creole.} -#' \item{ADM0_EN}{Country name in English.} -#' \item{ADM0_FR}{Country name in French.} -#' \item{ADM0_HT}{Country name in Haitian Creole.} -#' \item{ADM0_PCODE}{Country postal code.} -#' \item{geometry}{Multiline geometry.} -#' } -"line_admin1" - - -#' Haïti border. -#' -#' A multiline shapefile of Haiti's border. -#' -#' @format A sf multiline objet with 1 feature and 6 fields: -#' \describe{ -#' \item{fid_1}{fid_1} -#' \item{uno}{uno} -#' \item{count}{count} -#' \item{x_coord}{x_coord} -#' \item{y_coord}{y_coord} -#' \item{area}{area} -#' \item{geometry}{Multiline geometry.} -#' } -"border_admin0" - - -#' Haïti frontier with Dominican Republic. -#' -#' A multiline shapefile of Haiti's frontier with Dominican Republic. -#' -#' @format A sf multipoint objet with 4 features and 8 fields: -#' \describe{ -#' \item{fid_1}{fid_1} -#' \item{objectid}{objectid} -#' \item{id}{id} -#' \item{fromnode}{fromnode} -#' \item{tonode}{tonode} -#' \item{leftpolygo}{leftpolygo} -#' \item{rightpolygo}{rightpolygo} -#' \item{shape_leng}{shape_leng} -#' \item{geometry}{Multiline geometry.} -#' } -"frontier_admin0" diff --git a/R/donut.R b/R/donut.R deleted file mode 100644 index 0c1cd93..0000000 --- a/R/donut.R +++ /dev/null @@ -1,107 +0,0 @@ -#' @title Simple donut chart (to be used parsimoniously), can be a pie chart -#' -#' @param df A data frame. -#' @param x A character column or coercible as a character column. Will give the donut's fill color. -#' @param y A numeric column. -#' @param alpha Fill transparency. -#' @param x_title The x scale title. Default to NULL. -#' @param title Plot title. Default to NULL. -#' @param subtitle Plot subtitle. Default to NULL. -#' @param caption Plot caption. Default to NULL. -#' @param arrange TRUE or FALSE. Arrange by highest percentage first. -#' @param hole_size Hole size. Default to 3. If less than 2, back to a pie chart. -#' @param add_text TRUE or FALSE. Add the value as text. -#' @param add_text_treshold_display Minimum value to add the text label. -#' @param add_text_color Text color. -#' @param add_text_suffix If percent is FALSE, should we add a suffix to the text label? -#' @param theme Whatever theme. Default to theme_reach(). -#' -#' @return A donut chart to be used parsimoniously -#' -#' @export -donut <- function(df, - x, - y, - alpha = 1, - x_title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - arrange = TRUE, - hole_size = 3, - add_text = TRUE, - add_text_treshold_display = 5, add_text_color = "white", add_text_suffix = "", theme = theme_reach(legend_reverse = TRUE)){ - - # Arrange by biggest prop first ? - if (arrange) df <- dplyr::arrange( - df, - {{ y }} - ) - - # Get levels for scaling - lev <- dplyr::pull(df, {{ x }}) - df <- dplyr::mutate(df, "{{x}}" := factor({{ x }}, levels = lev)) - - # Mapping - g <- ggplot2::ggplot( - df, - mapping = ggplot2::aes( - x = hole_size, - y = {{ y }}, - fill = {{ x }}, - color = {{ x }} - ) - ) - - # Add rect - g <- g + ggplot2::geom_col(alpha = alpha) - - - # Add text labels - if (add_text) { - - df <- dplyr::mutate(df, y_treshold = ifelse({{ y }} >= add_text_treshold_display, {{ y }}, NA )) - - g <- g + - ggplot2::geom_text( - data = df, - ggplot2::aes( - x = hole_size, - y = !!rlang::sym("y_treshold"), - label = paste0({{ y }}, add_text_suffix)), - color = add_text_color, - position = ggplot2::position_stack(vjust = 0.5)) - } - - # Add title, subtitle, caption, x_title, y_title - g <- g + ggplot2::labs( - title = title, - subtitle = subtitle, - caption = caption, - fill = x_title, - color = x_title - ) - - # Transform to polar coordinates and adjust hole - g <- g + - ggplot2::coord_polar( - theta = "y" - ) - - if (hole_size >= 2) g <- g + ggplot2::xlim(c(1, hole_size + 0.5)) # Try to remove that to see how to make a pie chart - - # Add theme - g <- g + theme - - # No axis - g <- g + ggplot2::theme( - axis.text = ggplot2::element_blank(), - axis.line = ggplot2::element_blank(), - axis.ticks = ggplot2::element_blank(), - axis.title = ggplot2::element_blank() - ) - - - return(g) - -} diff --git a/R/dumbbell.R b/R/dumbbell.R deleted file mode 100644 index 18f0e9a..0000000 --- a/R/dumbbell.R +++ /dev/null @@ -1,161 +0,0 @@ -#' Make dumbbell chart. -#' -#' @param df A data frame. -#' @param col A numeric column. -#' @param group_x The grouping column on the x-axis; only two groups. -#' @param group_y The grouping column on the y-axis. -#' @param point_size Point size. -#' @param point_alpha Point alpha. -#' @param segment_size Segment size. -#' @param segment_color Segment color. -#' @param group_x_title X-group and legend title. -#' @param group_y_title Y-axis and group title. -#' @param x_title X-axis title. -#' @param title Title. -#' @param subtitle Subtitle. -#' @param caption Caption. -#' @param line_to_y_axis TRUE or FALSE; add a line connected points and Y-axis. -#' @param line_to_y_axis_type Line to Y-axis type. -#' @param line_to_y_axis_width Line to Y-axis width. -#' @param line_to_y_axis_color Line to Y-axis color. -#' @param add_text TRUE or FALSE; add text at the points. -#' @param add_text_vjust Vertical adjustment. -#' @param add_text_size Text size. -#' @param add_text_color Text color. -#' @param theme A ggplot2 theme, default to `theme_reach()` -#' -#' @return A dumbbell chart. -#' @export -#' -dumbbell <- function(df, - col, - group_x, - group_y, - point_size = 5, - point_alpha = 1, - segment_size = 2.5, - segment_color = cols_reach("main_lt_grey"), - group_x_title = NULL, - group_y_title = NULL, - x_title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - line_to_y_axis = TRUE, - line_to_y_axis_type = 3, - line_to_y_axis_width = 0.5, - line_to_y_axis_color = cols_reach("main_grey"), - add_text = TRUE, - add_text_vjust = 2, - add_text_size = 3.5, - add_text_color = cols_reach("main_grey"), - theme = theme_reach(palette = "primary")){ - - # Get group keys - group_x_keys <- df |> - dplyr::group_by({{ group_x }}) |> - dplyr::group_keys() |> - dplyr::pull() - - # Check if only two groups - if (length(group_x_keys) > 2) rlang::abort("Cannot draw a dumbbell plot for `group_x` with more than 2 groups") - - # Pivot long data - df_pivot <- df |> - tidyr::pivot_wider( - id_cols = c({{ group_y}}), - values_from = {{ col }}, - names_from = {{ group_x }} - ) - - df_pivot <- df_pivot |> - dplyr::rowwise() |> - dplyr::mutate( - min = min(!!rlang::sym(group_x_keys[[1]]), !!rlang::sym(group_x_keys[[2]]), na.rm = T), - max = max(!!rlang::sym(group_x_keys[[1]]), !!rlang::sym(group_x_keys[[2]]), na.rm = T)) |> - dplyr::ungroup() |> - dplyr::mutate(diff = max - min) - - g <- ggplot2::ggplot(df_pivot) - - # Add line - if(line_to_y_axis) { - - xend <- min(dplyr::pull(df, {{ col }})) - - g <- g + - ggplot2::geom_segment( - ggplot2::aes( - x = min, - y = {{ group_y }}, - yend = {{ group_y }}), - xend = xend, - linetype = line_to_y_axis_type, - size = line_to_y_axis_width, - color = line_to_y_axis_color) - } - - # Add segment - g <- g + - ggplot2::geom_segment( - ggplot2::aes( - x = !!rlang::sym(group_x_keys[[1]]), - y = {{ group_y }}, - xend = !!rlang::sym(group_x_keys[[2]]), - yend = {{ group_y }}), - size = segment_size, - color = segment_color - ) - - # Add points - g <- g + - ggplot2::geom_point( - data = df, - ggplot2::aes( - x = {{ col }}, - y = {{ group_y }}, - color = {{ group_x }}, - fill = {{ group_x }} - ), - size = point_size, - alpha = point_alpha - ) - - # Add title, subtitle, caption, x_title, y_title - g <- g + ggplot2::labs( - title = title, - subtitle = subtitle, - caption = caption, - x = x_title, - y = group_y_title, - color = group_x_title, - fill = group_x_title - ) - - # Add stat labels to points - if(add_text) g <- g + - ggrepel::geom_text_repel( - data = df, - ggplot2::aes( - x = {{ col }}, - y = {{ group_y}}, - label = {{ col }} - ), - vjust = add_text_vjust, - size = add_text_size, - color = add_text_color - ) - - # Expan y axis - # g <- g + - # ggplot2::scale_y_discrete( - # group_y_title, - # expand = c(0, 0)) - - - # Add theme - g <- g + theme - - return(g) - -} diff --git a/R/internals.R b/R/internals.R index 0f145b5..4856c41 100644 --- a/R/internals.R +++ b/R/internals.R @@ -1,95 +1,15 @@ -#' @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 - ) +# not in +`%notin%` <- function(a, b) { + !(a %in% b) } - - -#' @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 = ", ") - ) - ) - ) - } +# not all in +`%notallin%` <- function(a, b) { + !(all(a %in% b)) } - - -#' @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 = ", ") - ) - ) - ) - } -} - -#' @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)] +# infix for null replacement +#' @importFrom rlang `%||%` +`%ifnullrep%` <- function(a, b) { + a %||% b } diff --git a/R/lollipop.R b/R/lollipop.R deleted file mode 100644 index 60de655..0000000 --- a/R/lollipop.R +++ /dev/null @@ -1,121 +0,0 @@ -#' @title Simple bar chart -#' -#' @param df A data frame. -#' @param x A numeric column. -#' @param y A character column or coercible as a character column. -#' @param flip TRUE or FALSE. Default to TRUE or horizontal lollipop plot. -#' @param wrap Should x-labels be wrapped? Number of characters. -#' @param arrange TRUE or FALSE. Arrange by highest percentage first. -#' @param point_size Point size. -#' @param point_color Point color. -#' @param point_alpha Point alpha. -#' @param segment_size Segment size. -#' @param segment_color Segment color. -#' @param segment_alpha Segment alpha. -#' @param alpha Fill transparency. -#' @param x_title The x scale title. Default to NULL. -#' @param y_title The y scale title. Default to NULL. -#' @param title Plot title. Default to NULL. -#' @param subtitle Plot subtitle. Default to NULL. -#' @param caption Plot caption. Default to NULL. -#' @param add_text TRUE or FALSE. Add the y value as text within the bubble. -#' @param add_text_size Text size. -#' @param add_text_suffix If percent is FALSE, should we add a suffix to the text label? -#' @param add_text_color Added text color. Default to white. -#' @param add_text_fontface Added text font face. Default to "bold". -#' @param theme Whatever theme. Default to theme_reach(). -#' -#' @return A bar chart -#' -#' @export -lollipop <- function(df, - x, - y, - flip = TRUE, - wrap = NULL, - arrange = TRUE, - point_size = 3, - point_color = cols_reach("main_red"), - point_alpha = 1, - segment_size = 1, - segment_color = cols_reach("main_grey"), - segment_alpha = 1, - alpha = 1, - x_title = NULL, - y_title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - add_text = FALSE, - add_text_size = 3, - add_text_suffix = "", - add_text_color = "white", - add_text_fontface = "bold", - theme = theme_reach()){ - - - # Arrange by biggest prop first ? - if (arrange) df <- dplyr::arrange( - df, - {{ y }} - ) - - # Get levels for scaling - lev <- dplyr::pull(df, {{ x }}) - df <- dplyr::mutate(df, "{{x}}" := factor({{ x }}, levels = lev)) - - # Mapping - g <- ggplot2::ggplot( - df, - mapping = ggplot2::aes(x = {{ x }}, y = {{ y }}, xend = {{ x }}, yend = 0) - ) - - # Add segment - g <- g + ggplot2::geom_segment( - linewidth = segment_size, - alpha = segment_alpha, - color = segment_color - ) - - g <- g + ggplot2::geom_point( - size = point_size, - alpha = point_alpha, - color = point_color - ) - - if (!is.null(wrap)) { - g <- g + ggplot2::scale_x_discrete(labels = scales::label_wrap(wrap)) - } - - # Because a text legend should always be horizontal, especially for an horizontal bar graph - if (flip){ - g <- g + ggplot2::coord_flip() - } - - # Add text labels - if (add_text) { - g <- g + ggplot2::geom_text( - ggplot2::aes( - label = paste0({{ y }}, add_text_suffix)), - size = add_text_size, - color = add_text_color, - fontface = add_text_fontface) - } - - # Add title, subtitle, caption, x_title, y_title - g <- g + ggplot2::labs( - title = title, - subtitle = subtitle, - caption = caption, - x = x_title, - y = y_title, - ) - - - # Add theme - g <- g + theme - - return(g) - -} - diff --git a/R/map.R b/R/map.R deleted file mode 100644 index 3e9ac1b..0000000 --- a/R/map.R +++ /dev/null @@ -1,354 +0,0 @@ - - -#' Wrapper around `tmap::tm_polygons()` with sane defaults for plotting indicator values -#' -#' @param poly Multipolygon shape defined by sf package. -#' @param col Numeric attribute to map. -#' @param buffer A buffer, either one value or a vector of 4 values (left, bottom, right, top). -#' @param n The desire number of classes. -#' @param style Method to process the color scale for continuous numerical variables. See `classInt::classIntervals()` for details. -#' @param palette Vector of fill colors as hexadecimal values. For REACH color palettes, it is possible to use `pal_reach()`. For now,'palette' must be changed manually, accordingly to the number of drawn classes. -#' @param as_count Boolean. When col is a numeric variable, should it be processed as a count variable? For instance, 0, 1-10, 11-20. -#' @param color_na Fill color for missing data. -#' @param text_na Legend text for missing data. -#' @param legend_title Legend title. -#' @param legend_text_separator Text separator for classes. E.g. " to " will give 0, 1 to 10, 11 to 20. -#' @param border_alpha Transparency of the border. -#' @param border_col Color of the border. -#' @param lwd Linewidth of the border. -#' @param ... Other arguments to pass to `tmap::tm_polygons()`. -#' -#' @return A tmap layer. -#' @export -#' -add_indicator_layer <- function( - poly, - col, - buffer = NULL, - n = 5, - style = "pretty", - palette = pal_reach("red_5"), - as_count = TRUE, - color_na = cols_reach("white"), - text_na = "Missing data", - legend_title = "Proportion (%)", - legend_text_separator = " - ", - border_alpha = 1, - border_col = cols_reach("lt_grey_1"), - lwd = 1, - ...){ - - #------ Checks and make valid - - rlang::check_installed("tmap", reason = "Package \"tmap\" needed for `add_indicator_layer()` to work. Please install it.") - - poly <- sf::st_make_valid(poly) - - #------ Other checks - - col_name <- rlang::as_name(rlang::enquo(col)) - if_not_in_stop(poly, col_name, "poly", "col") - - if (!is.numeric(poly[[col_name]])) rlang::abort(glue::glue("{col_name} is not numeric.")) - - - #------ Prepare data - - if(!is.null(buffer)){ buffer <- buffer_bbox(poly, buffer) } else { buffer <- NULL } - - - #------ Polygon layer - - layer <- tmap::tm_shape( - poly, - bbox = buffer - ) + - tmap::tm_polygons( - col = col_name, - n = n, - style = style, - palette = palette, - as.count = as_count, - colorNA = color_na, - textNA = text_na, - title = legend_title, - legend.format = list(text.separator = legend_text_separator), - borderl.col = border_col, - border.alpha = border_alpha, - lwd = lwd, - ... - ) - - return(layer) - -} - - - - -#' Add admin boundaries (lines) and the legend -#' -#' @param lines List of multiline shape defined by sf package. -#' @param colors Vector of hexadecimal codes. Same order as lines. -#' @param labels Vector of labels in the legend. Same order as lines. -#' @param lwds Vector of line widths. Same order as lines. -#' @param title Legend title. -#' @param buffer A buffer, either one value or a vector of 4 values (left, bottom, right, top). -#' @param ... Other arguments to pass to each shape in `tmap::tm_lines()`. -#' -#' @return A tmap layer. -#' @export -#' -add_admin_boundaries <- function(lines, colors, labels, lwds, title = "", buffer = NULL, ...){ - - - #------ Package check - - rlang::check_installed("tmap", reason = "Package \"tmap\" needed for `add_admin_boundaries()` to work. Please install it.") - - - #------ Check that the length of vectors is identical between arguments - - if(!inherits(lines, "list")) rlang::abort("Please provide a list for lines.") - - ll <- list(lines, colors, labels, lwds) - if (!all(sapply(ll,length) == length(ll[[1]]))) rlang::abort("lines, colors, labels, lwds do not all have the same length.") - - - #------ Make valid - - lines <- lapply(lines, \(x) sf::st_make_valid(x)) - - - #------ Prepare legend - legend_lines <- tmap::tm_add_legend("line", - title = title, - col = colors, - lwd = lwds, - labels = labels) - - - #------ Let's go with all line shapes - - if(!is.null(buffer)){ buffer <- buffer_bbox(lines[[1]], buffer) } else { buffer <- NULL } - - - layers <- tmap::tm_shape(lines[[1]], bbox = buffer) + - tmap::tm_lines(lwd = lwds[[1]], col = colors[[1]], ...) - - if (length(lines) == 1) { - - layers <- layers + legend_lines - - return(layers) - - } else { - - for(i in 2:length(lines)){ - - layers <- layers + tmap::tm_shape(shp = lines[[i]]) + tmap::tm_lines(lwd = lwds[[i]], col = colors[[i]], ...) - } - - layers <- layers + legend_lines - - return(layers) - - } -} - - - - -#' Basic defaults based on `tmap::tm_layout()` -#' -#' @param title Map title. -#' @param legend_position Legend position. Not above the map is a good start. -#' @param frame Boolean. Legend frame? -#' @param legend_frame Legend frame color. -#' @param legend_text_size Legend text size in 'pt'. -#' @param legend_title_size Legend title size in 'pt'. -#' @param title_size Title text size in 'pt'. -#' @param title_fontface Title fontface. Bold if you wanna exemplify a lot what it is about. -#' @param title_color Title font color. -#' @param fontfamily Overall fontfamily. Leelawadee is your precious. -#' @param ... Other arguments to pass to `tmap::tm_layout()`. -#' -#' @return A tmap layer. -#' @export -#' -add_layout <- function( - title = NULL, - legend_position = c(0.02, 0.5), - frame = FALSE, - legend_frame = cols_reach("main_grey"), - legend_text_size = 0.6, - legend_title_size = 0.8, - title_size = 0.9, - title_fontface = "bold", - title_color = cols_reach("main_grey"), - # check.and.fix = TRUE, - fontfamily = "Leelawadee", - ...){ - - layout <- tmap::tm_layout( - title = title, - legend.position = legend_position, - legend.frame = legend_frame, - frame = FALSE, - legend.text.size = legend_text_size, - legend.title.size = legend_title_size, - title.size = title_size, - title.fontface = title_fontface, - title.color = title_color, - fontfamily = fontfamily, - ...) - - return(layout) - - } - - - - -#' Wrapper around `tmap::tm_text()` with sane defaults for plotting admin labels. -#' -#' @param point Multipoint shape defined by sf package. -#' @param text Text labels column. -#' @param size Relative size of the text labels. -#' @param fontface Fontface. -#' @param fontfamily Fontfamily. Leelawadee is your precious. -#' @param shadow Boolean. Add a shadow around text labels. Issue opened on Github to request. -#' @param auto_placement Logical that determines whether the labels are placed automatically. -#' @param remove_overlap Logical that determines whether the overlapping labels are removed. -#' @param ... Other arguments to pass to `tmap::tm_text()`. -#' -#' @return A tmap layer. -#' @export -#' -add_admin_labels <- function(point, - text, - size = 0.5, - fontface = "bold", - fontfamily = "Leelawadee", - shadow = TRUE, - auto_placement = FALSE, - remove_overlap = FALSE, - ...){ - - - #------ Restrictive sf checks (might not be necessary depending on the desired behaviour) - - rlang::check_installed("tmap", reason = "Package \"tmap\" needed for `add_indicator_layer()` to work. Please install it.") - - point <- sf::st_make_valid(point) - - #------ Other checks - - text_name <- rlang::as_name(rlang::enquo(text)) - if_not_in_stop(point, text_name, "point", "text") - - #------ Point text layer - - layer <- tmap::tm_shape(point) + - tmap::tm_text(text = text_name, - size = size, - fontface = fontface, - fontfamily = fontfamily, - shadow = shadow, - auto.placement = auto_placement, - remove.overlap = remove_overlap, - ...) - - return(layer) - -} - - - - -#' Add a compass -#' -#' @param text_size Relative font size. -#' @param position Position of the compass. Vector of two values, specifying the x and y coordinates. -#' @param color_dark Color of the dark parts of the compass. -#' @param text_color color of the text. -#' @param type Compass type, one of: "arrow", "4star", "8star", "radar", "rose". -#' @param ... Other arguments to pass to `tmap::tm_compass()`. -#' -#' @return A tmap layer. -#' @export -#' -add_compass <- function(text_size = 0.6, - position = c("right", 0.8), - color_dark = cols_reach("black"), - text_color = cols_reach("black"), - type = "4star", - ...){ - - compass <- tmap::tm_compass( - text.size = text_size, - position = position, - color.dark = color_dark, - type = type, - text.color = text_color - ) - - return(compass) - -} - - - - -#' Add a scale bar -#' -#' @param text_size Relative font size. -#' @param position Position of the compass. Vector of two values, specifying the x and y coordinates. -#' @param color_dark Color of the dark parts of the compass. -#' @param breaks Breaks of the scale bar. If not specified, breaks will be automatically be chosen given the prefered width of the scale bar. Example: c(0, 50, 100). -#' @param ... Other arguments to pass to `tmap::tm_compass()`. -#' -#' @return A tmap layer. -#' @export -#' -add_scale_bar <- function(text_size = 0.6, - position = c("left", 0.01), - color_dark = cols_reach("black"), - breaks = c(0, 50, 100), - ...){ - - scale_bar <- tmap::tm_scale_bar( - text.size = text_size, - position = position, - color.dark = color_dark, - breaks = breaks, - ... - ) - - return(scale_bar) - -} - - - - -#' Do you want to credit someone or some institution? -#' -#' @param text Text. -#' @param size Relative text size. -#' @param bg_color Background color. -#' @param position Position. Vector of two coordinates. Usually somewhere down. -#' @param ... Other arguments to pass to `tmap::tm_credits()`. -#' -#' @return A tmap layer. -#' @export -#' -add_credits <- function(text, size = 0.4, bg_color = NA, position = c(0.75, 0.02), ...){ - - tmap::tm_credits(text, - size = size, - bg.color = bg_color, - position = position, - ...) -} - diff --git a/R/pal_agora.R b/R/pal_agora.R deleted file mode 100644 index 756e9d8..0000000 --- a/R/pal_agora.R +++ /dev/null @@ -1,34 +0,0 @@ -#' @title Return function to interpolate an AGORA color palette -#' -#' @param palette Character name of a palette in AGORA palettes -#' @param reverse Boolean indicating whether the palette should be reversed -#' @param color_ramp_palette Should the output be a `grDevices::colorRampPalette` function or a vector of hex codes? Default to the former with `TRUE` -#' @param show_palettes Should the ouput be the set of palettes names to pick from? Default to `FALSE` -#' @param ... Additional arguments to pass to colorRampPalette() -#' -#' @return A color palette -#' -#' @export -pal_agora <- function(palette = "main", reverse = FALSE, color_ramp_palette = FALSE, show_palettes = FALSE, ...) { - - - palettes_agora <- list( - `main` = cols_agora("main_bordeaux", "main_dk_beige", "main_lt_grey", "main_lt_beige"), - `primary` = cols_agora("main_bordeaux", "main_dk_beige"), - `secondary` = cols_agora( "main_lt_grey", "main_lt_beige") - ) - - if (show_palettes) return(names(palettes_agora)) - - pal <- palettes_agora[[palette]] - - if (reverse) pal <- rev(pal) - - if (color_ramp_palette) { - rlang::check_installed("grDevices", reason = "Package \"grDevices\" needed for `pal_agora()` woth 'color_ramp_palette' set to `TRUE` to work. Please install it.") - - pal <- grDevices::colorRampPalette(pal, ...) - } - - return(pal) -} diff --git a/R/pal_fallback.R b/R/pal_fallback.R deleted file mode 100644 index 0fb7b23..0000000 --- a/R/pal_fallback.R +++ /dev/null @@ -1,30 +0,0 @@ -#' @title Return function to interpolate a fallback palette base on viridis::magma() -#' -#' @param reverse Boolean indicating whether the palette should be reversed -#' @param color_ramp_palette Should the output be a `grDevices::colorRampPalette` function or a vector of hex codes? Default to the latter with `FALSE` -#' @param discrete Boolean. Discrete or not? Default to FALSE. -#' @param n Number of colors in the palette. Default to 5. Passe to `viridis::magma()` -#' @param ... Other parameters to pass to `grDevices::colorRampPalette()` -#' -#' @return A color palette -#' -#' @export -pal_fallback <- function(reverse = FALSE, - color_ramp_palette = FALSE, - discrete = FALSE, - n = 5, - ...){ - - pal <- if(discrete) { viridisLite::viridis(n) } else {viridisLite::magma(n)} - - if (reverse) pal <- rev(pal) - - if (color_ramp_palette) { - rlang::check_installed("grDevices", reason = "Package \"grDevices\" needed for `pal_fallback()` with 'color_ramp_palette' set to `TRUE` to work. Please install it.") - - pal <- grDevices::colorRampPalette(pal, ...) - } - - return(pal) - -} diff --git a/R/pal_impact.R b/R/pal_impact.R deleted file mode 100644 index ff9b561..0000000 --- a/R/pal_impact.R +++ /dev/null @@ -1,34 +0,0 @@ -#' @title Return function to interpolate an IMPACT color palette -#' -#' @param palette Character name of a palette in IMPACT palettes -#' @param reverse Boolean indicating whether the palette should be reversed -#' @param color_ramp_palette Should the output be a `grDevices::colorRampPalette` function or a vector of hex codes? Default to the former with `TRUE` -#' @param show_palettes Should the ouput be the set of palettes names to pick from? Default to `FALSE` -#' @param ... Additional arguments to pass to colorRampPalette() -#' -#' @return A color palette -#' -#' @export -pal_impact <- function(palette = "main", reverse = FALSE, color_ramp_palette = FALSE, show_palettes = FALSE, ...) { - - - palettes_impact <- list( - `main` = cols_impact("black", "white", "main_blue", "main_grey"), - `primary` = cols_impact("black", "white"), - `secondary` = cols_impact("main_blue", "main_grey") - ) - - if (show_palettes) return(names(palettes_impact)) - - pal <- palettes_impact[[palette]] - - if (reverse) pal <- rev(pal) - - if (color_ramp_palette) { - rlang::check_installed("grDevices", reason = "Package \"grDevices\" needed for `pal_impact()` woth 'color_ramp_palette' set to `TRUE` to work. Please install it.") - - pal <- grDevices::colorRampPalette(pal, ...) - } - - return(pal) -} diff --git a/R/pal_reach.R b/R/pal_reach.R deleted file mode 100644 index 7472c08..0000000 --- a/R/pal_reach.R +++ /dev/null @@ -1,66 +0,0 @@ -#' @title Return function to interpolate a REACH color palette -#' -#' @param palette Character name of a palette in REACH palettes -#' @param reverse Boolean indicating whether the palette should be reversed -#' @param color_ramp_palette Should the output be a `grDevices::colorRampPalette` function or a vector of hex codes? Default to the former with `TRUE` -#' @param show_palettes Should the ouput be the set of palettes names to pick from? Default to `FALSE` -#' @param ... Additional arguments to pass to colorRampPalette() -#' -#' @return A color palette -#' -#' @export -pal_reach <- function(palette = "main", reverse = FALSE, color_ramp_palette = FALSE, show_palettes = FALSE, ...) { - - palettes_reach <- list( - `main` = cols_reach("main_grey", "main_red", "main_lt_grey", "main_beige"), - `primary` = cols_reach("main_grey", "main_red"), - `secondary` = cols_reach("main_lt_grey", "main_beige"), - `two_dots` = cols_reach("two_dots_1", "two_dots_2"), - `two_dots_flashy` = cols_reach("two_dots_flashy_1", "two_dots_flashy_2"), - `red_main` = cols_reach("red_main_1", "red_main_2", "red_main_3", "red_main_4", "red_main_5"), - `red_main_5` = cols_reach("red_main_1", "red_main_2", "red_main_3", "red_main_4", "red_main_5"), - `red_alt` = cols_reach("red_alt_1", "red_alt_2", "red_alt_3", "red_alt_4", "red_alt_5"), - `red_alt_5` = cols_reach("red_alt_1", "red_alt_2", "red_alt_3", "red_alt_4", "red_alt_5"), - `iroise` = cols_reach("iroise_1", "iroise_2", "iroise_3", "iroise_4", "iroise_5"), - `iroise_5` = cols_reach("iroise_1", "iroise_2", "iroise_3", "iroise_4", "iroise_5"), - `discrete_6` = cols_reach("dk_grey", "red_main_1", "main_beige", "red_main_2", "lt_grey_2", "red_4"), - `red_2` = cols_reach("red_less_4_1", "red_less_4_3"), - `red_3` = cols_reach("red_less_4_1", "red_less_4_2", "red_less_4_3"), - `red_4` = cols_reach("red_less_4_1", "red_less_4_2", "red_less_4_3", "red_less_4_4"), - `red_5` = cols_reach("red_5_1", "red_5_2", "red_5_3", "red_5_4", "red_5_5"), - `red_6` = cols_reach("red_less_7_1", "red_less_2", "red_less_7_3", "red_less_7_4", "red_less_7_5", "red_less_7_6"), - `red_7` = cols_reach("red_less_7_1", "red_less_7_2", "red_less_7_3", "red_less_7_4", "red_less_7_5", "red_less_7_6", "red_less_7_7"), - `green_2` = cols_reach("green_2_1", "green_2_2"), - `green_3` = cols_reach("green_3_1", "green_3_2", "green_3_3"), - `green_4` = cols_reach("green_4_1", "green_4_2", "green_4_3", "green_4_4"), - `green_5` = cols_reach("green_5_1", "green_5_2", "green_5_3", "green_5_4", "green_5_5"), - `green_6` = cols_reach("green_6_1", "green_6_2", "green_6_3", "green_6_4", "green_6_5", "green_6_6"), - `green_7` = cols_reach("green_7_1", "green_7_2", "green_7_3", "green_7_4", "green_7_5", "green_7_6", "green_7_7"), - `artichoke_2` = cols_reach("artichoke_2_1", "artichoke_2_2"), - `artichoke_3` = cols_reach("artichoke_3_1", "artichoke_3_2", "artichoke_3_3"), - `artichoke_4` = cols_reach("artichoke_4_1", "artichoke_4_2", "artichoke_4_3", "artichoke_4_4"), - `artichoke_5` = cols_reach("artichoke_5_1", "artichoke_5_2", "artichoke_5_3", "artichoke_5_4", "artichoke_5_5"), - `artichoke_6` = cols_reach("artichoke_6_1", "artichoke_6_2", "artichoke_6_3", "artichoke_6_4", "artichoke_6_5", "artichoke_6_6"), - `artichoke_7` = cols_reach("artichoke_7_1", "artichoke_7_2", "artichoke_7_3", "artichoke_7_4", "artichoke_7_5", "artichoke_7_6", "artichoke_7_7"), - `blue_2` = cols_reach("blue_2_1", "blue_2_2"), - `blue_3` = cols_reach("blue_3_1", "blue_3_2", "blue_3_3"), - `blue_4` = cols_reach("blue_4_1", "blue_4_2", "blue_4_3", "blue_4_4"), - `blue_5` = cols_reach("blue_5_1", "blue_5_2", "blue_5_3", "blue_5_4", "blue_5_5"), - `blue_6` = cols_reach("blue_6_1", "blue_6_2", "blue_6_3", "blue_6_4", "blue_6_5", "blue_6_6"), - `blue_7` = cols_reach("blue_7_1", "blue_7_2", "blue_7_3", "blue_7_4", "blue_7_5", "blue_7_6", "blue_7_7") - ) - - if (show_palettes) return(names(palettes_reach)) - - pal <- palettes_reach[[palette]] - - if (reverse) pal <- rev(pal) - - if (color_ramp_palette) { - rlang::check_installed("grDevices", reason = "Package \"grDevices\" needed for `pal_reach()` with 'color_ramp_palette' set to `TRUE` to work. Please install it.") - - pal <- grDevices::colorRampPalette(pal, ...) - } - - return(pal) -} diff --git a/R/palette.R b/R/palette.R new file mode 100644 index 0000000..e92ca25 --- /dev/null +++ b/R/palette.R @@ -0,0 +1,66 @@ +#' @title Interpolate a color palette +#' +#' @param palette Character name of a palette in palettes +#' @param reverse Boolean indicating whether the palette should be reversed +#' @param show_palettes Should the ouput be the set of palettes names to pick from? Default to `FALSE` +#' @param ... Additional arguments to pass to colorRampPalette() +#' +#' @return A color palette +#' +#' @export +palette <- function(palette = "cat_5_main", reverse = FALSE, show_palettes = FALSE, ...) { + + #------ Checks + + # Check that palette is a character scalar + checkmate::assert_character(palette, len = 1) + + # Check that reverse is a logical scalar + checkmate::assert_logical(reverse, len = 1) + + # Check that show_palettes is a logical scalar + checkmate::assert_logical(show_palettes, len = 1) + + #------ Get colors + + # Define palettes + pals <- list( + cat_2_yellow = color_pattern("cat_2_yellow") + , cat_2_light = color_pattern("cat_2_light") + , cat_2_green = color_pattern("cat_2_green") + , cat_2_blue = color_pattern("cat_2_blue") + , cat_5_main = color_pattern("cat_5_main") + , cat_5_ibm = color_pattern("cat_5_ibm") + , cat_3_aquamarine = color_pattern("cat_3_aquamarine") + , cat_3_tol_high_contrast = color_pattern("cat_3_tol_high_contrast") + , cat_8_tol_adapted = color_pattern("cat_8_tol_adapted") + , cat_3_custom_1 = c("#003F5C", "#58508D", "#FFA600") + , cat_4_custom_1 = c("#003F5C", "#7a5195", "#ef5675", "#ffa600") + , cat_5_custom_1 = c("#003F5C", "#58508d", "#bc5090", "#ff6361", "#ffa600") + , cat_6_custom_1 = c("#003F5C", "#444e86", "#955196", "#dd5182", "#ff6e54", "#ffa600") + , div_5_orange_blue = color_pattern("div_5_orange_blue") + , div_5_green_purple = color_pattern("div_5_green_purple") + ) + + # Return if show palettes + if (show_palettes) { + return(names(pals)) + } + + # palette is in pals + if (palette %notin% names(pals)) { + rlang::abort(c( + "Palette not defined", + "*" = glue::glue("Palette `{palette}` is not defined in the `palettes` list."), + "i" = "Use `palette(show_palettes = TRUE)` to see all available palettes." + )) + } + + #------ Get palette + + pal <- pals[[palette]] + + if (reverse) pal <- rev(pal) + + return(pal) +} diff --git a/R/palette_gen.R b/R/palette_gen.R new file mode 100644 index 0000000..28870e2 --- /dev/null +++ b/R/palette_gen.R @@ -0,0 +1,61 @@ +#' Generate color palettes +#' +#' [palette_gen()] generates a color palette and let you choose whether continuous or discrete. [palette_gen_categorical()] and [palette_gen_sequential()] generates respectively discrete and continuous palettes. +#' +#' @param palette Palette name from [palette()]. +#' @param type "categorical" or "sequential" or "divergent". +#' @param direction 1 or -1; should the order of colors be reversed? +#' @param ... Additional arguments to pass to [colorRampPalette()] when type is "continuous". +#' +#' @export +palette_gen <- function(palette, type, direction = 1, ...) { + + if (type %notin% c("categorical", "sequential", "divergent")) rlang::abort("'type' must be categorical or continuous or divergent.") + + if (type == "categorical") { + return(palette_gen_categorical(palette = palette, direction = direction)) + } + + if (type %in% c("sequential", "divergent")) { + return(palette_gen_sequential(palette = palette, direction = direction, ...)) + } +} + + +#' @rdname palette_gen +#' +#' @export +palette_gen_categorical <- function(palette = "cat_5_main", direction = 1) { + + if (abs(direction) != 1) rlang::abort("Direction must be either 1 or -1.") + + pal <- palette(palette) + + f <- function(n) { + if (is.null(n)) n <- length(pal) + + if (n > length(pal)) rlang::warn("Not enough colors in this palette!") + + pal <- if (direction == 1) pal else rev(pal) + + pal <- pal[1:n] + + return(pal) + } + + return(f) +} + +#' @rdname palette_gen +#' +#' @export +palette_gen_sequential <- function(palette = "seq_5_main", direction = 1, ...) { + + if (abs(direction) != 1) rlang::abort("Direction must be either 1 or -1.") + + pal <- palette(palette) + + pal <- if (direction == 1) pal else rev(pal) + + grDevices::colorRampPalette(pal, ...) +} diff --git a/R/point.R b/R/point.R index 9dae4bf..1d4d980 100644 --- a/R/point.R +++ b/R/point.R @@ -2,8 +2,9 @@ #' #' @param df A data frame. #' @param x A numeric column. -#' @param y A character column or coercible as a character column. +#' @param y Another numeric column. #' @param group Some grouping categorical column, e.g. administrative areas or population groups. +#' @param add_color Add a color to bars (if no grouping). #' @param flip TRUE or FALSE. Default to TRUE or horizontal bar plot. #' @param alpha Fill transparency. #' @param size Point size. @@ -13,28 +14,38 @@ #' @param title Plot title. Default to NULL. #' @param subtitle Plot subtitle. Default to NULL. #' @param caption Plot caption. Default to NULL. -#' @param theme Whatever theme. Default to theme_reach(). +#' @param theme_fun Whatever theme. Default to theme_reach(). NULL if no theming needed. +#' @param scale_impact Use the package custom scales for fill and color. #' -#' @return A bar chart +#' @inheritParams scale_color_impact_discrete #' #' @export -point <- function(df, x, y, group = NULL, flip = TRUE, alpha = 1, size = 1, x_title = NULL, y_title = NULL, group_title = NULL, title = NULL, subtitle = NULL, caption = NULL, theme = theme_reach()){ - - # To do : - # - automate bar width and text size, or at least give the flexibility and still center text - # - add facet possibility - - # Prepare group, x and y names - # if (is.null(x_title)) x_title <- rlang::as_name(rlang::enquo(x)) - # if (is.null(y_title)) y_title <- rlang::as_name(rlang::enquo(y)) - # if (is.null(group_title)) group_title <- rlang::as_name(rlang::enquo(group)) +point <- function(df, x, y, group = "", add_color = color("branding_reach_red"), flip = TRUE, alpha = 1, size = 2, x_title = NULL, y_title = NULL, group_title = NULL, title = NULL, subtitle = NULL, caption = NULL, theme_fun = theme_reach(grid_major_y = TRUE), palette = "cat_5_ibm", scale_impact = TRUE, direction = 1, reverse_guide = TRUE) { + # # Check if numeric and character + if (!any(c("numeric", "integer") %in% class(df[[x]]))) rlang::abort(paste0(x, " must be numeric.")) + if (!any(c("numeric", "integer") %in% class(df[[y]]))) rlang::abort(paste0(x, " must be numeric.")) # Mapping - g <- ggplot2::ggplot( - df, - mapping = ggplot2::aes(x = {{ x }}, y = {{ y }}, fill = {{ group }}, color = {{ group }} + if (group != "") { + g <- ggplot2::ggplot( + df, + mapping = ggplot2::aes( + x = !!rlang::sym(x), + y = !!rlang::sym(y), + fill = !!rlang::sym(group), + color = !!rlang::sym(group) + ) ) - ) + } else { + g <- ggplot2::ggplot( + df, + mapping = ggplot2::aes( + x = !!rlang::sym(x), + y = !!rlang::sym(y) + ) + ) + } + # Add title, subtitle, caption, x_title, y_title g <- g + ggplot2::labs( @@ -47,35 +58,33 @@ point <- function(df, x, y, group = NULL, flip = TRUE, alpha = 1, size = 1, x_ti fill = group_title ) - width <- 0.5 - dodge_width <- 0.5 - # Should the graph use position_fill? - g <- g + ggplot2::geom_point( + if (group != "") { + g <- g + ggplot2::geom_point( alpha = alpha, size = size ) + } else { + g <- g + ggplot2::geom_point( + alpha = alpha, + size = size, + color = add_color + ) + } - # Labels to percent and expand scale - # if (percent) { - # g <- g + ggplot2::scale_y_continuous( - # labels = scales::label_percent( - # accuracy = 1, - # decimal.mark = ",", - # suffix = " %"), - # expand = c(0.01, 0.1) - # ) - # } else { - # g <- g + ggplot2::scale_y_continuous(expand = c(0.01, 0.1)) - # } - - # # Because a text legend should always be horizontal, especially for an horizontal bar graph - if (flip){ + if (flip) { g <- g + ggplot2::coord_flip() } # Add theme - g <- g + theme + g <- g + theme_fun + + + # Add theme + if (!is.null(theme_fun)) g <- g + theme_fun + + # Add scale + if (scale_impact) g <- g + scale_fill_impact_discrete(palette, direction, reverse_guide) + scale_color_impact_discrete(palette, direction, reverse_guide) return(g) } diff --git a/R/scale.R b/R/scale.R index b1a8ccd..bc82655 100644 --- a/R/scale.R +++ b/R/scale.R @@ -1,248 +1,187 @@ -#' Color scale constructor for REACH or AGORA colors + +#' One scale for all +#' +#' This function is based on [palette()]. If palette is NULL, the used palette will be magma from gpplot2's viridis scale constructors. +#' +#' @inheritParams palette_gen #' -#' @param initiative Either "reach" or "agora" or "default". -#' @param palette Palette name from `pal_reach()` or `pal_agora()`. -#' @param discrete Boolean indicating whether color aesthetic is discrete or not. -#' @param reverse Boolean indicating whether the palette should be reversed. #' @param reverse_guide Boolean indicating whether the guide should be reversed. -#' @param ... Additional arguments passed to discrete_scale() or -#' scale_fill_gradient(), used respectively when discrete is TRUE or FALSE. -#' -#' @return A color scale for ggplot +#' @param ... Additional arguments passed to [ggplot2::discrete_scale()] if discrete or [ggplot2::scale_fill_gradient()] if continuous. #' #' @export -scale_color <- function(initiative = "reach", palette = "main", discrete = TRUE, reverse = FALSE, reverse_guide = TRUE, ...) { +scale_visualizer_discrete <- function(palette = "cat_5_main", direction = 1, reverse_guide = TRUE, ...) { - if (initiative == "reach") { + s <- scale_color_visualizer_discrete(palette, direction, reverse_guide, ...) + + scale_fill_visualizer_discrete(palette, direction, reverse_guide, ...) - pal <- pal_reach(palette) + return(s) - if (is.null(pal)) { +} - pal <- pal_fallback( - reverse = reverse, - discrete = discrete, - color_ramp_palette = TRUE) +#' @rdname scale_visualizer_dicscrete +#' +#' @export +scale_visualizer_continuous <- function(palette = "seq_5_main", direction = 1, reverse_guide = TRUE, ...) { - rlang::warn( - c( - paste0("There is no palette '", palette, "' for the selected initiative. Fallback to pal_fallback()."), - "i" = paste0("Use `pal_reach(show_palettes = TRUE)` to see the list of available palettes.") - ) - ) + s <- scale_color_visualizer_continuous(palette, direction, reverse_guide, ...) + + scale_fill_visualizer_continuous(palette, direction, reverse_guide, ...) - if (discrete) palette <- "viridis" else palette <- "magma" + return(s) - } else { +} - pal <- pal_reach( - palette = palette, - reverse = reverse, - color_ramp_palette = TRUE, - show_palettes = FALSE - ) +#' Scale constructors for fill and colors +#' +#' This function is based on [palette()]. If palette is NULL, the used palette will be magma from gpplot2's viridis scale constructors. +#' +#' @inheritParams palette_gen +#' +#' @param reverse_guide Boolean indicating whether the guide should be reversed. +#' @param ... Additional arguments passed to [ggplot2::discrete_scale()] if discrete or [ggplot2::scale_fill_gradient()] if continuous. +#' +#' @export +scale_color_visualizer_discrete <- function(palette = "cat_5_main", direction = 1, reverse_guide = TRUE, ...) { - } - - } else if (initiative == "agora") { - - pal <- pal_agora(palette) - - if (is.null(pal)) { - - pal <- pal_fallback( - reverse = reverse, - discrete = discrete, - color_ramp_palette = TRUE) - - rlang::warn( - c( - paste0("There is no palette '", palette, "' for the selected initiative. Fallback to pal_fallback()."), - "i" = paste0("Use `pal_reach(show_palettes = TRUE)` to see the list of available palettes.") - ) - ) - - if (discrete) palette <- "viridis" else palette <- "magma" - - } else { - - pal <- pal_agora( - palette = palette, - reverse = reverse, - color_ramp_palette = TRUE, - show_palettes = FALSE - ) - } - - } else if (initiative == "default") { - - pal <- pal_fallback( - reverse = reverse, - discrete = discrete, - color_ramp_palette = TRUE) - - if (discrete) palette <- "viridis" else palette <- "magma" - - } else { - rlang::abort( - c( - paste0("There is no initiative '", initiative, "."), - "i" = paste0("initiative should be either 'reach', 'agora' or 'default'") - ) - ) - } - - if (discrete) { + if (!(is.null(palette))) { ggplot2::discrete_scale( - "colour", - paste0(initiative, "_", palette), - palette = pal, + "color", + palette = palette_gen(palette, "categorical", direction), guide = ggplot2::guide_legend( title.position = "top", draw.ulim = TRUE, draw.llim = TRUE, - ticks.colour = "#F1F3F5", + # ticks.colour = "#F1F3F5", reverse = reverse_guide ), ... ) } else { - ggplot2::scale_color_gradientn( - colours = pal(256), - guide = ggplot2::guide_colorbar( + + ggplot2::scale_colour_viridis_d( + direction = direction, + guide = ggplot2::guide_legend( title.position = "top", draw.ulim = TRUE, draw.llim = TRUE, - ticks.colour = "#F1F3F5", + # ticks.colour = "#F1F3F5", reverse = reverse_guide ), ... ) + } + } - - -#' Fill scale constructor for REACH or AGORA colors -#' -#' @param initiative Either "reach" or "agora" or "default". -#' @param palette Palette name from `pal_reach()` or `pal_agora()`. -#' @param discrete Boolean indicating whether color aesthetic is discrete or not. -#' @param reverse Boolean indicating whether the palette should be reversed. -#' @param reverse_guide Boolean indicating whether the guide should be reversed. -#' @param ... Additional arguments passed to discrete_scale() or -#' scale_fill_gradient(), used respectively when discrete is TRUE or FALSE. -#' -#' @return A fill scale for ggplot. +#' @rdname scale_color_visualizer_discrete #' #' @export -scale_fill <- function(initiative = "reach", palette = "main", discrete = TRUE, reverse = FALSE, reverse_guide = TRUE, ...) { +scale_fill_visualizer_discrete <- function(palette = "cat_5_main", direction = 1, reverse_guide = TRUE, ...) { + if (!(is.null(palette))) { - if (initiative == "reach") { - - pal <- pal_reach(palette) - - if (is.null(pal)) { - - pal <- pal_fallback( - reverse = reverse, - discrete = discrete, - color_ramp_palette = TRUE) - - rlang::warn( - c( - paste0("There is no palette '", palette, "' for the selected initiative. Fallback to pal_fallback()."), - "i" = paste0("Use `pal_reach(show_palettes = TRUE)` to see the list of available palettes.") - ) - ) - - if (discrete) palette <- "viridis" else palette <- "magma" - - } else { - - pal <- pal_reach( - palette = palette, - reverse = reverse, - color_ramp_palette = TRUE, - show_palettes = FALSE - ) - - } - - } else if (initiative == "agora") { - - pal <- pal_agora(palette) - - if (is.null(pal)) { - - pal <- pal_fallback( - reverse = reverse, - discrete = discrete, - color_ramp_palette = TRUE) - - rlang::warn( - c( - paste0("There is no palette '", palette, "' for the selected initiative. Fallback to pal_fallback()."), - "i" = paste0("Use `pal_reach(show_palettes = TRUE)` to see the list of available palettes.") - ) - ) - - if (discrete) palette <- "viridis" else palette <- "magma" - - } else { - - pal <- pal_agora( - palette = palette, - reverse = reverse, - color_ramp_palette = TRUE, - show_palettes = FALSE - ) - } - - } else if (initiative == "default") { - - pal <- pal_fallback( - reverse = reverse, - discrete = discrete, - color_ramp_palette = TRUE) - - if (discrete) palette <- "viridis" else palette <- "magma" - - } else { - rlang::abort( - c( - paste0("There is no initiative '", initiative, "."), - "i" = paste0("initiative should be either 'reach', 'agora' or 'default'") - ) - ) - } - - if (discrete) { ggplot2::discrete_scale( "fill", - paste0(initiative, "_", palette), - palette = pal, + palette = palette_gen(palette, "categorical", direction), guide = ggplot2::guide_legend( title.position = "top", draw.ulim = TRUE, draw.llim = TRUE, - ticks.colour = "#F1F3F5", + # ticks.colour = "#F1F3F5", reverse = reverse_guide ), ... ) } else { - ggplot2::scale_color_gradientn( - colours = pal(256), - guide = ggplot2::guide_colorbar( + + ggplot2::scale_fill_viridis_d( + direction = direction, + guide = ggplot2::guide_legend( title.position = "top", draw.ulim = TRUE, draw.llim = TRUE, - ticks.colour = "#F1F3F5", + # ticks.colour = "#F1F3F5", reverse = reverse_guide ), ... ) + } + } + +#' @rdname scale_color_visualizer_discrete +#' +#' @export +scale_fill_visualizer_continuous <- function(palette = "seq_5_main", direction = 1, reverse_guide = TRUE, ...) { + + if (!(is.null(palette))) { + + pal <- palette_gen(palette, "continuous", direction) + + ggplot2::scale_fill_gradientn( + colors = pal(256), + guide = ggplot2::guide_colorbar( + title.position = "top", + draw.ulim = TRUE, + draw.llim = TRUE, + # ticks.colour = "#F1F3F5", + reverse = reverse_guide + ), + ... + ) + + } else { + + ggplot2::scale_fill_viridis_c( + option = "magma", + guide = ggplot2::guide_colorbar( + title.position = "top", + draw.ulim = TRUE, + draw.llim = TRUE, + # ticks.colour = "#F1F3F5", + reverse = reverse_guide + ), + ...) + + } + +} + +#' @rdname scale_color_visualizer_discrete +#' +#' @export +scale_color_visualizer_continuous <- function(palette = "seq_5_main", direction = 1, reverse_guide = TRUE, ...) { + + if (!(is.null(palette))) { + + pal <- palette_gen(palette, "continuous", direction) + + ggplot2::scale_fill_gradientn( + colors = pal(256), + guide = ggplot2::guide_colorbar( + title.position = "top", + draw.ulim = TRUE, + draw.llim = TRUE, + # ticks.colour = "#F1F3F5", + reverse = reverse_guide + ), + ... + ) + + } else { + + ggplot2::scale_colour_viridis_c( + option = "magma", + guide = ggplot2::guide_colorbar( + title.position = "top", + draw.ulim = TRUE, + draw.llim = TRUE, + # ticks.colour = "#F1F3F5", + reverse = reverse_guide + ), + ....) + + } + +} \ No newline at end of file diff --git a/R/test-example.R b/R/test-example.R new file mode 100644 index 0000000..c9f807e --- /dev/null +++ b/R/test-example.R @@ -0,0 +1,22 @@ +dat <- data.frame( + x = c(15, 34, 59, 21, 33, 66), + y = c("Admin A", "Admin B", "Admin C", "Admin C", "Admin B", "Admin A"), + group = c("Displaced", "Non displaced", "Non displaced", "Displaced", "Displaced", "Non displaced") +) + +dat |> + bar( + x = "y", + y = "x", + group = "group", + flip = F, + add_text = F, + title = "In Admin A and C, Non-Displaced Persons Face Greater WASH Challenges Than Their Displaced Counterparts", + subtitle = "% of households not accessing WASH services by admin 1 and status", + caption = "Source: FAO 2022. No message is a real one. Fake data are used in this example. As a cautiom, no decision should be made based on this plot.", + ) + + theme_visualizer_bar() + + scale_color_visualizer_discrete() + + scale_fill_visualizer_discrete() + + diff --git a/R/theme.R b/R/theme.R new file mode 100644 index 0000000..713b5ec --- /dev/null +++ b/R/theme.R @@ -0,0 +1,385 @@ +#' ggplot2 theme for bar charts with sane defaults +#' +#' @rdname theme_visualizer +#' @inheritParams theme_visualizer +#' +#' @export +theme_visualizer_bar <- function(...) { + + theme_visualizer_default( + grid_major_y = TRUE + , axis_line_y = FALSE + , axis_ticks_y = FALSE + , grid_major_x = FALSE + , ... + ) + +} + + +#' ggplot2 theme wrapper with fonts and colors +#' +#' @param font_family The font family for all plot's texts. Default to "Segoe UI". +#' @param title_size The size of the title. Defaults to 12. +#' @param title_color Title color. +#' @param title_font_face Title font face. Default to "bold". Font face ("plain", "italic", "bold", "bold.italic"). +#' @param title_hjust Title horizontal justification. Default to NULL. Use 0.5 to center the title. +#' @param title_font_family Title font family. Default to "Roboto Condensed". +#' @param text_size The size of all text other than the title, subtitle and caption. Defaults to 10. +#' @param text_color Text color. +#' @param text_font_face Text font face. Default to "bold". Font face ("plain", "italic", "bold", "bold.italic"). +#' @param panel_background_color The color for the panel background color. Default to white. +#' @param panel_border Boolean. Plot a panel border? Default to FALSE. +#' @param panel_border_color A color. Default to REACH main grey. +#' @param legend_position Position of the legend; Default to "right". Can take "right", "left", "top", "bottom" or "none". +#' @param legend_direction Direction of the legend. Default to "vertical". Can take "vertical" or "horizontal". +#' @param legend_justification In addition to legend_direction, place the legend. Can take "left", "bottom", "center", "right", "top". +#' @param legend_title_size Legend title size. +#' @param legend_title_color Legend title color. +#' @param legend_title_font_face Legend title font face. Default to "plain". Font face ("plain", "italic", "bold", "bold.italic"). +#' @param legend_text_size Legend text size. +#' @param legend_text_color Legend text color. +#' @param legend_text_font_face Legend text font face. Default to "plain". Font face ("plain", "italic", "bold", "bold.italic"). +#' @param legend_reverse Reverse the color in the guide? Default to TRUE. +#' @param title_size The size of the legend title. Defaults to 11. +#' @param title_color Legend title color. +#' @param title_font_face Legend title font face. Default to "plain". Font face ("plain", "italic", "bold", "bold.italic"). +#' @param title_position_to_plot TRUE or FALSE. Positioning to plot or to panel? +#' @param axis_x Boolean. Do you need x-axis? +#' @param axis_y Boolean. Do you need y-axis? +#' @param axis_text_size Axis text size. +#' @param axis_text_color Axis text color. +#' @param axis_text_font_face Axis text font face. Default to "plain". Font face ("plain", "italic", "bold", "bold.italic"). +#' @param axis_text_x Boolean. Do you need the text for the x-axis? +#' @param axis_line_x Boolean. Do you need the line for the x-axis? +#' @param axis_ticks_x Boolean. Do you need the line for the x-axis? +#' @param axis_text_x_angle Angle for the x-axis text. +#' @param axis_text_x_vjust Vertical adjustment for the x-axis text. +#' @param axis_text_x_hjust Vertical adjustment for the x-axis text. +#' @param axis_text_y Boolean. Do you need the text for the y-axis? +#' @param axis_line_y Boolean. Do you need the line for the y-axis? +#' @param axis_ticks_y Boolean. Do you need the line for the y-axis? +#' @param axis_title_size Axis title size. +#' @param axis_title_color Axis title color. +#' @param axis_title_font_face Axis title font face. Default to "plain". Font face ("plain", "italic", "bold", "bold.italic"). +#' @param grid_major_x Boolean. Do you need major grid lines for x-axis? +#' @param grid_major_y Boolean. Do you need major grid lines for y-axis? +#' @param grid_major_x_size Major X line size. +#' @param grid_major_y_size Major Y line size. +#' @param grid_major_color Major grid lines color. +#' @param grid_minor_x Boolean. Do you need minor grid lines for x-axis? +#' @param grid_minor_y Boolean. Do you need minor grid lines for y-axis? +#' @param grid_minor_x_size Minor X line size. +#' @param grid_minor_y_size Minor Y line size. +#' @param grid_minor_color Minor grid lines color. +#' @param caption_position_to_plot TRUE or FALSE. Positioning to plot or to panel? +#' @param ... Additional arguments passed to [ggplot2::theme()]. +#' +#' +#' @description Give some reach colors and fonts to a ggplot. +#' +#' @export +theme_visualizer_default <- function( + font_family = "Carlito", + title_size = 14, + title_color = color("dark_grey"), + title_font_face = "bold", + title_hjust = NULL, + title_position_to_plot = TRUE, + title_font_family = "Carlito", + subtitle_size = 13, + subtitle_font_face = "plain", + subtitle_font_family = "Carlito", + text_size = 12, + text_color = color("dark_grey"), + text_font_face = "plain", + panel_background_color = "#FFFFFF", + panel_border = FALSE, + panel_border_color = color("dark_grey"), + legend_position = "bottom", + legend_direction = "horizontal", + legend_justification = "center", + legend_reverse = TRUE, + legend_title_size = 12, + legend_title_color = color("dark_grey"), + legend_title_font_face = "plain", + legend_text_size = 12, + legend_text_color = color("dark_grey"), + legend_text_font_face = "plain", + axis_x = TRUE, + axis_y = TRUE, + axis_text_x = TRUE, + axis_line_x = TRUE, + axis_ticks_x = TRUE, + axis_text_y = TRUE, + axis_line_y = TRUE, + axis_ticks_y = TRUE, + axis_text_size = 12, + axis_text_color = color("dark_grey"), + axis_text_font_face = "plain", + axis_title_size = 15, + axis_title_color = color("dark_grey"), + axis_title_font_face = "plain", + axis_text_x_angle = 0, + axis_text_x_vjust = 0.5, + axis_text_x_hjust = 0.5, + grid_major_x = TRUE, + grid_major_y = FALSE, + grid_major_color = color("dark_grey"), + grid_major_x_size = 0.1, + grid_major_y_size = 0.1, + grid_minor_x = FALSE, + grid_minor_y = FALSE, + grid_minor_color = color("dark_grey"), + grid_minor_x_size = 0.05, + grid_minor_y_size = 0.05, + caption_position_to_plot = TRUE, + caption_text_size = 10, + caption_text_color = color("dark_grey"), + ...) { + # Basic simple theme + # theme <- ggplot2::theme_bw() + + theme <- ggplot2::theme( + # Title - design + title = ggtext::element_textbox_simple( + family = title_font_family, + color = title_color, + size = title_size, + face = title_font_face + ), + # Text - design + text = ggplot2::element_text( + family = font_family, + color = text_color, + size = text_size, + face = text_font_face + ), + # Default legend to right position + legend.position = legend_position, + # Defaut legend to vertical direction + legend.direction = legend_direction, + # Default legend to left justified + legend.justification = legend_justification, + # set panel background color + panel.background = ggplot2::element_rect( + fill = panel_background_color + ), + # Remove background for legend key + legend.key = ggplot2::element_blank(), + # Text sizes + axis.text = ggplot2::element_text( + size = axis_text_size, + family = font_family, + face = axis_text_font_face, + color = axis_text_color + ), + axis.title = ggplot2::element_text( + size = axis_title_size, + family = font_family, + face = axis_title_font_face, + color = axis_title_color + ), + # Wrap title + plot.title = ggtext::element_textbox_simple( + hjust = title_hjust, + width = grid::unit(0.8, "npc"), + margin = ggplot2::margin(b = 5) + ), + plot.subtitle = ggtext::element_textbox_simple( + hjust = title_hjust, + family = subtitle_font_family, + color = text_color, + size = subtitle_size, + face = subtitle_font_face, + margin = ggplot2::margin(t = 5, b = 5) + ), + plot.caption = ggtext::element_textbox_simple( + size = caption_text_size, + family = font_family, + color = caption_text_color + ), + legend.title = ggplot2::element_text( + size = legend_title_size, + face = legend_title_font_face, + family = font_family, + color = legend_title_color + ), + legend.text = ggplot2::element_text( + size = legend_text_size, + face = legend_text_font_face, + family = font_family, + color = legend_text_color + ), + axis.text.x = ggplot2::element_text( + angle = axis_text_x_angle, + vjust = axis_text_x_vjust, + hjust = axis_text_x_hjust + ) + ) + + # Position of title + if (title_position_to_plot) { + theme <- theme + + ggplot2::theme( + plot.title.position = "plot" + ) + } + + if (caption_position_to_plot) { + theme <- theme + + ggplot2::theme( + plot.caption.position = "plot" + ) + } + # Position of caption + + # Axis lines ? + if (axis_x & axis_y) { + theme <- theme + + ggplot2::theme( + axis.line = ggplot2::element_line(color = text_color) + ) + } + + if (!axis_x) { + theme <- theme + + ggplot2::theme( + axis.line.x = ggplot2::element_blank(), + axis.ticks.x = ggplot2::element_blank(), + axis.text.x = ggplot2::element_blank() + ) + } + + if (!axis_y) { + theme <- theme + + ggplot2::theme( + axis.line.y = ggplot2::element_blank(), + axis.ticks.y = ggplot2::element_blank(), + axis.text.y = ggplot2::element_blank() + ) + } + + if (!axis_line_x) { + theme <- theme + + ggplot2::theme( + axis.line.x = ggplot2::element_blank() + ) + } + + if (!axis_ticks_x) { + theme <- theme + + ggplot2::theme( + axis.ticks.x = ggplot2::element_blank() + ) + } + + if (!axis_text_x) { + theme <- theme + + ggplot2::theme( + axis.text.x = ggplot2::element_blank() + ) + } + + if (!axis_line_y) { + theme <- theme + + ggplot2::theme( + axis.line.y = ggplot2::element_blank() + ) + } + + if (!axis_ticks_y) { + theme <- theme + + ggplot2::theme( + axis.ticks.y = ggplot2::element_blank() + ) + } + + if (!axis_text_y) { + theme <- theme + + ggplot2::theme( + axis.text.y = ggplot2::element_blank() + ) + } + + # X - major grid lines + if (!grid_major_x) { + theme <- theme + + ggplot2::theme( + panel.grid.major.x = ggplot2::element_blank() + ) + } else { + theme <- theme + + ggplot2::theme( + panel.grid.major.x = ggplot2::element_line( + color = grid_major_color, + linewidth = grid_major_x_size + ) + ) + } + + # Y - major grid lines + if (!grid_major_y) { + theme <- theme + + ggplot2::theme( + panel.grid.major.y = ggplot2::element_blank() + ) + } else { + theme <- theme + + ggplot2::theme( + panel.grid.major.y = ggplot2::element_line( + color = grid_major_color, + linewidth = grid_major_y_size + ) + ) + } + + # X - minor grid lines + if (!grid_minor_x) { + theme <- theme + + ggplot2::theme( + panel.grid.minor.x = ggplot2::element_blank() + ) + } else { + theme <- theme + + ggplot2::theme( + panel.grid.minor.x = ggplot2::element_line( + color = grid_minor_color, + linewidth = grid_minor_x_size + ) + ) + } + + # Y - minor grid lines + if (!grid_minor_y) { + theme <- theme + + ggplot2::theme( + panel.grid.minor.y = ggplot2::element_blank() + ) + } else { + theme <- theme + + ggplot2::theme( + panel.grid.minor.y = ggplot2::element_line( + color = grid_minor_color, + linewidth = grid_minor_y_size + ) + ) + } + if (!panel_border) { + theme <- theme + + ggplot2::theme( + panel.border = ggplot2::element_blank() + ) + } else { + theme <- theme + + ggplot2::theme( + panel.border = ggplot2::element_rect(color = panel_background_color) + ) + } + + # Other parameters + theme <- theme + ggplot2::theme(...) + + + return(theme) +} diff --git a/R/theme_reach.R b/R/theme_reach.R deleted file mode 100644 index ac4a3be..0000000 --- a/R/theme_reach.R +++ /dev/null @@ -1,290 +0,0 @@ -#' @title ggplot2 theme with REACH color palettes -#' -#' @param initiative Either "reach" or "default". -#' @param palette Palette name from 'pal_reach()'. -#' @param discrete Boolean indicating whether color aesthetic is discrete or not. -#' @param reverse Boolean indicating whether the palette should be reversed. -#' @param font_family The font family for all plot's texts. Default to "Segoe UI". -#' @param title_size The size of the title. Defaults to 12. -#' @param title_color Title color. -#' @param title_font_face Title font face. Default to "bold". Font face ("plain", "italic", "bold", "bold.italic"). -#' @param title_hjust Title horizontal justification. Default to NULL. Use 0.5 to center the title. -#' @param text_size The size of all text other than the title, subtitle and caption. Defaults to 10. -#' @param text_color Text color. -#' @param text_font_face Text font face. Default to "bold". Font face ("plain", "italic", "bold", "bold.italic"). -#' @param panel_background_color The color for the panel background color. Default to white. -#' @param panel_border Boolean. Plot a panel border? Default to FALSE. -#' @param panel_border_color A color. Default to REACH main grey. -#' @param legend_position Position of the legend; Default to "right". Can take "right", "left", "top", "bottom" or "none". -#' @param legend_direction Direction of the legend. Default to "vertical". Can take "vertical" or "horizontal". -#' @param legend_title_size Legend title size. -#' @param legend_title_color Legend title color. -#' @param legend_title_font_face Legend title font face. Default to "plain". Font face ("plain", "italic", "bold", "bold.italic"). -#' @param legend_text_size Legend text size. -#' @param legend_text_color Legend text color. -#' @param legend_text_font_face Legend text font face. Default to "plain". Font face ("plain", "italic", "bold", "bold.italic"). -#' @param legend_reverse Reverse the color in the guide? Default to TRUE. -#' @param title_size The size of the legend title. Defaults to 11. -#' @param title_color Legend title color. -#' @param title_font_face Legend title font face. Default to "plain". Font face ("plain", "italic", "bold", "bold.italic"). -#' @param title_position_to_plot TRUE or FALSE. Positioning to plot or to panel? -#' @param axis_x Boolean. Do you need x-axis? -#' @param axis_y Boolean. Do you need y-axis? -#' @param axis_text_size Axis text size. -#' @param axis_text_color Axis text color. -#' @param axis_text_font_face Axis text font face. Default to "plain". Font face ("plain", "italic", "bold", "bold.italic"). -#' @param axis_text_x_angle Angle for the x-axis text. -#' @param axis_text_x_vjust Vertical adjustment for the x-axis text. -#' @param axis_text_x_hjust Vertical adjustment for the x-axis text. -#' @param axis_title_size Axis title size. -#' @param axis_title_color Axis title color. -#' @param axis_title_font_face Axis title font face. Default to "plain". Font face ("plain", "italic", "bold", "bold.italic"). -#' @param grid_major_x Boolean. Do you need major grid lines for x-axis? -#' @param grid_major_y Boolean. Do you need major grid lines for y-axis? -#' @param grid_major_x_size Major X line size. -#' @param grid_major_y_size Major Y line size. -#' @param grid_major_color Major grid lines color. -#' @param grid_minor_x Boolean. Do you need minor grid lines for x-axis? -#' @param grid_minor_y Boolean. Do you need minor grid lines for y-axis? -#' @param grid_minor_x_size Minor X line size. -#' @param grid_minor_y_size Minor Y line size. -#' @param grid_minor_color Minor grid lines color. -#' @param caption_position_to_plot TRUE or FALSE. Positioning to plot or to panel? -#' @param ... Additional arguments passed to `ggplot2::gg_theme()`. -#' -#' -#' @description Give some reach colors and fonts to a ggplot. -#' -#' @return The base REACH theme -#' -#' @export -theme_reach <- function( - initiative = "reach", - palette = "main", - discrete = TRUE, - reverse = FALSE, - font_family = "Segoe UI", - title_size = 12, - title_color = cols_reach("main_grey"), - title_font_face = "bold", - title_hjust = NULL, - title_position_to_plot = TRUE, - text_size = 10, - text_color = cols_reach("main_grey"), - text_font_face = "plain", - panel_background_color = "#FFFFFF", - panel_border = FALSE, - panel_border_color = cols_reach("main_grey"), - legend_position = "right", - legend_direction = "vertical", - legend_reverse = TRUE, - legend_title_size = 11, - legend_title_color = cols_reach("main_grey"), - legend_title_font_face = "plain", - legend_text_size = 10, - legend_text_color = cols_reach("main_grey"), - legend_text_font_face = "plain", - axis_x = TRUE, - axis_y = TRUE, - axis_text_size = 10, - axis_text_color = cols_reach("main_grey"), - axis_text_font_face = "plain", - axis_title_size = 11, - axis_title_color = cols_reach("main_grey"), - axis_title_font_face = "bold", - axis_text_x_angle = 0, - axis_text_x_vjust = 0.5, - axis_text_x_hjust = 0.5, - grid_major_x = FALSE, - grid_major_y = FALSE, - grid_major_color = cols_reach("main_lt_grey"), - grid_major_x_size = 0.1, - grid_major_y_size = 0.1, - grid_minor_x = FALSE, - grid_minor_y = FALSE, - grid_minor_color = cols_reach("main_lt_grey"), - grid_minor_x_size = 0.05, - grid_minor_y_size = 0.05, - caption_position_to_plot = TRUE, - ... - ) { - - # To do : - # - add facet theming - - if (!initiative %in% c("reach", "default")) - rlang::abort( - c( - paste0("There is no initiative '", initiative, " to be used with theme_reach()."), - "i" = paste0("initiative should be either 'reach' or 'default'") - ) - ) - - # Basic simple theme - # theme_reach <- ggplot2::theme_bw() - - theme_reach <- ggplot2::theme( - # Title - design - title = ggplot2::element_text( - family = font_family, - color = title_color, - size = title_size, - face = title_font_face - ), - # Text - design - text = ggplot2::element_text( - family = font_family, - color = text_color, - size = text_size, - face = text_font_face - ), - # Default legend to right position - legend.position = legend_position, - # Defaut legend to vertical direction - legend.direction = legend_direction, - # set panel background color - panel.background = ggplot2::element_rect( - fill = panel_background_color - ), - # Remove background for legend key - legend.key = ggplot2::element_blank(), - # Text sizes - axis.text = ggplot2::element_text( - size = axis_text_size, - family = font_family, - face = axis_text_font_face, - color = axis_text_color - ), - axis.title = ggplot2::element_text( - size = axis_title_size, - family = font_family, - face = axis_title_font_face, - color = axis_title_color), - # Wrap title - plot.title = ggtext::element_textbox( - hjust = title_hjust - ), - plot.subtitle = ggtext::element_textbox( - hjust = title_hjust - ), - plot.caption = ggtext::element_textbox(), - legend.title = ggplot2::element_text( - size = legend_title_size, - face = legend_title_font_face, - family = font_family, - color = legend_title_color), - legend.text = ggplot2::element_text( - size = legend_text_size, - face = legend_text_font_face, - family = font_family, - color = legend_text_color - ), - axis.text.x = ggplot2::element_text( - angle = axis_text_x_angle, - vjust = axis_text_x_vjust, - hjust = axis_text_x_hjust - ) - ) - - # Position of title - if (title_position_to_plot) theme_reach <- theme_reach + - ggplot2::theme( - plot.title.position = "plot" - ) - - if (caption_position_to_plot) theme_reach <- theme_reach + - ggplot2::theme( - plot.caption.position = "plot" - ) - # Position of caption - - # Axis lines ? - if (axis_x & axis_y) { - theme_reach <- theme_reach + - ggplot2::theme( - axis.line = ggplot2::element_line(color = text_color)) - } - - if (!axis_x) { - theme_reach <- theme_reach + - ggplot2::theme( - axis.line.x = ggplot2::element_blank(), - axis.ticks.x = ggplot2::element_blank(), - axis.text.x = ggplot2::element_blank()) - } - - if (!axis_y) { - theme_reach <- theme_reach + - ggplot2::theme( - axis.line.y = ggplot2::element_blank(), - axis.ticks.y = ggplot2::element_blank(), - axis.text.y = ggplot2::element_blank()) - } - - # X - major grid lines - if (!grid_major_x) theme_reach <- theme_reach + - ggplot2::theme( - panel.grid.major.x = ggplot2::element_blank() - ) else theme_reach <- theme_reach + - ggplot2::theme( - panel.grid.major.x = ggplot2::element_line( - color = grid_major_color, - linewidth = grid_major_x_size) - ) - - # Y - major grid lines - if (!grid_major_y) theme_reach <- theme_reach + - ggplot2::theme( - panel.grid.major.y = ggplot2::element_blank() - ) else theme_reach <- theme_reach + - ggplot2::theme( - panel.grid.major.y = ggplot2::element_line( - color = grid_major_color, - linewidth = grid_major_y_size) - ) - - # X - minor grid lines - if (!grid_minor_x) theme_reach <- theme_reach + - ggplot2::theme( - panel.grid.minor.x = ggplot2::element_blank() - ) else theme_reach <- theme_reach + - ggplot2::theme( - panel.grid.minor.x = ggplot2::element_line( - color = grid_minor_color, - linewidth = grid_minor_x_size) - ) - - # Y - minor grid lines - if (!grid_minor_y) theme_reach <- theme_reach + - ggplot2::theme( - panel.grid.minor.y = ggplot2::element_blank() - ) else theme_reach <- theme_reach + - ggplot2::theme( - panel.grid.minor.y = ggplot2::element_line( - color = grid_minor_color, - linewidth = grid_minor_y_size) - ) - if (!panel_border) theme_reach <- theme_reach + - ggplot2::theme( - panel.border = ggplot2::element_blank() - ) else theme_reach <- theme_reach + - ggplot2::theme( - panel.border = ggplot2::element_rect(color = panel_background_color) - ) - - - # Other parameters - theme_reach <- theme_reach + ggplot2::theme(...) - - # Add reach color palettes by default - # (reversed guide is defaulted to TRUE for natural reading) - theme_reach <- list( - theme_reach, - scale_color(initiative = initiative, palette = palette, discrete = discrete, reverse = reverse, reverse_guide = legend_reverse), - scale_fill(initiative = initiative, palette = palette, discrete = discrete, reverse = reverse, reverse_guide = legend_reverse) - ) - - - return(theme_reach) - -} diff --git a/R/visualizeR-package.R b/R/visualizeR-package.R deleted file mode 100644 index 62800aa..0000000 --- a/R/visualizeR-package.R +++ /dev/null @@ -1,7 +0,0 @@ -#' @keywords internal -"_PACKAGE" - -## usethis namespace: start -#' @importFrom rlang := -## usethis namespace: end -NULL diff --git a/R/waffle.R b/R/waffle.R deleted file mode 100644 index 7df06d9..0000000 --- a/R/waffle.R +++ /dev/null @@ -1,74 +0,0 @@ -#' @title Simple waffle chart -#' -#' @param df A data frame. -#' @param x A character column or coercible as a character column. Will give the waffle's fill color. -#' @param y A numeric column (if plotting proportion, make sure to have percentages between 0 and 100 and not 0 and 1). -#' @param n_rows Number of rows. Default to 10. -#' @param size Width of the separator between blocks (defaults to 2). -#' @param x_title The x scale title. Default to NULL. -#' @param x_lab The x scale caption. Default to NULL. -#' @param title Plot title. Default to NULL. -#' @param subtitle Plot subtitle. Default to NULL. -#' @param caption Plot caption. Default to NULL. -#' @param arrange TRUE or FALSE. Arrange by highest percentage first. -#' @param theme Whatever theme. Default to theme_reach(). -#' -#' @return A waffle chart -#' -#' @export -waffle <- function(df, - x, - y, - n_rows = 10, - size = 2, - x_title = NULL, - x_lab = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - arrange = TRUE, - theme = theme_reach( - axis_x = FALSE, - axis_y = FALSE, - legend_position = "bottom", - legend_direction = "horizontal", - title_hjust = 0.5)){ - - # A basic and not robust check - # - add check between 0 and 1 - - # Arrange by biggest prop first ? - if (arrange) df <- dplyr::arrange( - df, - dplyr::desc({{ y }}) - ) - - # Mutate to 100 - # df <- dplyr::mutate(df, "{{y}}" := {{ y }} * 100) - - # Prepare named vector - values <- stats::setNames(dplyr::pull(df, {{ y }}), dplyr::pull(df, {{ x }})) - - # Make plot - g <- waffle::waffle(values, xlab = x_lab, rows = n_rows, size = size) - - # Add title, subtitle, caption, x_title, y_title - g <- g + ggplot2::labs( - title = title, - subtitle = subtitle, - caption = caption, - fill = x_title, - color = x_title - ) - - # Basic theme - # g <- g + - # hrbrthemes::theme_ipsum() #+ - # waffle::theme_enhance_waffle() - - # Add theme - g <- g + theme - - return(g) - -} diff --git a/README.Rmd b/README.Rmd index df843f4..b8d23ce 100644 --- a/README.Rmd +++ b/README.Rmd @@ -12,12 +12,12 @@ knitr::opts_chunk$set( out.width = "100%", warning = FALSE, message = FALSE, - dpi = 300, + dpi = 300, dev.args = list(type = "cairo") ) -desc = read.dcf('DESCRIPTION') -desc = setNames(as.list(desc), colnames(desc)) +desc <- read.dcf("DESCRIPTION") +desc <- setNames(as.list(desc), colnames(desc)) ``` # `r desc$Package` @@ -79,22 +79,22 @@ library(visualizeR) library(palmerpenguins) library(dplyr) -df <- penguins |> - group_by(island, species) |> +df <- penguins |> + group_by(island, species) |> summarize( mean_bl = mean(bill_length_mm, na.rm = T), - mean_fl = mean(flipper_length_mm, na.rm = T)) |> + mean_fl = mean(flipper_length_mm, na.rm = T) + ) |> ungroup() # Simple bar chart by group with some alpha transparency bar(df, island, mean_bl, species, percent = FALSE, alpha = 0.6, x_title = "Mean of bill length") # Using another color palette through `theme_reach()` and changing scale to percent -bar(df, island,mean_bl, species, percent = TRUE, theme = theme_reach(palette = "artichoke_3")) +bar(df, island, mean_bl, species, percent = TRUE, theme = theme_reach(palette = "artichoke_3")) # Not flipped, with text added, group_title, no y-axis and no bold for legend bar(df, island, mean_bl, species, group_title = "Species", flip = FALSE, add_text = TRUE, add_text_suffix = "%", percent = FALSE, theme = theme_reach(text_font_face = "plain", axis_y = FALSE)) - ``` ### Example 2: Point chart, already REACH themed @@ -102,7 +102,6 @@ bar(df, island, mean_bl, species, group_title = "Species", flip = FALSE, add_tex At this stage, `point_reach()` only supports categorical grouping colors with the `group` arg. ```{r example-point-chart, out.width = "65%", eval = TRUE} - # Simple point chart point(penguins, bill_length_mm, flipper_length_mm) @@ -110,7 +109,7 @@ point(penguins, bill_length_mm, flipper_length_mm) point(penguins, bill_length_mm, flipper_length_mm, island, alpha = 0.6, size = 3, theme = theme_reach(reverse = TRUE)) # Using another color palettes -point(penguins, bill_length_mm, flipper_length_mm, island, size = 1.5, x_title = "Bill", y_title = "Flipper", title = "Length (mm)", theme = theme_reach(palette = "artichoke_3", text_font_face = , grid_major_x = TRUE, title_position_to_plot = FALSE)) +point(penguins, bill_length_mm, flipper_length_mm, island, size = 1.5, x_title = "Bill", y_title = "Flipper", title = "Length (mm)", theme = theme_reach(palette = "artichoke_3", text_font_face = , grid_major_x = TRUE, title_position_to_plot = FALSE)) ``` @@ -130,20 +129,23 @@ df <- tibble::tibble( # Example, adding a parameter to `theme_reach()` passed on `ggplot2::theme()` to align legend title dumbbell(df, - stat, - setting, - admin1, - title = "% of HHs that reported open defecation as sanitation facility", - group_y_title = "Admin 1", - group_x_title = "Setting", - theme = theme_reach(legend_position = "bottom", - legend_direction = "horizontal", - legend_title_font_face = "bold", - palette = "primary", - title_position_to_plot = FALSE, - legend.title.align = 0.5)) + + stat, + setting, + admin1, + title = "% of HHs that reported open defecation as sanitation facility", + group_y_title = "Admin 1", + group_x_title = "Setting", + theme = theme_reach( + legend_position = "bottom", + legend_direction = "horizontal", + legend_title_font_face = "bold", + palette = "primary", + title_position_to_plot = FALSE, + legend.title.align = 0.5 + ) +) + # Change legend title position (could be included as part of the function) - ggplot2::guides( + ggplot2::guides( color = ggplot2::guide_legend(title.position = "left"), fill = ggplot2::guide_legend(title.position = "left") ) @@ -151,7 +153,6 @@ dumbbell(df, ### Example 4: donut chart, REACH themed (to used once, not twice) ```{r example-donut-plot, out.width = "65%", warning = FALSE} - # Some summarized data: % of HHs by displacement status df <- tibble::tibble( status = c("Displaced", "Non displaced", "Returnee", "Don't know/Prefer not to say"), @@ -159,16 +160,17 @@ df <- tibble::tibble( ) # Donut -donut(df, - status, - percentage, - hole_size = 3, - add_text_suffix = "%", - add_text_color = cols_reach("dk_grey"), - add_text_treshold_display = 5, - x_title = "Displacement status", - title = "% of HHs by displacement status", - theme = theme_reach(legend_reverse = TRUE)) +donut(df, + status, + percentage, + hole_size = 3, + add_text_suffix = "%", + add_text_color = cols_reach("dk_grey"), + add_text_treshold_display = 5, + x_title = "Displacement status", + title = "% of HHs by displacement status", + theme = theme_reach(legend_reverse = TRUE) +) ``` @@ -181,32 +183,34 @@ waffle(df, status, percentage, x_title = "A caption", title = "A title", subtitl ### Example 6: alluvial chart, REACH themed ```{r example-alluvial-plot, out.width = "65%", warning = FALSE} - # Some summarized data: % of HHs by self-reported status of displacement in 2021 and in 2022 df <- tibble::tibble( - status_from = c(rep("Displaced", 4), - rep("Non displaced", 4), - rep("Returnee", 4), - rep("Dnk/Pnts", 4)), + status_from = c( + rep("Displaced", 4), + rep("Non displaced", 4), + rep("Returnee", 4), + rep("Dnk/Pnts", 4) + ), status_to = c("Displaced", "Non displaced", "Returnee", "Dnk/Pnts", "Displaced", "Non displaced", "Returnee", "Dnk/Pnts", "Displaced", "Non displaced", "Returnee", "Dnk/Pnts", "Displaced", "Non displaced", "Returnee", "Dnk/Pnts"), percentage = c(20, 8, 18, 1, 12, 21, 0, 2, 0, 3, 12, 1, 0, 0, 1, 1) ) # Alluvial, here the group is the status for 2021 -alluvial(df, - status_from, - status_to, - percentage, - status_from, - from_levels = c("Displaced", "Non displaced", "Returnee", "Dnk/Pnts"), - alpha = 0.8, - group_title = "Status for 2021", - title = "% of HHs by self-reported status from 2021 to 2022", - theme = theme_reach( - axis_y = FALSE, - legend_position = "none")) - +alluvial(df, + status_from, + status_to, + percentage, + status_from, + from_levels = c("Displaced", "Non displaced", "Returnee", "Dnk/Pnts"), + alpha = 0.8, + group_title = "Status for 2021", + title = "% of HHs by self-reported status from 2021 to 2022", + theme = theme_reach( + axis_y = FALSE, + legend_position = "none" + ) +) ``` ### Example 7: lollipop chart @@ -214,65 +218,69 @@ alluvial(df, library(tidyr) # Prepare long data df <- tibble::tibble( - admin1 = replicate(15, sample(letters, 8)) |> t() |> as.data.frame() |> unite("admin1", sep = "") |> dplyr::pull(admin1), - stat = rnorm(15, mean = 50, sd = 15)) |> + admin1 = replicate(15, sample(letters, 8)) |> t() |> as.data.frame() |> unite("admin1", sep = "") |> dplyr::pull(admin1), + stat = rnorm(15, mean = 50, sd = 15) +) |> dplyr::mutate(stat = round(stat, 0)) # Make lollipop plot, REACH themed, vertical with 45 degrees angle X-labels lollipop(df, - admin1, - stat, - arrange = FALSE, - add_text = FALSE, - flip = FALSE, - y_title = "% of HHs", - x_title = "Admin 1", - title = "% of HHs that reported having received a humanitarian assistance", - theme = theme_reach(axis_text_x_angle = 45, - grid_major_y = TRUE, - grid_major_y_size = 0.2, - grid_major_x = TRUE, - grid_minor_y = TRUE)) + admin1, + stat, + arrange = FALSE, + add_text = FALSE, + flip = FALSE, + y_title = "% of HHs", + x_title = "Admin 1", + title = "% of HHs that reported having received a humanitarian assistance", + theme = theme_reach( + axis_text_x_angle = 45, + grid_major_y = TRUE, + grid_major_y_size = 0.2, + grid_major_x = TRUE, + grid_minor_y = TRUE + ) +) # Horizontal, greater point size, arranged by value, no grid, and text labels added lollipop(df, - admin1, - stat, - arrange = TRUE, - point_size = 10, - point_color = cols_reach("main_beige"), - segment_size = 2, - add_text = TRUE, - add_text_suffix = "%", - y_title = "% of HHs", - x_title = "Admin 1", - title = "% of HHs that reported having received a humanitarian assistance in the 12 months prior to the assessment", - theme = theme_reach(title_position_to_plot = FALSE)) - - + admin1, + stat, + arrange = TRUE, + point_size = 10, + point_color = cols_reach("main_beige"), + segment_size = 2, + add_text = TRUE, + add_text_suffix = "%", + y_title = "% of HHs", + x_title = "Admin 1", + title = "% of HHs that reported having received a humanitarian assistance in the 12 months prior to the assessment", + theme = theme_reach(title_position_to_plot = FALSE) +) ``` ## Maps ```{r example-map, out.width = "50%"} - -# Add indicator layer -# - based on "pretty" classes and title "Proportion (%)" +# Add indicator layer +# - based on "pretty" classes and title "Proportion (%)" # - buffer to add a 10% around the bounding box map <- add_indicator_layer( - indicator_admin1, + indicator_admin1, opn_dfc, - buffer = 0.1) + + buffer = 0.1 +) + # Layout - some defaults - add the map title - add_layout("% of HH that reported open defecation as sanitation facility") + + add_layout("% of HH that reported open defecation as sanitation facility") + # Admin boundaries as list of shape files (lines) and colors, line widths and labels as vectors add_admin_boundaries( lines = list(line_admin1, border_admin0, frontier_admin0), colors = cols_reach("main_lt_grey", "dk_grey", "black"), lwds = c(0.5, 2, 3), labels = c("Department", "Country", "Dominican Rep. frontier"), - title = "Administrative boundaries") + + title = "Administrative boundaries" + ) + # Add text labels - centered on admin 1 centroids add_admin_labels(centroid_admin1, ADM1_FR_UPPER) + # Add a compass @@ -285,10 +293,10 @@ map <- add_indicator_layer( ```{r map-save, eval = TRUE, include = FALSE, echo = TRUE} tmap::tmap_save(map, - "man/figures/README-example-map.png", - height = 4.5, - width = 6 - ) + "man/figures/README-example-map.png", + height = 4.5, + width = 6 +) ``` ![Once exported with `tmap::tmap_save()`.](man/figures/README-example-map.png) diff --git a/data-raw/shapefiles.R b/data-raw/shapefiles.R index 13db57a..db22c8c 100644 --- a/data-raw/shapefiles.R +++ b/data-raw/shapefiles.R @@ -1,4 +1,3 @@ - #------ Border - admin 0 border_admin0 <- sf::st_read("data-raw/border_admin0.shp") usethis::use_data(border_admin0, overwrite = TRUE) diff --git a/man/abort_bad_argument.Rd b/man/abort_bad_argument.Rd deleted file mode 100644 index 02ec558..0000000 --- a/man/abort_bad_argument.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/internals.R -\name{abort_bad_argument} -\alias{abort_bad_argument} -\title{Abord bad argument} -\usage{ -abort_bad_argument(arg, must, not = NULL) -} -\arguments{ -\item{arg}{An argument} - -\item{must}{What arg must be} - -\item{not}{Optional. What arg must not be.} -} -\value{ -A stop statement -} -\description{ -Abord bad argument -} diff --git a/man/add_admin_boundaries.Rd b/man/add_admin_boundaries.Rd deleted file mode 100644 index 7d6e3b4..0000000 --- a/man/add_admin_boundaries.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/map.R -\name{add_admin_boundaries} -\alias{add_admin_boundaries} -\title{Add admin boundaries (lines) and the legend} -\usage{ -add_admin_boundaries( - lines, - colors, - labels, - lwds, - title = "", - buffer = NULL, - ... -) -} -\arguments{ -\item{lines}{List of multiline shape defined by sf package.} - -\item{colors}{Vector of hexadecimal codes. Same order as lines.} - -\item{labels}{Vector of labels in the legend. Same order as lines.} - -\item{lwds}{Vector of line widths. Same order as lines.} - -\item{title}{Legend title.} - -\item{buffer}{A buffer, either one value or a vector of 4 values (left, bottom, right, top).} - -\item{...}{Other arguments to pass to each shape in `tmap::tm_lines()`.} -} -\value{ -A tmap layer. -} -\description{ -Add admin boundaries (lines) and the legend -} diff --git a/man/add_admin_labels.Rd b/man/add_admin_labels.Rd deleted file mode 100644 index d9691b6..0000000 --- a/man/add_admin_labels.Rd +++ /dev/null @@ -1,43 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/map.R -\name{add_admin_labels} -\alias{add_admin_labels} -\title{Wrapper around `tmap::tm_text()` with sane defaults for plotting admin labels.} -\usage{ -add_admin_labels( - point, - text, - size = 0.5, - fontface = "bold", - fontfamily = "Leelawadee", - shadow = TRUE, - auto_placement = FALSE, - remove_overlap = FALSE, - ... -) -} -\arguments{ -\item{point}{Multipoint shape defined by sf package.} - -\item{text}{Text labels column.} - -\item{size}{Relative size of the text labels.} - -\item{fontface}{Fontface.} - -\item{fontfamily}{Fontfamily. Leelawadee is your precious.} - -\item{shadow}{Boolean. Add a shadow around text labels. Issue opened on Github to request.} - -\item{auto_placement}{Logical that determines whether the labels are placed automatically.} - -\item{remove_overlap}{Logical that determines whether the overlapping labels are removed.} - -\item{...}{Other arguments to pass to `tmap::tm_text()`.} -} -\value{ -A tmap layer. -} -\description{ -Wrapper around `tmap::tm_text()` with sane defaults for plotting admin labels. -} diff --git a/man/add_compass.Rd b/man/add_compass.Rd deleted file mode 100644 index a22f932..0000000 --- a/man/add_compass.Rd +++ /dev/null @@ -1,34 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/map.R -\name{add_compass} -\alias{add_compass} -\title{Add a compass} -\usage{ -add_compass( - text_size = 0.6, - position = c("right", 0.8), - color_dark = cols_reach("black"), - text_color = cols_reach("black"), - type = "4star", - ... -) -} -\arguments{ -\item{text_size}{Relative font size.} - -\item{position}{Position of the compass. Vector of two values, specifying the x and y coordinates.} - -\item{color_dark}{Color of the dark parts of the compass.} - -\item{text_color}{color of the text.} - -\item{type}{Compass type, one of: "arrow", "4star", "8star", "radar", "rose".} - -\item{...}{Other arguments to pass to `tmap::tm_compass()`.} -} -\value{ -A tmap layer. -} -\description{ -Add a compass -} diff --git a/man/add_credits.Rd b/man/add_credits.Rd deleted file mode 100644 index 9410747..0000000 --- a/man/add_credits.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/map.R -\name{add_credits} -\alias{add_credits} -\title{Do you want to credit someone or some institution?} -\usage{ -add_credits(text, size = 0.4, bg_color = NA, position = c(0.75, 0.02), ...) -} -\arguments{ -\item{text}{Text.} - -\item{size}{Relative text size.} - -\item{bg_color}{Background color.} - -\item{position}{Position. Vector of two coordinates. Usually somewhere down.} - -\item{...}{Other arguments to pass to `tmap::tm_credits()`.} -} -\value{ -A tmap layer. -} -\description{ -Do you want to credit someone or some institution? -} diff --git a/man/add_indicator_layer.Rd b/man/add_indicator_layer.Rd deleted file mode 100644 index cf54ac2..0000000 --- a/man/add_indicator_layer.Rd +++ /dev/null @@ -1,61 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/map.R -\name{add_indicator_layer} -\alias{add_indicator_layer} -\title{Wrapper around `tmap::tm_polygons()` with sane defaults for plotting indicator values} -\usage{ -add_indicator_layer( - poly, - col, - buffer = NULL, - n = 5, - style = "pretty", - palette = pal_reach("red_5"), - as_count = TRUE, - color_na = cols_reach("white"), - text_na = "Missing data", - legend_title = "Proportion (\%)", - legend_text_separator = " - ", - border_alpha = 1, - border_col = cols_reach("lt_grey_1"), - lwd = 1, - ... -) -} -\arguments{ -\item{poly}{Multipolygon shape defined by sf package.} - -\item{col}{Numeric attribute to map.} - -\item{buffer}{A buffer, either one value or a vector of 4 values (left, bottom, right, top).} - -\item{n}{The desire number of classes.} - -\item{style}{Method to process the color scale for continuous numerical variables. See `classInt::classIntervals()` for details.} - -\item{palette}{Vector of fill colors as hexadecimal values. For REACH color palettes, it is possible to use `pal_reach()`. For now,'palette' must be changed manually, accordingly to the number of drawn classes.} - -\item{as_count}{Boolean. When col is a numeric variable, should it be processed as a count variable? For instance, 0, 1-10, 11-20.} - -\item{color_na}{Fill color for missing data.} - -\item{text_na}{Legend text for missing data.} - -\item{legend_title}{Legend title.} - -\item{legend_text_separator}{Text separator for classes. E.g. " to " will give 0, 1 to 10, 11 to 20.} - -\item{border_alpha}{Transparency of the border.} - -\item{border_col}{Color of the border.} - -\item{lwd}{Linewidth of the border.} - -\item{...}{Other arguments to pass to `tmap::tm_polygons()`.} -} -\value{ -A tmap layer. -} -\description{ -Wrapper around `tmap::tm_polygons()` with sane defaults for plotting indicator values -} diff --git a/man/add_layout.Rd b/man/add_layout.Rd deleted file mode 100644 index f5c4b53..0000000 --- a/man/add_layout.Rd +++ /dev/null @@ -1,49 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/map.R -\name{add_layout} -\alias{add_layout} -\title{Basic defaults based on `tmap::tm_layout()`} -\usage{ -add_layout( - title = NULL, - legend_position = c(0.02, 0.5), - frame = FALSE, - legend_frame = cols_reach("main_grey"), - legend_text_size = 0.6, - legend_title_size = 0.8, - title_size = 0.9, - title_fontface = "bold", - title_color = cols_reach("main_grey"), - fontfamily = "Leelawadee", - ... -) -} -\arguments{ -\item{title}{Map title.} - -\item{legend_position}{Legend position. Not above the map is a good start.} - -\item{frame}{Boolean. Legend frame?} - -\item{legend_frame}{Legend frame color.} - -\item{legend_text_size}{Legend text size in 'pt'.} - -\item{legend_title_size}{Legend title size in 'pt'.} - -\item{title_size}{Title text size in 'pt'.} - -\item{title_fontface}{Title fontface. Bold if you wanna exemplify a lot what it is about.} - -\item{title_color}{Title font color.} - -\item{fontfamily}{Overall fontfamily. Leelawadee is your precious.} - -\item{...}{Other arguments to pass to `tmap::tm_layout()`.} -} -\value{ -A tmap layer. -} -\description{ -Basic defaults based on `tmap::tm_layout()` -} diff --git a/man/add_scale_bar.Rd b/man/add_scale_bar.Rd deleted file mode 100644 index b204c3c..0000000 --- a/man/add_scale_bar.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/map.R -\name{add_scale_bar} -\alias{add_scale_bar} -\title{Add a scale bar} -\usage{ -add_scale_bar( - text_size = 0.6, - position = c("left", 0.01), - color_dark = cols_reach("black"), - breaks = c(0, 50, 100), - ... -) -} -\arguments{ -\item{text_size}{Relative font size.} - -\item{position}{Position of the compass. Vector of two values, specifying the x and y coordinates.} - -\item{color_dark}{Color of the dark parts of the compass.} - -\item{breaks}{Breaks of the scale bar. If not specified, breaks will be automatically be chosen given the prefered width of the scale bar. Example: c(0, 50, 100).} - -\item{...}{Other arguments to pass to `tmap::tm_compass()`.} -} -\value{ -A tmap layer. -} -\description{ -Add a scale bar -} diff --git a/man/alluvial.Rd b/man/alluvial.Rd deleted file mode 100644 index 8750fe9..0000000 --- a/man/alluvial.Rd +++ /dev/null @@ -1,64 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/alluvial.R -\name{alluvial} -\alias{alluvial} -\title{Simple alluvial chart} -\usage{ -alluvial( - df, - from, - to, - value, - group = NULL, - alpha = 0.5, - from_levels = NULL, - value_title = NULL, - group_title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - rect_color = cols_reach("white"), - rect_border_color = cols_reach("main_grey"), - rect_text_color = cols_reach("main_grey"), - theme = theme_reach(axis_y = FALSE, legend_position = "none") -) -} -\arguments{ -\item{df}{A data frame.} - -\item{from}{A character column of upstream stratum.} - -\item{to}{A character column of downstream stratum.} - -\item{value}{A numeric column of values.} - -\item{group}{The grouping column to fill the alluvium with.} - -\item{alpha}{Fill transparency. Default to 0.5.} - -\item{from_levels}{Order by given from levels?} - -\item{value_title}{The value/y scale title. Default to NULL.} - -\item{group_title}{The group title. Default to NULL.} - -\item{title}{Plot title. Default to NULL.} - -\item{subtitle}{Plot subtitle. Default to NULL.} - -\item{caption}{Plot caption. Default to NULL.} - -\item{rect_color}{Stratum rectangles' fill color.} - -\item{rect_border_color}{Stratum rectangles' border color.} - -\item{rect_text_color}{Stratum rectangles' text color.} - -\item{theme}{Whatever theme. Default to theme_reach().} -} -\value{ -A donut chart to be used parsimoniously -} -\description{ -Simple alluvial chart -} diff --git a/man/bar.Rd b/man/bar.Rd index 7dc2f19..3ed541a 100644 --- a/man/bar.Rd +++ b/man/bar.Rd @@ -8,9 +8,9 @@ bar( df, x, y, - group = NULL, + group = "", + add_color = color("dark_grey"), flip = TRUE, - percent = TRUE, wrap = NULL, position = "dodge", alpha = 1, @@ -20,24 +20,29 @@ bar( title = NULL, subtitle = NULL, caption = NULL, - add_text = FALSE, - add_text_suffix = "", - theme = theme_reach() + width = 0.5, + add_text = TRUE, + add_text_size = 5, + add_text_color = color("dark_grey"), + add_text_font_face = "plain", + add_text_threshold_display = 0.05, + add_text_suffix = "\%", + add_text_expand_limit = 1.1 ) } \arguments{ \item{df}{A data frame.} -\item{x}{A numeric column.} +\item{x}{A quoted numeric column.} -\item{y}{A character column or coercible as a character column.} +\item{y}{A quoted character column or coercible as a character column.} -\item{group}{Some grouping categorical column, e.g. administrative areas or population groups.} +\item{group}{Some quoted grouping categorical column, e.g. administrative areas or population groups.} + +\item{add_color}{Add a color to bars (if no grouping).} \item{flip}{TRUE or FALSE. Default to TRUE or horizontal bar plot.} -\item{percent}{TRUE or FALSE. Should the x-labels (and text labels if present) be displayed as percentages? Default to TRUE.} - \item{wrap}{Should x-labels be wrapped? Number of characters.} \item{position}{Should the chart be stacked? Default to "dodge". Can take "dodge" and "stack".} @@ -56,14 +61,21 @@ bar( \item{caption}{Plot caption. Default to NULL.} -\item{add_text}{TRUE or FALSE. Add the value as text.} +\item{width}{Bar width.} + +\item{add_text}{TRUE or FALSE. Add values as text.} + +\item{add_text_size}{Text size.} + +\item{add_text_color}{Text color.} + +\item{add_text_font_face}{Text font_face.} + +\item{add_text_threshold_display}{Minimum value to add the text label.} \item{add_text_suffix}{If percent is FALSE, should we add a suffix to the text label?} -\item{theme}{Whatever theme. Default to theme_reach().} -} -\value{ -A bar chart +\item{add_text_expand_limit}{Default to adding 10% on top of the bar.} } \description{ Simple bar chart diff --git a/man/border_admin0.Rd b/man/border_admin0.Rd deleted file mode 100644 index cd495f3..0000000 --- a/man/border_admin0.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{border_admin0} -\alias{border_admin0} -\title{Haïti border.} -\format{ -A sf multiline objet with 1 feature and 6 fields: -\describe{ - \item{fid_1}{fid_1} - \item{uno}{uno} - \item{count}{count} - \item{x_coord}{x_coord} - \item{y_coord}{y_coord} - \item{area}{area} - \item{geometry}{Multiline geometry.} -} -} -\usage{ -border_admin0 -} -\description{ -A multiline shapefile of Haiti's border. -} -\keyword{datasets} diff --git a/man/buffer_bbox.Rd b/man/buffer_bbox.Rd deleted file mode 100644 index 066562f..0000000 --- a/man/buffer_bbox.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/bbox_buffer.R -\name{buffer_bbox} -\alias{buffer_bbox} -\title{Bbbox buffer} -\usage{ -buffer_bbox(sf_obj, buffer = 0) -} -\arguments{ -\item{sf_obj}{A `sf` object} - -\item{buffer}{A buffer, either one value or a vector of 4 values (left, bottom, right, top). Default to 0.} -} -\value{ -A bbox with a buffer -} -\description{ -Bbbox buffer -} diff --git a/man/centroid_admin1.Rd b/man/centroid_admin1.Rd deleted file mode 100644 index c221ac9..0000000 --- a/man/centroid_admin1.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{centroid_admin1} -\alias{centroid_admin1} -\title{Haïti admin 1 centroids shapefile.} -\format{ -A sf multipoint object with 10 features and 9 fields: -\describe{ - \item{ADM1_PC}{Admin 1 postal code.} - \item{ADM1_EN}{Full name in English.} - \item{ADM1_FR}{Full name in French.} - \item{ADM1_HT}{Full name in Haitian Creole.} - \item{ADM0_EN}{Country name in English.} - \item{ADM0_FR}{Country name in French.} - \item{ADM0_HT}{Country name in Haitian Creole.} - \item{ADM0_PC}{Country postal code.} - \item{ADM1_FR_UPPER}{Admin 1 French name - uppercase.} - \item{geometry}{Multipoint geometry.} -} -} -\usage{ -centroid_admin1 -} -\description{ -A multipoint shapefile of Haiti's admin 1. -} -\keyword{datasets} diff --git a/man/check_vars_in_df.Rd b/man/check_vars_in_df.Rd new file mode 100644 index 0000000..b973b00 --- /dev/null +++ b/man/check_vars_in_df.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/checks.R +\name{check_vars_in_df} +\alias{check_vars_in_df} +\title{Check if variables are in data frame} +\usage{ +check_vars_in_df(df, vars) +} +\arguments{ +\item{df}{A data frame} + +\item{vars}{A vector of variable names} +} +\value{ +A stop statement +} +\description{ +Check if variables are in data frame +} diff --git a/man/color.Rd b/man/color.Rd new file mode 100644 index 0000000..12dc8e6 --- /dev/null +++ b/man/color.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/color.R +\name{color} +\alias{color} +\alias{color_pattern} +\title{Helpers to extract defined colors as hex codes} +\usage{ +color(..., unname = TRUE) + +color_pattern(pattern, unname = TRUE) +} +\arguments{ +\item{...}{Character names of colors. If NULL returns all colors.} + +\item{unname}{Boolean. Should the output vector be unnamed? Default to `TRUE`.} + +\item{pattern}{Pattern of the start of colors' name.} +} +\value{ +Hex codes named or unnamed. +} +\description{ +[color()] returns the requested columns, returns NA if absent. [color_pattern()] returns all colors that start with the pattern. +} +\section{Naming of colors}{ + +* All branding colors start with "branding"; +* All , categorical colors start with ", cat_"; +* All sequential colors start with "seq_"; + +Then, a number indi, cates the number of colors that belong to the palettes, a string the name of the palette, and, finally, a number the position of the color. E.g., "seq_5_red_4" would be the 4th color of a continuous palettes of 5 colors in the red band. Exception is made for white, light_grey, dark_grey, and black. +} + diff --git a/man/cols_agora.Rd b/man/cols_agora.Rd deleted file mode 100644 index 29f603a..0000000 --- a/man/cols_agora.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cols_agora.R -\name{cols_agora} -\alias{cols_agora} -\title{Function to extract AGORA colors as hex codes} -\usage{ -cols_agora(..., unnamed = TRUE) -} -\arguments{ -\item{...}{Character names of reach colors. If NULL returns all colors} - -\item{unnamed}{Should the output vector be unnamed? Default to `TRUE`} -} -\value{ -An hex code or hex codes named or unnamed -} -\description{ -Function to extract AGORA colors as hex codes -} -\details{ -This function needs to be modified to add colors -} diff --git a/man/cols_impact.Rd b/man/cols_impact.Rd deleted file mode 100644 index 9833a64..0000000 --- a/man/cols_impact.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cols_impact.R -\name{cols_impact} -\alias{cols_impact} -\title{Function to extract IMPACT colors as hex codes} -\usage{ -cols_impact(..., unnamed = TRUE) -} -\arguments{ -\item{...}{Character names of reach colors. If NULL returns all colors} - -\item{unnamed}{Should the output vector be unnamed? Default to `TRUE`} -} -\value{ -An hex code or hex codes named or unnamed -} -\description{ -Function to extract IMPACT colors as hex codes -} -\details{ -This function needs to be modified to add colors -} diff --git a/man/cols_reach.Rd b/man/cols_reach.Rd deleted file mode 100644 index 7c0ed87..0000000 --- a/man/cols_reach.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cols_reach.R -\name{cols_reach} -\alias{cols_reach} -\title{Function to extract REACH colors as hex codes} -\usage{ -cols_reach(..., unnamed = TRUE) -} -\arguments{ -\item{...}{Character names of reach colors. If NULL returns all colors} - -\item{unnamed}{Should the output vector be unnamed? Default to `TRUE`} -} -\value{ -An hex code or hex codes named or unnamed -} -\description{ -Function to extract REACH colors as hex codes -} -\details{ -This function needs to be modified to add colors -} diff --git a/man/donut.Rd b/man/donut.Rd deleted file mode 100644 index b461123..0000000 --- a/man/donut.Rd +++ /dev/null @@ -1,61 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/donut.R -\name{donut} -\alias{donut} -\title{Simple donut chart (to be used parsimoniously), can be a pie chart} -\usage{ -donut( - df, - x, - y, - alpha = 1, - x_title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - arrange = TRUE, - hole_size = 3, - add_text = TRUE, - add_text_treshold_display = 5, - add_text_color = "white", - add_text_suffix = "", - theme = theme_reach(legend_reverse = TRUE) -) -} -\arguments{ -\item{df}{A data frame.} - -\item{x}{A character column or coercible as a character column. Will give the donut's fill color.} - -\item{y}{A numeric column.} - -\item{alpha}{Fill transparency.} - -\item{x_title}{The x scale title. Default to NULL.} - -\item{title}{Plot title. Default to NULL.} - -\item{subtitle}{Plot subtitle. Default to NULL.} - -\item{caption}{Plot caption. Default to NULL.} - -\item{arrange}{TRUE or FALSE. Arrange by highest percentage first.} - -\item{hole_size}{Hole size. Default to 3. If less than 2, back to a pie chart.} - -\item{add_text}{TRUE or FALSE. Add the value as text.} - -\item{add_text_treshold_display}{Minimum value to add the text label.} - -\item{add_text_color}{Text color.} - -\item{add_text_suffix}{If percent is FALSE, should we add a suffix to the text label?} - -\item{theme}{Whatever theme. Default to theme_reach().} -} -\value{ -A donut chart to be used parsimoniously -} -\description{ -Simple donut chart (to be used parsimoniously), can be a pie chart -} diff --git a/man/dumbbell.Rd b/man/dumbbell.Rd deleted file mode 100644 index 2bd7437..0000000 --- a/man/dumbbell.Rd +++ /dev/null @@ -1,85 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/dumbbell.R -\name{dumbbell} -\alias{dumbbell} -\title{Make dumbbell chart.} -\usage{ -dumbbell( - df, - col, - group_x, - group_y, - point_size = 5, - point_alpha = 1, - segment_size = 2.5, - segment_color = cols_reach("main_lt_grey"), - group_x_title = NULL, - group_y_title = NULL, - x_title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - line_to_y_axis = TRUE, - line_to_y_axis_type = 3, - line_to_y_axis_width = 0.5, - line_to_y_axis_color = cols_reach("main_grey"), - add_text = TRUE, - add_text_vjust = 2, - add_text_size = 3.5, - add_text_color = cols_reach("main_grey"), - theme = theme_reach(palette = "primary") -) -} -\arguments{ -\item{df}{A data frame.} - -\item{col}{A numeric column.} - -\item{group_x}{The grouping column on the x-axis; only two groups.} - -\item{group_y}{The grouping column on the y-axis.} - -\item{point_size}{Point size.} - -\item{point_alpha}{Point alpha.} - -\item{segment_size}{Segment size.} - -\item{segment_color}{Segment color.} - -\item{group_x_title}{X-group and legend title.} - -\item{group_y_title}{Y-axis and group title.} - -\item{x_title}{X-axis title.} - -\item{title}{Title.} - -\item{subtitle}{Subtitle.} - -\item{caption}{Caption.} - -\item{line_to_y_axis}{TRUE or FALSE; add a line connected points and Y-axis.} - -\item{line_to_y_axis_type}{Line to Y-axis type.} - -\item{line_to_y_axis_width}{Line to Y-axis width.} - -\item{line_to_y_axis_color}{Line to Y-axis color.} - -\item{add_text}{TRUE or FALSE; add text at the points.} - -\item{add_text_vjust}{Vertical adjustment.} - -\item{add_text_size}{Text size.} - -\item{add_text_color}{Text color.} - -\item{theme}{A ggplot2 theme, default to `theme_reach()`} -} -\value{ -A dumbbell chart. -} -\description{ -Make dumbbell chart. -} diff --git a/man/frontier_admin0.Rd b/man/frontier_admin0.Rd deleted file mode 100644 index 91501c1..0000000 --- a/man/frontier_admin0.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{frontier_admin0} -\alias{frontier_admin0} -\title{Haïti frontier with Dominican Republic.} -\format{ -A sf multipoint objet with 4 features and 8 fields: -\describe{ - \item{fid_1}{fid_1} - \item{objectid}{objectid} - \item{id}{id} - \item{fromnode}{fromnode} - \item{tonode}{tonode} - \item{leftpolygo}{leftpolygo} - \item{rightpolygo}{rightpolygo} - \item{shape_leng}{shape_leng} - \item{geometry}{Multiline geometry.} -} -} -\usage{ -frontier_admin0 -} -\description{ -A multiline shapefile of Haiti's frontier with Dominican Republic. -} -\keyword{datasets} diff --git a/man/if_not_in_stop.Rd b/man/if_not_in_stop.Rd deleted file mode 100644 index bb29dea..0000000 --- a/man/if_not_in_stop.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/internals.R -\name{if_not_in_stop} -\alias{if_not_in_stop} -\title{Stop statement "If not in colnames" with colnames} -\usage{ -if_not_in_stop(.tbl, cols, df, arg = NULL) -} -\arguments{ -\item{.tbl}{A tibble} - -\item{cols}{A vector of column names (quoted)} - -\item{df}{Provide the tibble name as a character string} - -\item{arg}{Default to NULL.} -} -\value{ -A stop statement -} -\description{ -Stop statement "If not in colnames" with colnames -} diff --git a/man/if_vec_not_in_stop.Rd b/man/if_vec_not_in_stop.Rd deleted file mode 100644 index 56d228f..0000000 --- a/man/if_vec_not_in_stop.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/internals.R -\name{if_vec_not_in_stop} -\alias{if_vec_not_in_stop} -\title{Stop statement "If not in vector"} -\usage{ -if_vec_not_in_stop(vec, cols, vec_name, arg = NULL) -} -\arguments{ -\item{vec}{A vector of character strings} - -\item{cols}{A set of character strings} - -\item{vec_name}{Provide the vector name as a character string} - -\item{arg}{Default to NULL.} -} -\value{ -A stop statement if some elements of vec are not in cols -} -\description{ -Stop statement "If not in vector" -} diff --git a/man/indicator_admin1.Rd b/man/indicator_admin1.Rd deleted file mode 100644 index 673ee1b..0000000 --- a/man/indicator_admin1.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{indicator_admin1} -\alias{indicator_admin1} -\title{Indicator admin 1 polygons shapefile.} -\format{ -A sf multipoint object with 10 features and 10 fields: -\describe{ - \item{ADM1_PC}{Admin 1 postal code.} - \item{admin1}{Admin 1 unique id.} - \item{opn_dfc}{Proportion of HHs that reported open defecation as sanitation facility.} - \item{ADM1_EN}{Full name in English.} - \item{ADM1_FR}{Full name in French.} - \item{ADM1_HT}{Full name in Haitian Creole.} - \item{ADM0_EN}{Country name in English.} - \item{ADM0_FR}{Country name in French.} - \item{ADM0_HT}{Country name in Haitian Creole.} - \item{ADM0_PC}{Country postal code.} - \item{geometry}{Multipolygon geometry.} -} -} -\usage{ -indicator_admin1 -} -\description{ -A multipolygon shapefile of Haiti's admin 1 with an indicator column 'opn_dfc'. -} -\keyword{datasets} diff --git a/man/line_admin1.Rd b/man/line_admin1.Rd deleted file mode 100644 index 49f72e4..0000000 --- a/man/line_admin1.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{line_admin1} -\alias{line_admin1} -\title{Haïti admin 1 lines shapefile.} -\format{ -A sf multiline object with 10 features and 8 fields: -\describe{ - \item{ADM1_EN}{Full name in English.} - \item{ADM1_FR}{Full name in French.} - \item{ADM1_HT}{Full name in Haitian Creole.} - \item{ADM0_EN}{Country name in English.} - \item{ADM0_FR}{Country name in French.} - \item{ADM0_HT}{Country name in Haitian Creole.} - \item{ADM0_PCODE}{Country postal code.} - \item{geometry}{Multiline geometry.} -} -} -\usage{ -line_admin1 -} -\description{ -A multiline shapefile of Haiti's admin 1. -} -\keyword{datasets} diff --git a/man/lollipop.Rd b/man/lollipop.Rd deleted file mode 100644 index 6bc23ef..0000000 --- a/man/lollipop.Rd +++ /dev/null @@ -1,88 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/lollipop.R -\name{lollipop} -\alias{lollipop} -\title{Simple bar chart} -\usage{ -lollipop( - df, - x, - y, - flip = TRUE, - wrap = NULL, - arrange = TRUE, - point_size = 3, - point_color = cols_reach("main_red"), - point_alpha = 1, - segment_size = 1, - segment_color = cols_reach("main_grey"), - segment_alpha = 1, - alpha = 1, - x_title = NULL, - y_title = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - add_text = FALSE, - add_text_size = 3, - add_text_suffix = "", - add_text_color = "white", - add_text_fontface = "bold", - theme = theme_reach() -) -} -\arguments{ -\item{df}{A data frame.} - -\item{x}{A numeric column.} - -\item{y}{A character column or coercible as a character column.} - -\item{flip}{TRUE or FALSE. Default to TRUE or horizontal lollipop plot.} - -\item{wrap}{Should x-labels be wrapped? Number of characters.} - -\item{arrange}{TRUE or FALSE. Arrange by highest percentage first.} - -\item{point_size}{Point size.} - -\item{point_color}{Point color.} - -\item{point_alpha}{Point alpha.} - -\item{segment_size}{Segment size.} - -\item{segment_color}{Segment color.} - -\item{segment_alpha}{Segment alpha.} - -\item{alpha}{Fill transparency.} - -\item{x_title}{The x scale title. Default to NULL.} - -\item{y_title}{The y scale title. Default to NULL.} - -\item{title}{Plot title. Default to NULL.} - -\item{subtitle}{Plot subtitle. Default to NULL.} - -\item{caption}{Plot caption. Default to NULL.} - -\item{add_text}{TRUE or FALSE. Add the y value as text within the bubble.} - -\item{add_text_size}{Text size.} - -\item{add_text_suffix}{If percent is FALSE, should we add a suffix to the text label?} - -\item{add_text_color}{Added text color. Default to white.} - -\item{add_text_fontface}{Added text font face. Default to "bold".} - -\item{theme}{Whatever theme. Default to theme_reach().} -} -\value{ -A bar chart -} -\description{ -Simple bar chart -} diff --git a/man/pal_agora.Rd b/man/pal_agora.Rd deleted file mode 100644 index 71b9921..0000000 --- a/man/pal_agora.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/pal_agora.R -\name{pal_agora} -\alias{pal_agora} -\title{Return function to interpolate an AGORA color palette} -\usage{ -pal_agora( - palette = "main", - reverse = FALSE, - color_ramp_palette = FALSE, - show_palettes = FALSE, - ... -) -} -\arguments{ -\item{palette}{Character name of a palette in AGORA palettes} - -\item{reverse}{Boolean indicating whether the palette should be reversed} - -\item{color_ramp_palette}{Should the output be a `grDevices::colorRampPalette` function or a vector of hex codes? Default to the former with `TRUE`} - -\item{show_palettes}{Should the ouput be the set of palettes names to pick from? Default to `FALSE`} - -\item{...}{Additional arguments to pass to colorRampPalette()} -} -\value{ -A color palette -} -\description{ -Return function to interpolate an AGORA color palette -} diff --git a/man/pal_fallback.Rd b/man/pal_fallback.Rd deleted file mode 100644 index 6716ae5..0000000 --- a/man/pal_fallback.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/pal_fallback.R -\name{pal_fallback} -\alias{pal_fallback} -\title{Return function to interpolate a fallback palette base on viridis::magma()} -\usage{ -pal_fallback( - reverse = FALSE, - color_ramp_palette = FALSE, - discrete = FALSE, - n = 5, - ... -) -} -\arguments{ -\item{reverse}{Boolean indicating whether the palette should be reversed} - -\item{color_ramp_palette}{Should the output be a `grDevices::colorRampPalette` function or a vector of hex codes? Default to the latter with `FALSE`} - -\item{discrete}{Boolean. Discrete or not? Default to FALSE.} - -\item{n}{Number of colors in the palette. Default to 5. Passe to `viridis::magma()`} - -\item{...}{Other parameters to pass to `grDevices::colorRampPalette()`} -} -\value{ -A color palette -} -\description{ -Return function to interpolate a fallback palette base on viridis::magma() -} diff --git a/man/pal_impact.Rd b/man/pal_impact.Rd deleted file mode 100644 index a3a16a2..0000000 --- a/man/pal_impact.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/pal_impact.R -\name{pal_impact} -\alias{pal_impact} -\title{Return function to interpolate an IMPACT color palette} -\usage{ -pal_impact( - palette = "main", - reverse = FALSE, - color_ramp_palette = FALSE, - show_palettes = FALSE, - ... -) -} -\arguments{ -\item{palette}{Character name of a palette in IMPACT palettes} - -\item{reverse}{Boolean indicating whether the palette should be reversed} - -\item{color_ramp_palette}{Should the output be a `grDevices::colorRampPalette` function or a vector of hex codes? Default to the former with `TRUE`} - -\item{show_palettes}{Should the ouput be the set of palettes names to pick from? Default to `FALSE`} - -\item{...}{Additional arguments to pass to colorRampPalette()} -} -\value{ -A color palette -} -\description{ -Return function to interpolate an IMPACT color palette -} diff --git a/man/pal_reach.Rd b/man/pal_reach.Rd deleted file mode 100644 index 4d32f98..0000000 --- a/man/pal_reach.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/pal_reach.R -\name{pal_reach} -\alias{pal_reach} -\title{Return function to interpolate a REACH color palette} -\usage{ -pal_reach( - palette = "main", - reverse = FALSE, - color_ramp_palette = FALSE, - show_palettes = FALSE, - ... -) -} -\arguments{ -\item{palette}{Character name of a palette in REACH palettes} - -\item{reverse}{Boolean indicating whether the palette should be reversed} - -\item{color_ramp_palette}{Should the output be a `grDevices::colorRampPalette` function or a vector of hex codes? Default to the former with `TRUE`} - -\item{show_palettes}{Should the ouput be the set of palettes names to pick from? Default to `FALSE`} - -\item{...}{Additional arguments to pass to colorRampPalette()} -} -\value{ -A color palette -} -\description{ -Return function to interpolate a REACH color palette -} diff --git a/man/palette.Rd b/man/palette.Rd new file mode 100644 index 0000000..c17f4b5 --- /dev/null +++ b/man/palette.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/palette.R +\name{palette} +\alias{palette} +\title{Interpolate a color palette} +\usage{ +palette(palette = "cat_5_main", reverse = FALSE, show_palettes = FALSE, ...) +} +\arguments{ +\item{palette}{Character name of a palette in palettes} + +\item{reverse}{Boolean indicating whether the palette should be reversed} + +\item{show_palettes}{Should the ouput be the set of palettes names to pick from? Default to `FALSE`} + +\item{...}{Additional arguments to pass to colorRampPalette()} +} +\value{ +A color palette +} +\description{ +Interpolate a color palette +} diff --git a/man/palette_gen.Rd b/man/palette_gen.Rd new file mode 100644 index 0000000..3dec864 --- /dev/null +++ b/man/palette_gen.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/palette_gen.R +\name{palette_gen} +\alias{palette_gen} +\alias{palette_gen_categorical} +\alias{palette_gen_sequential} +\title{Generate color palettes} +\usage{ +palette_gen(palette, type, direction = 1, ...) + +palette_gen_categorical(palette = "branding_reach", direction = 1) + +palette_gen_sequential(palette = "seq_7_artichoke", direction = 1, ...) +} +\arguments{ +\item{palette}{Palette name from [palette()].} + +\item{type}{"categorical" or "sequential" or "divergent".} + +\item{direction}{1 or -1; should the order of colors be reversed?} + +\item{...}{Additional arguments to pass to [colorRampPalette()] when type is "continuous".} +} +\description{ +[palette_gen()] generates a color palette and let you choose whether continuous or discrete. [palette_gen_categorical()] and [palette_gen_sequential()] generates respectively discrete and continuous palettes. +} diff --git a/man/point.Rd b/man/point.Rd index fd2d5d0..fcf9760 100644 --- a/man/point.Rd +++ b/man/point.Rd @@ -8,17 +8,22 @@ point( df, x, y, - group = NULL, + group = "", + add_color = color("branding_reach_red"), flip = TRUE, alpha = 1, - size = 1, + size = 2, x_title = NULL, y_title = NULL, group_title = NULL, title = NULL, subtitle = NULL, caption = NULL, - theme = theme_reach() + theme_fun = theme_reach(grid_major_y = TRUE), + palette = "cat_5_ibm", + scale_impact = TRUE, + direction = 1, + reverse_guide = TRUE ) } \arguments{ @@ -26,10 +31,12 @@ point( \item{x}{A numeric column.} -\item{y}{A character column or coercible as a character column.} +\item{y}{Another numeric column.} \item{group}{Some grouping categorical column, e.g. administrative areas or population groups.} +\item{add_color}{Add a color to bars (if no grouping).} + \item{flip}{TRUE or FALSE. Default to TRUE or horizontal bar plot.} \item{alpha}{Fill transparency.} @@ -48,10 +55,9 @@ point( \item{caption}{Plot caption. Default to NULL.} -\item{theme}{Whatever theme. Default to theme_reach().} -} -\value{ -A bar chart +\item{theme_fun}{Whatever theme. Default to theme_reach(). NULL if no theming needed.} + +\item{scale_impact}{Use the package custom scales for fill and color.} } \description{ Simple point chart diff --git a/man/scale_color.Rd b/man/scale_color.Rd deleted file mode 100644 index ab17204..0000000 --- a/man/scale_color.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/scale.R -\name{scale_color} -\alias{scale_color} -\title{Color scale constructor for REACH or AGORA colors} -\usage{ -scale_color( - initiative = "reach", - palette = "main", - discrete = TRUE, - reverse = FALSE, - reverse_guide = TRUE, - ... -) -} -\arguments{ -\item{initiative}{Either "reach" or "agora" or "default".} - -\item{palette}{Palette name from `pal_reach()` or `pal_agora()`.} - -\item{discrete}{Boolean indicating whether color aesthetic is discrete or not.} - -\item{reverse}{Boolean indicating whether the palette should be reversed.} - -\item{reverse_guide}{Boolean indicating whether the guide should be reversed.} - -\item{...}{Additional arguments passed to discrete_scale() or -scale_fill_gradient(), used respectively when discrete is TRUE or FALSE.} -} -\value{ -A color scale for ggplot -} -\description{ -Color scale constructor for REACH or AGORA colors -} diff --git a/man/scale_color_visualizer_discrete.Rd b/man/scale_color_visualizer_discrete.Rd new file mode 100644 index 0000000..77efa1b --- /dev/null +++ b/man/scale_color_visualizer_discrete.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale.R +\name{scale_color_visualizer_discrete} +\alias{scale_color_visualizer_discrete} +\alias{scale_fill_visualizer_discrete} +\alias{scale_fill_visualizer_continuous} +\alias{scale_color_visualizer_continuous} +\title{Scale constructors} +\usage{ +scale_color_visualizer_discrete( + palette = "cat_5_main", + direction = 1, + reverse_guide = TRUE, + ... +) + +scale_fill_visualizer_discrete( + palette = "cat_5_main", + direction = 1, + reverse_guide = TRUE, + ... +) + +scale_fill_visualizer_continuous( + palette = "seq_5_main", + direction = 1, + reverse_guide = TRUE, + ... +) + +scale_color_visualizer_continuous( + palette = "seq_5_main", + direction = 1, + reverse_guide = TRUE, + ... +) +} +\arguments{ +\item{palette}{Palette name from [palette()].} + +\item{direction}{1 or -1; should the order of colors be reversed?} + +\item{reverse_guide}{Boolean indicating whether the guide should be reversed.} + +\item{...}{Additional arguments passed to [ggplot2::discrete_scale()] if discrete or [ggplot2::scale_fill_gradient()] if continuous.} +} +\description{ +Scale constructors +} diff --git a/man/scale_fill.Rd b/man/scale_fill.Rd deleted file mode 100644 index 95d3dc3..0000000 --- a/man/scale_fill.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/scale.R -\name{scale_fill} -\alias{scale_fill} -\title{Fill scale constructor for REACH or AGORA colors} -\usage{ -scale_fill( - initiative = "reach", - palette = "main", - discrete = TRUE, - reverse = FALSE, - reverse_guide = TRUE, - ... -) -} -\arguments{ -\item{initiative}{Either "reach" or "agora" or "default".} - -\item{palette}{Palette name from `pal_reach()` or `pal_agora()`.} - -\item{discrete}{Boolean indicating whether color aesthetic is discrete or not.} - -\item{reverse}{Boolean indicating whether the palette should be reversed.} - -\item{reverse_guide}{Boolean indicating whether the guide should be reversed.} - -\item{...}{Additional arguments passed to discrete_scale() or -scale_fill_gradient(), used respectively when discrete is TRUE or FALSE.} -} -\value{ -A fill scale for ggplot. -} -\description{ -Fill scale constructor for REACH or AGORA colors -} diff --git a/man/subvec_not_in.Rd b/man/subvec_not_in.Rd deleted file mode 100644 index 90d4d58..0000000 --- a/man/subvec_not_in.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/internals.R -\name{subvec_not_in} -\alias{subvec_not_in} -\title{Subvec not in} -\usage{ -subvec_not_in(vector, set) -} -\arguments{ -\item{vector}{A vector to subset} - -\item{set}{A set-vector} -} -\value{ -A subset of vector not in set -} -\description{ -Subvec not in -} diff --git a/man/theme_reach.Rd b/man/theme_reach.Rd index 8718dc6..df8048b 100644 --- a/man/theme_reach.Rd +++ b/man/theme_reach.Rd @@ -1,69 +1,65 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/theme_reach.R +% Please edit documentation in R/theme.R \name{theme_reach} \alias{theme_reach} -\title{ggplot2 theme with REACH color palettes} +\title{ggplot2 theme wrapper with REACH fonts and colors} \usage{ theme_reach( - initiative = "reach", - palette = "main", - discrete = TRUE, - reverse = FALSE, - font_family = "Segoe UI", - title_size = 12, - title_color = cols_reach("main_grey"), + font_family = "Carlito", + title_size = 16, + title_color = color("dark_grey"), title_font_face = "bold", title_hjust = NULL, title_position_to_plot = TRUE, - text_size = 10, - text_color = cols_reach("main_grey"), + title_font_family = "Carlito", + text_size = 14, + text_color = color("dark_grey"), text_font_face = "plain", panel_background_color = "#FFFFFF", panel_border = FALSE, - panel_border_color = cols_reach("main_grey"), - legend_position = "right", - legend_direction = "vertical", + panel_border_color = color("dark_grey"), + legend_position = "bottom", + legend_direction = "horizontal", + legend_justification = "left", legend_reverse = TRUE, - legend_title_size = 11, - legend_title_color = cols_reach("main_grey"), + legend_title_size = 14, + legend_title_color = color("dark_grey"), legend_title_font_face = "plain", - legend_text_size = 10, - legend_text_color = cols_reach("main_grey"), + legend_text_size = 12, + legend_text_color = color("dark_grey"), legend_text_font_face = "plain", axis_x = TRUE, axis_y = TRUE, - axis_text_size = 10, - axis_text_color = cols_reach("main_grey"), + axis_text_x = TRUE, + axis_line_x = TRUE, + axis_ticks_x = TRUE, + axis_text_y = TRUE, + axis_line_y = TRUE, + axis_ticks_y = TRUE, + axis_text_size = 14, + axis_text_color = color("dark_grey"), axis_text_font_face = "plain", - axis_title_size = 11, - axis_title_color = cols_reach("main_grey"), - axis_title_font_face = "bold", + axis_title_size = 15, + axis_title_color = color("dark_grey"), + axis_title_font_face = "plain", axis_text_x_angle = 0, axis_text_x_vjust = 0.5, axis_text_x_hjust = 0.5, - grid_major_x = FALSE, + grid_major_x = TRUE, grid_major_y = FALSE, - grid_major_color = cols_reach("main_lt_grey"), - grid_major_x_size = 0.1, - grid_major_y_size = 0.1, + grid_major_color = color("light_grey"), + grid_major_x_size = 0.01, + grid_major_y_size = 0.01, grid_minor_x = FALSE, grid_minor_y = FALSE, - grid_minor_color = cols_reach("main_lt_grey"), - grid_minor_x_size = 0.05, - grid_minor_y_size = 0.05, + grid_minor_color = color("light_grey"), + grid_minor_x_size = 0.005, + grid_minor_y_size = 0.005, caption_position_to_plot = TRUE, ... ) } \arguments{ -\item{initiative}{Either "reach" or "default".} - -\item{palette}{Palette name from 'pal_reach()'.} - -\item{discrete}{Boolean indicating whether color aesthetic is discrete or not.} - -\item{reverse}{Boolean indicating whether the palette should be reversed.} - \item{font_family}{The font family for all plot's texts. Default to "Segoe UI".} \item{title_size}{The size of the legend title. Defaults to 11.} @@ -76,6 +72,8 @@ theme_reach( \item{title_position_to_plot}{TRUE or FALSE. Positioning to plot or to panel?} +\item{title_font_family}{Title font family. Default to "Roboto Condensed".} + \item{text_size}{The size of all text other than the title, subtitle and caption. Defaults to 10.} \item{text_color}{Text color.} @@ -92,6 +90,8 @@ theme_reach( \item{legend_direction}{Direction of the legend. Default to "vertical". Can take "vertical" or "horizontal".} +\item{legend_justification}{In addition to legend_direction, place the legend. Can take "left", "bottom", "center", "right", "top".} + \item{legend_reverse}{Reverse the color in the guide? Default to TRUE.} \item{legend_title_size}{Legend title size.} @@ -110,6 +110,18 @@ theme_reach( \item{axis_y}{Boolean. Do you need y-axis?} +\item{axis_text_x}{Boolean. Do you need the text for the x-axis?} + +\item{axis_line_x}{Boolean. Do you need the line for the x-axis?} + +\item{axis_ticks_x}{Boolean. Do you need the line for the x-axis?} + +\item{axis_text_y}{Boolean. Do you need the text for the y-axis?} + +\item{axis_line_y}{Boolean. Do you need the line for the y-axis?} + +\item{axis_ticks_y}{Boolean. Do you need the line for the y-axis?} + \item{axis_text_size}{Axis text size.} \item{axis_text_color}{Axis text color.} @@ -150,10 +162,7 @@ theme_reach( \item{caption_position_to_plot}{TRUE or FALSE. Positioning to plot or to panel?} -\item{...}{Additional arguments passed to `ggplot2::gg_theme()`.} -} -\value{ -The base REACH theme +\item{...}{Additional arguments passed to [ggplot2::theme()].} } \description{ Give some reach colors and fonts to a ggplot. diff --git a/man/visualizeR-package.Rd b/man/visualizeR-package.Rd deleted file mode 100644 index 25e9400..0000000 --- a/man/visualizeR-package.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/visualizeR-package.R -\docType{package} -\name{visualizeR-package} -\alias{visualizeR} -\alias{visualizeR-package} -\title{visualizeR: What a color! What a viz!} -\description{ -\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} - -It basically provides colors as hex codes, color palettes, and some viz functions (graphs and maps). -} -\seealso{ -Useful links: -\itemize{ - \item \url{https://github.com/gnoblet/visualizeR} - \item \url{https://gnoblet.github.io/visualizeR/} -} - -} -\author{ -\strong{Maintainer}: Noblet Guillaume \email{gnoblet@zaclys.net} - -} -\keyword{internal} diff --git a/man/waffle.Rd b/man/waffle.Rd deleted file mode 100644 index a46d9aa..0000000 --- a/man/waffle.Rd +++ /dev/null @@ -1,53 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/waffle.R -\name{waffle} -\alias{waffle} -\title{Simple waffle chart} -\usage{ -waffle( - df, - x, - y, - n_rows = 10, - size = 2, - x_title = NULL, - x_lab = NULL, - title = NULL, - subtitle = NULL, - caption = NULL, - arrange = TRUE, - theme = theme_reach(axis_x = FALSE, axis_y = FALSE, legend_position = "bottom", - legend_direction = "horizontal", title_hjust = 0.5) -) -} -\arguments{ -\item{df}{A data frame.} - -\item{x}{A character column or coercible as a character column. Will give the waffle's fill color.} - -\item{y}{A numeric column (if plotting proportion, make sure to have percentages between 0 and 100 and not 0 and 1).} - -\item{n_rows}{Number of rows. Default to 10.} - -\item{size}{Width of the separator between blocks (defaults to 2).} - -\item{x_title}{The x scale title. Default to NULL.} - -\item{x_lab}{The x scale caption. Default to NULL.} - -\item{title}{Plot title. Default to NULL.} - -\item{subtitle}{Plot subtitle. Default to NULL.} - -\item{caption}{Plot caption. Default to NULL.} - -\item{arrange}{TRUE or FALSE. Arrange by highest percentage first.} - -\item{theme}{Whatever theme. Default to theme_reach().} -} -\value{ -A waffle chart -} -\description{ -Simple waffle chart -} diff --git a/renv.lock b/renv.lock new file mode 100644 index 0000000..787981d --- /dev/null +++ b/renv.lock @@ -0,0 +1,1909 @@ +{ + "R": { + "Version": "4.4.2", + "Repositories": [ + { + "Name": "CRAN", + "URL": "https://cran.rstudio.com" + } + ] + }, + "Packages": { + "DBI": { + "Package": "DBI", + "Version": "1.2.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "065ae649b05f1ff66bb0c793107508f5" + }, + "DT": { + "Package": "DT", + "Version": "0.33", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "crosstalk", + "htmltools", + "htmlwidgets", + "httpuv", + "jquerylib", + "jsonlite", + "magrittr", + "promises" + ], + "Hash": "64ff3427f559ce3f2597a4fe13255cb6" + }, + "KernSmooth": { + "Package": "KernSmooth", + "Version": "2.23-24", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "stats" + ], + "Hash": "9f33a1ee37bbe8919eb2ec4b9f2473a5" + }, + "MASS": { + "Package": "MASS", + "Version": "7.3-61", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "grDevices", + "graphics", + "methods", + "stats", + "utils" + ], + "Hash": "0cafd6f0500e5deba33be22c46bf6055" + }, + "Matrix": { + "Package": "Matrix", + "Version": "1.7-0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "graphics", + "grid", + "lattice", + "methods", + "stats", + "utils" + ], + "Hash": "1920b2f11133b12350024297d8a4ff4a" + }, + "R6": { + "Package": "R6", + "Version": "2.5.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "470851b6d5d0ac559e9d01bb352b4021" + }, + "RColorBrewer": { + "Package": "RColorBrewer", + "Version": "1.1-3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "45f0398006e83a5b10b72a90663d8d8c" + }, + "Rcpp": { + "Package": "Rcpp", + "Version": "1.0.13", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "methods", + "utils" + ], + "Hash": "f27411eb6d9c3dada5edd444b8416675" + }, + "Rttf2pt1": { + "Package": "Rttf2pt1", + "Version": "1.3.12", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "a60168d094ca7e4de5106d60001c3964" + }, + "XML": { + "Package": "XML", + "Version": "3.99-0.17", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods", + "utils" + ], + "Hash": "bc2a8a1139d8d4bd9c46086708945124" + }, + "abind": { + "Package": "abind", + "Version": "1.4-8", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods", + "utils" + ], + "Hash": "2288423bb0f20a457800d7fc47f6aa54" + }, + "askpass": { + "Package": "askpass", + "Version": "1.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "sys" + ], + "Hash": "c39f4155b3ceb1a9a2799d700fbd4b6a" + }, + "backports": { + "Package": "backports", + "Version": "1.5.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "e1e1b9d75c37401117b636b7ae50827a" + }, + "base64enc": { + "Package": "base64enc", + "Version": "0.1-3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "543776ae6848fde2f48ff3816d0628bc" + }, + "brio": { + "Package": "brio", + "Version": "1.1.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "c1ee497a6d999947c2c224ae46799b1a" + }, + "bslib": { + "Package": "bslib", + "Version": "0.8.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "base64enc", + "cachem", + "fastmap", + "grDevices", + "htmltools", + "jquerylib", + "jsonlite", + "lifecycle", + "memoise", + "mime", + "rlang", + "sass" + ], + "Hash": "b299c6741ca9746fb227debcb0f9fb6c" + }, + "cachem": { + "Package": "cachem", + "Version": "1.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "fastmap", + "rlang" + ], + "Hash": "cd9a672193789068eb5a2aad65a0dedf" + }, + "callr": { + "Package": "callr", + "Version": "3.7.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "processx", + "utils" + ], + "Hash": "d7e13f49c19103ece9e58ad2d83a7354" + }, + "checkmate": { + "Package": "checkmate", + "Version": "2.3.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "backports", + "utils" + ], + "Hash": "0e14e01ce07e7c88fd25de6d4260d26b" + }, + "class": { + "Package": "class", + "Version": "7.3-22", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "MASS", + "R", + "stats", + "utils" + ], + "Hash": "f91f6b29f38b8c280f2b9477787d4bb2" + }, + "classInt": { + "Package": "classInt", + "Version": "0.4-10", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "KernSmooth", + "R", + "class", + "e1071", + "grDevices", + "graphics", + "stats" + ], + "Hash": "f5a40793b1ae463a7ffb3902a95bf864" + }, + "cli": { + "Package": "cli", + "Version": "3.6.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "b21916dd77a27642b447374a5d30ecf3" + }, + "clipr": { + "Package": "clipr", + "Version": "0.8.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "utils" + ], + "Hash": "3f038e5ac7f41d4ac41ce658c85e3042" + }, + "colorspace": { + "Package": "colorspace", + "Version": "2.1-1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "graphics", + "methods", + "stats" + ], + "Hash": "d954cb1c57e8d8b756165d7ba18aa55a" + }, + "commonmark": { + "Package": "commonmark", + "Version": "1.9.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "14eb0596f987c71535d07c3aff814742" + }, + "cpp11": { + "Package": "cpp11", + "Version": "0.5.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "91570bba75d0c9d3f1040c835cee8fba" + }, + "crayon": { + "Package": "crayon", + "Version": "1.5.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "grDevices", + "methods", + "utils" + ], + "Hash": "859d96e65ef198fd43e82b9628d593ef" + }, + "credentials": { + "Package": "credentials", + "Version": "2.0.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "askpass", + "curl", + "jsonlite", + "openssl", + "sys" + ], + "Hash": "09fd631e607a236f8cc7f9604db32cb8" + }, + "crosstalk": { + "Package": "crosstalk", + "Version": "1.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R6", + "htmltools", + "jsonlite", + "lazyeval" + ], + "Hash": "ab12c7b080a57475248a30f4db6298c0" + }, + "curl": { + "Package": "curl", + "Version": "5.2.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "d91263322a58af798f6cf3b13fd56dde" + }, + "desc": { + "Package": "desc", + "Version": "1.4.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "cli", + "utils" + ], + "Hash": "99b79fcbd6c4d1ce087f5c5c758b384f" + }, + "dichromat": { + "Package": "dichromat", + "Version": "2.0-0.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "stats" + ], + "Hash": "16e66f2a483e124af5fc6582d26005f7" + }, + "digest": { + "Package": "digest", + "Version": "0.6.37", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "33698c4b3127fc9f506654607fb73676" + }, + "downlit": { + "Package": "downlit", + "Version": "0.4.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "brio", + "desc", + "digest", + "evaluate", + "fansi", + "memoise", + "rlang", + "vctrs", + "withr", + "yaml" + ], + "Hash": "45a6a596bf0108ee1ff16a040a2df897" + }, + "dplyr": { + "Package": "dplyr", + "Version": "1.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "cli", + "generics", + "glue", + "lifecycle", + "magrittr", + "methods", + "pillar", + "rlang", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "fedd9d00c2944ff00a0e2696ccf048ec" + }, + "e1071": { + "Package": "e1071", + "Version": "1.7-16", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "class", + "grDevices", + "graphics", + "methods", + "proxy", + "stats", + "utils" + ], + "Hash": "27a09ca40266a1066d62ef5402dd51d6" + }, + "evaluate": { + "Package": "evaluate", + "Version": "1.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "3fd29944b231036ad67c3edb32e02201" + }, + "extrafont": { + "Package": "extrafont", + "Version": "0.19", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rttf2pt1", + "extrafontdb", + "grDevices", + "utils" + ], + "Hash": "03d9939b37164f34e0522fef13e63158" + }, + "extrafontdb": { + "Package": "extrafontdb", + "Version": "1.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "a861555ddec7451c653b40e713166c6f" + }, + "fansi": { + "Package": "fansi", + "Version": "1.0.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "utils" + ], + "Hash": "962174cf2aeb5b9eea581522286a911f" + }, + "farver": { + "Package": "farver", + "Version": "2.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "680887028577f3fa2a81e410ed0d6e42" + }, + "fastmap": { + "Package": "fastmap", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "aa5e1cd11c2d15497494c5292d7ffcc8" + }, + "fontawesome": { + "Package": "fontawesome", + "Version": "0.5.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "htmltools", + "rlang" + ], + "Hash": "c2efdd5f0bcd1ea861c2d4e2a883a67d" + }, + "fs": { + "Package": "fs", + "Version": "1.6.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "15aeb8c27f5ea5161f9f6a641fafd93a" + }, + "generics": { + "Package": "generics", + "Version": "0.1.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "15e9634c0fcd294799e9b2e929ed1b86" + }, + "geojsonsf": { + "Package": "geojsonsf", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "geometries", + "jsonify", + "rapidjsonr", + "sfheaders" + ], + "Hash": "8d077646c6713838233e8710910ef92e" + }, + "geometries": { + "Package": "geometries", + "Version": "0.2.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "Rcpp" + ], + "Hash": "a722b946e99fd7a006ab1239c0d1b2bc" + }, + "gert": { + "Package": "gert", + "Version": "2.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "askpass", + "credentials", + "openssl", + "rstudioapi", + "sys", + "zip" + ], + "Hash": "ae855ad6d7be20dd7b05d43d25700398" + }, + "ggalluvial": { + "Package": "ggalluvial", + "Version": "0.12.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "dplyr", + "ggplot2", + "lazyeval", + "rlang", + "stats", + "tidyr", + "tidyselect" + ], + "Hash": "29bb601821609476215720798eecf979" + }, + "ggplot2": { + "Package": "ggplot2", + "Version": "3.5.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "MASS", + "R", + "cli", + "glue", + "grDevices", + "grid", + "gtable", + "isoband", + "lifecycle", + "mgcv", + "rlang", + "scales", + "stats", + "tibble", + "vctrs", + "withr" + ], + "Hash": "44c6a2f8202d5b7e878ea274b1092426" + }, + "ggrepel": { + "Package": "ggrepel", + "Version": "0.9.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "ggplot2", + "grid", + "rlang", + "scales", + "withr" + ], + "Hash": "3d4156850acc1161f2f24bc61c9217c1" + }, + "ggtext": { + "Package": "ggtext", + "Version": "0.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "ggplot2", + "grid", + "gridtext", + "rlang", + "scales" + ], + "Hash": "c5ba8f5056487403a299b91984be86ca" + }, + "gh": { + "Package": "gh", + "Version": "1.4.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "gitcreds", + "glue", + "httr2", + "ini", + "jsonlite", + "lifecycle", + "rlang" + ], + "Hash": "fbbbc48eba7a6626a08bb365e44b563b" + }, + "gitcreds": { + "Package": "gitcreds", + "Version": "0.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "ab08ac61f3e1be454ae21911eb8bc2fe" + }, + "glue": { + "Package": "glue", + "Version": "1.8.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "5899f1eaa825580172bb56c08266f37c" + }, + "gridExtra": { + "Package": "gridExtra", + "Version": "2.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "grDevices", + "graphics", + "grid", + "gtable", + "utils" + ], + "Hash": "7d7f283939f563670a697165b2cf5560" + }, + "gridtext": { + "Package": "gridtext", + "Version": "0.1.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "curl", + "grDevices", + "grid", + "jpeg", + "markdown", + "png", + "rlang", + "stringr", + "xml2" + ], + "Hash": "05e4f5fffb1eecfeaac9ea0b7f255fef" + }, + "gtable": { + "Package": "gtable", + "Version": "0.3.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "grid", + "lifecycle", + "rlang" + ], + "Hash": "e18861963cbc65a27736e02b3cd3c4a0" + }, + "highr": { + "Package": "highr", + "Version": "0.11", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "xfun" + ], + "Hash": "d65ba49117ca223614f71b60d85b8ab7" + }, + "htmltools": { + "Package": "htmltools", + "Version": "0.5.8.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "base64enc", + "digest", + "fastmap", + "grDevices", + "rlang", + "utils" + ], + "Hash": "81d371a9cc60640e74e4ab6ac46dcedc" + }, + "htmlwidgets": { + "Package": "htmlwidgets", + "Version": "1.6.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "grDevices", + "htmltools", + "jsonlite", + "knitr", + "rmarkdown", + "yaml" + ], + "Hash": "04291cc45198225444a397606810ac37" + }, + "httpuv": { + "Package": "httpuv", + "Version": "1.6.15", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "Rcpp", + "later", + "promises", + "utils" + ], + "Hash": "d55aa087c47a63ead0f6fc10f8fa1ee0" + }, + "httr2": { + "Package": "httr2", + "Version": "1.0.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "cli", + "curl", + "glue", + "lifecycle", + "magrittr", + "openssl", + "rappdirs", + "rlang", + "vctrs", + "withr" + ], + "Hash": "d84e4c33206aaace37714901ac2b00c3" + }, + "ini": { + "Package": "ini", + "Version": "0.3.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "6154ec2223172bce8162d4153cda21f7" + }, + "isoband": { + "Package": "isoband", + "Version": "0.2.7", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "grid", + "utils" + ], + "Hash": "0080607b4a1a7b28979aecef976d8bc2" + }, + "jpeg": { + "Package": "jpeg", + "Version": "0.1-10", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "031a0b683d001a7519202f0628fc0358" + }, + "jquerylib": { + "Package": "jquerylib", + "Version": "0.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "htmltools" + ], + "Hash": "5aab57a3bd297eee1c1d862735972182" + }, + "jsonify": { + "Package": "jsonify", + "Version": "1.2.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "rapidjsonr" + ], + "Hash": "49a9775e4f8c96c654b6018739067055" + }, + "jsonlite": { + "Package": "jsonlite", + "Version": "1.8.9", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "methods" + ], + "Hash": "4e993b65c2c3ffbffce7bb3e2c6f832b" + }, + "knitr": { + "Package": "knitr", + "Version": "1.48", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "evaluate", + "highr", + "methods", + "tools", + "xfun", + "yaml" + ], + "Hash": "acf380f300c721da9fde7df115a5f86f" + }, + "labeling": { + "Package": "labeling", + "Version": "0.4.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "graphics", + "stats" + ], + "Hash": "b64ec208ac5bc1852b285f665d6368b3" + }, + "later": { + "Package": "later", + "Version": "1.3.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "Rcpp", + "rlang" + ], + "Hash": "a3e051d405326b8b0012377434c62b37" + }, + "lattice": { + "Package": "lattice", + "Version": "0.22-6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "graphics", + "grid", + "stats", + "utils" + ], + "Hash": "cc5ac1ba4c238c7ca9fa6a87ca11a7e2" + }, + "lazyeval": { + "Package": "lazyeval", + "Version": "0.2.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "d908914ae53b04d4c0c0fd72ecc35370" + }, + "leafem": { + "Package": "leafem", + "Version": "0.2.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "base64enc", + "geojsonsf", + "htmltools", + "htmlwidgets", + "leaflet", + "methods", + "png", + "raster", + "sf" + ], + "Hash": "6b43f986a9a0c1c1810b2deec71bfdf2" + }, + "leaflet": { + "Package": "leaflet", + "Version": "2.2.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "RColorBrewer", + "crosstalk", + "htmltools", + "htmlwidgets", + "jquerylib", + "leaflet.providers", + "magrittr", + "methods", + "png", + "raster", + "scales", + "sp", + "stats", + "viridisLite", + "xfun" + ], + "Hash": "ca012d4a706e21ce217ba15f22d402b2" + }, + "leaflet.providers": { + "Package": "leaflet.providers", + "Version": "2.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "htmltools" + ], + "Hash": "c0b81ad9d5d932772f7a457ac398cf36" + }, + "leafsync": { + "Package": "leafsync", + "Version": "0.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "htmltools", + "htmlwidgets", + "leaflet", + "methods" + ], + "Hash": "819d7169c7d39f0f952473e943375da1" + }, + "lifecycle": { + "Package": "lifecycle", + "Version": "1.0.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "rlang" + ], + "Hash": "b8552d117e1b808b09a832f589b79035" + }, + "lwgeom": { + "Package": "lwgeom", + "Version": "0.2-14", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "sf", + "units" + ], + "Hash": "f1fb7cc9fc60f3b039201174268aaad9" + }, + "magrittr": { + "Package": "magrittr", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "7ce2733a9826b3aeb1775d56fd305472" + }, + "markdown": { + "Package": "markdown", + "Version": "1.13", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "commonmark", + "utils", + "xfun" + ], + "Hash": "074efab766a9d6360865ad39512f2a7e" + }, + "memoise": { + "Package": "memoise", + "Version": "2.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "cachem", + "rlang" + ], + "Hash": "e2817ccf4a065c5d9d7f2cfbe7c1d78c" + }, + "mgcv": { + "Package": "mgcv", + "Version": "1.9-1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "Matrix", + "R", + "graphics", + "methods", + "nlme", + "splines", + "stats", + "utils" + ], + "Hash": "110ee9d83b496279960e162ac97764ce" + }, + "mime": { + "Package": "mime", + "Version": "0.12", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "tools" + ], + "Hash": "18e9c28c1d3ca1560ce30658b22ce104" + }, + "munsell": { + "Package": "munsell", + "Version": "0.5.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "colorspace", + "methods" + ], + "Hash": "4fd8900853b746af55b81fda99da7695" + }, + "nlme": { + "Package": "nlme", + "Version": "3.1-166", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "graphics", + "lattice", + "stats", + "utils" + ], + "Hash": "ccbb8846be320b627e6aa2b4616a2ded" + }, + "openssl": { + "Package": "openssl", + "Version": "2.2.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "askpass" + ], + "Hash": "d413e0fef796c9401a4419485f709ca1" + }, + "palmerpenguins": { + "Package": "palmerpenguins", + "Version": "0.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "6c6861efbc13c1d543749e9c7be4a592" + }, + "pillar": { + "Package": "pillar", + "Version": "1.9.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "cli", + "fansi", + "glue", + "lifecycle", + "rlang", + "utf8", + "utils", + "vctrs" + ], + "Hash": "15da5a8412f317beeee6175fbc76f4bb" + }, + "pkgconfig": { + "Package": "pkgconfig", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "utils" + ], + "Hash": "01f28d4278f15c76cddbea05899c5d6f" + }, + "pkgdown": { + "Package": "pkgdown", + "Version": "2.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "bslib", + "callr", + "cli", + "desc", + "digest", + "downlit", + "fontawesome", + "fs", + "httr2", + "jsonlite", + "openssl", + "purrr", + "ragg", + "rlang", + "rmarkdown", + "tibble", + "whisker", + "withr", + "xml2", + "yaml" + ], + "Hash": "df2912d5873422b55a13002510f02c9f" + }, + "plyr": { + "Package": "plyr", + "Version": "1.8.9", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp" + ], + "Hash": "6b8177fd19982f0020743fadbfdbd933" + }, + "png": { + "Package": "png", + "Version": "0.1-8", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "bd54ba8a0a5faded999a7aab6e46b374" + }, + "processx": { + "Package": "processx", + "Version": "3.8.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "ps", + "utils" + ], + "Hash": "0c90a7d71988856bad2a2a45dd871bb9" + }, + "promises": { + "Package": "promises", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R6", + "Rcpp", + "fastmap", + "later", + "magrittr", + "rlang", + "stats" + ], + "Hash": "434cd5388a3979e74be5c219bcd6e77d" + }, + "proxy": { + "Package": "proxy", + "Version": "0.4-27", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "stats", + "utils" + ], + "Hash": "e0ef355c12942cf7a6b91a6cfaea8b3e" + }, + "ps": { + "Package": "ps", + "Version": "1.8.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "4b9c8485b0c7eecdf0a9ba5132a45576" + }, + "purrr": { + "Package": "purrr", + "Version": "1.0.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "lifecycle", + "magrittr", + "rlang", + "vctrs" + ], + "Hash": "1cba04a4e9414bdefc9dcaa99649a8dc" + }, + "ragg": { + "Package": "ragg", + "Version": "1.3.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "systemfonts", + "textshaping" + ], + "Hash": "0595fe5e47357111f29ad19101c7d271" + }, + "rapidjsonr": { + "Package": "rapidjsonr", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "88b9f48c93d17cdb811b54079a6a414f" + }, + "rappdirs": { + "Package": "rappdirs", + "Version": "0.3.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "5e3c5dc0b071b21fa128676560dbe94d" + }, + "raster": { + "Package": "raster", + "Version": "3.6-30", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "methods", + "sp", + "terra" + ], + "Hash": "0e2829df8cb74a98179c886b023ffea8" + }, + "renv": { + "Package": "renv", + "Version": "1.0.11", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "utils" + ], + "Hash": "47623f66b4e80b3b0587bc5d7b309888" + }, + "rlang": { + "Package": "rlang", + "Version": "1.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "3eec01f8b1dee337674b2e34ab1f9bc1" + }, + "rmarkdown": { + "Package": "rmarkdown", + "Version": "2.28", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "bslib", + "evaluate", + "fontawesome", + "htmltools", + "jquerylib", + "jsonlite", + "knitr", + "methods", + "tinytex", + "tools", + "utils", + "xfun", + "yaml" + ], + "Hash": "062470668513dcda416927085ee9bdc7" + }, + "rprojroot": { + "Package": "rprojroot", + "Version": "2.0.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "4c8415e0ec1e29f3f4f6fc108bef0144" + }, + "rstudioapi": { + "Package": "rstudioapi", + "Version": "0.17.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "fb9f5fce8f609e9b66f0bea5c783f88a" + }, + "s2": { + "Package": "s2", + "Version": "1.1.7", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "wk" + ], + "Hash": "3c8013cdd7f1d20de5762e3f97e5e274" + }, + "sass": { + "Package": "sass", + "Version": "0.4.9", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R6", + "fs", + "htmltools", + "rappdirs", + "rlang" + ], + "Hash": "d53dbfddf695303ea4ad66f86e99b95d" + }, + "scales": { + "Package": "scales", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "RColorBrewer", + "cli", + "farver", + "glue", + "labeling", + "lifecycle", + "munsell", + "rlang", + "viridisLite" + ], + "Hash": "c19df082ba346b0ffa6f833e92de34d1" + }, + "sf": { + "Package": "sf", + "Version": "1.0-18", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "DBI", + "R", + "Rcpp", + "classInt", + "grDevices", + "graphics", + "grid", + "magrittr", + "methods", + "s2", + "stats", + "tools", + "units", + "utils" + ], + "Hash": "801bec14b3bae0f37eef4d187ee0bb44" + }, + "sfheaders": { + "Package": "sfheaders", + "Version": "0.4.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "geometries" + ], + "Hash": "d63e904c63deda45f3f9149c7dcf8703" + }, + "sp": { + "Package": "sp", + "Version": "2.1-4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "graphics", + "grid", + "lattice", + "methods", + "stats", + "utils" + ], + "Hash": "75940133cca2e339afce15a586f85b11" + }, + "stars": { + "Package": "stars", + "Version": "0.6-6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "abind", + "classInt", + "methods", + "parallel", + "rlang", + "sf", + "units" + ], + "Hash": "379c270cf22c8394682d3acd5c62a3ef" + }, + "stringi": { + "Package": "stringi", + "Version": "1.8.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "stats", + "tools", + "utils" + ], + "Hash": "39e1144fd75428983dc3f63aa53dfa91" + }, + "stringr": { + "Package": "stringr", + "Version": "1.5.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "magrittr", + "rlang", + "stringi", + "vctrs" + ], + "Hash": "960e2ae9e09656611e0b8214ad543207" + }, + "sys": { + "Package": "sys", + "Version": "3.4.3", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "de342ebfebdbf40477d0758d05426646" + }, + "systemfonts": { + "Package": "systemfonts", + "Version": "1.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cpp11", + "lifecycle" + ], + "Hash": "213b6b8ed5afbf934843e6c3b090d418" + }, + "terra": { + "Package": "terra", + "Version": "1.7-83", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "methods" + ], + "Hash": "fbeffe988419d292225a57cf9c284802" + }, + "textshaping": { + "Package": "textshaping", + "Version": "0.4.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cpp11", + "lifecycle", + "systemfonts" + ], + "Hash": "5142f8bc78ed3d819d26461b641627ce" + }, + "tibble": { + "Package": "tibble", + "Version": "3.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "fansi", + "lifecycle", + "magrittr", + "methods", + "pillar", + "pkgconfig", + "rlang", + "utils", + "vctrs" + ], + "Hash": "a84e2cc86d07289b3b6f5069df7a004c" + }, + "tidyr": { + "Package": "tidyr", + "Version": "1.3.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "cpp11", + "dplyr", + "glue", + "lifecycle", + "magrittr", + "purrr", + "rlang", + "stringr", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "915fb7ce036c22a6a33b5a8adb712eb1" + }, + "tidyselect": { + "Package": "tidyselect", + "Version": "1.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang", + "vctrs", + "withr" + ], + "Hash": "829f27b9c4919c16b593794a6344d6c0" + }, + "tinytex": { + "Package": "tinytex", + "Version": "0.53", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "xfun" + ], + "Hash": "9db859e8aabbb474293dde3097839420" + }, + "tmap": { + "Package": "tmap", + "Version": "3.3-4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "RColorBrewer", + "abind", + "classInt", + "grid", + "htmltools", + "htmlwidgets", + "leafem", + "leaflet", + "leafsync", + "methods", + "rlang", + "sf", + "stars", + "stats", + "tmaptools", + "units", + "utils", + "viridisLite", + "widgetframe" + ], + "Hash": "c65363bc002492caf754352499ce2386" + }, + "tmaptools": { + "Package": "tmaptools", + "Version": "3.1-1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "RColorBrewer", + "XML", + "dichromat", + "grid", + "lwgeom", + "magrittr", + "methods", + "sf", + "stars", + "stats", + "units", + "viridisLite" + ], + "Hash": "dfcb77371df343b663d6668d2d63ac35" + }, + "units": { + "Package": "units", + "Version": "0.8-5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp" + ], + "Hash": "119d19da480e873f72241ff6962ffd83" + }, + "usethis": { + "Package": "usethis", + "Version": "3.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "clipr", + "crayon", + "curl", + "desc", + "fs", + "gert", + "gh", + "glue", + "jsonlite", + "lifecycle", + "purrr", + "rappdirs", + "rlang", + "rprojroot", + "rstudioapi", + "stats", + "utils", + "whisker", + "withr", + "yaml" + ], + "Hash": "b2fbf93c2127bedd2cbe9b799530d5d2" + }, + "utf8": { + "Package": "utf8", + "Version": "1.2.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "62b65c52671e6665f803ff02954446e9" + }, + "vctrs": { + "Package": "vctrs", + "Version": "0.6.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang" + ], + "Hash": "c03fa420630029418f7e6da3667aac4a" + }, + "viridisLite": { + "Package": "viridisLite", + "Version": "0.4.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "c826c7c4241b6fc89ff55aaea3fa7491" + }, + "waffle": { + "Package": "waffle", + "Version": "1.0.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "DT", + "R", + "RColorBrewer", + "curl", + "extrafont", + "ggplot2", + "grid", + "gridExtra", + "gtable", + "htmlwidgets", + "plyr", + "rlang", + "stats", + "stringr", + "utils" + ], + "Hash": "b4a5d1a3036a7e6a63439b16b3ad39fc" + }, + "whisker": { + "Package": "whisker", + "Version": "0.4.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "c6abfa47a46d281a7d5159d0a8891e88" + }, + "widgetframe": { + "Package": "widgetframe", + "Version": "0.3.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "htmltools", + "htmlwidgets", + "magrittr", + "purrr", + "tools", + "utils" + ], + "Hash": "0ee89e6cb58182d39b30a5b506e04808" + }, + "withr": { + "Package": "withr", + "Version": "3.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "graphics" + ], + "Hash": "07909200e8bbe90426fbfeb73e1e27aa" + }, + "wk": { + "Package": "wk", + "Version": "0.9.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "37be35d733130f1de1ef51672cf7cdc0" + }, + "xfun": { + "Package": "xfun", + "Version": "0.48", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "stats", + "tools" + ], + "Hash": "89e455b87c84e227eb7f60a1b4e5fe1f" + }, + "xml2": { + "Package": "xml2", + "Version": "1.3.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "methods", + "rlang" + ], + "Hash": "1d0336142f4cd25d8d23cd3ba7a8fb61" + }, + "yaml": { + "Package": "yaml", + "Version": "2.3.10", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "51dab85c6c98e50a18d7551e9d49f76c" + }, + "zip": { + "Package": "zip", + "Version": "2.3.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "fcc4bd8e6da2d2011eb64a5e5cc685ab" + } + } +} diff --git a/renv/.gitignore b/renv/.gitignore new file mode 100644 index 0000000..0ec0cbb --- /dev/null +++ b/renv/.gitignore @@ -0,0 +1,7 @@ +library/ +local/ +cellar/ +lock/ +python/ +sandbox/ +staging/ diff --git a/renv/activate.R b/renv/activate.R new file mode 100644 index 0000000..0eb5108 --- /dev/null +++ b/renv/activate.R @@ -0,0 +1,1305 @@ + +local({ + + # the requested version of renv + version <- "1.0.11" + attr(version, "sha") <- NULL + + # the project directory + project <- Sys.getenv("RENV_PROJECT") + if (!nzchar(project)) + project <- getwd() + + # use start-up diagnostics if enabled + diagnostics <- Sys.getenv("RENV_STARTUP_DIAGNOSTICS", unset = "FALSE") + if (diagnostics) { + start <- Sys.time() + profile <- tempfile("renv-startup-", fileext = ".Rprof") + utils::Rprof(profile) + on.exit({ + utils::Rprof(NULL) + elapsed <- signif(difftime(Sys.time(), start, units = "auto"), digits = 2L) + writeLines(sprintf("- renv took %s to run the autoloader.", format(elapsed))) + writeLines(sprintf("- Profile: %s", profile)) + print(utils::summaryRprof(profile)) + }, add = TRUE) + } + + # figure out whether the autoloader is enabled + enabled <- local({ + + # first, check config option + override <- getOption("renv.config.autoloader.enabled") + if (!is.null(override)) + return(override) + + # if we're being run in a context where R_LIBS is already set, + # don't load -- presumably we're being run as a sub-process and + # the parent process has already set up library paths for us + rcmd <- Sys.getenv("R_CMD", unset = NA) + rlibs <- Sys.getenv("R_LIBS", unset = NA) + if (!is.na(rlibs) && !is.na(rcmd)) + return(FALSE) + + # next, check environment variables + # TODO: prefer using the configuration one in the future + envvars <- c( + "RENV_CONFIG_AUTOLOADER_ENABLED", + "RENV_AUTOLOADER_ENABLED", + "RENV_ACTIVATE_PROJECT" + ) + + for (envvar in envvars) { + envval <- Sys.getenv(envvar, unset = NA) + if (!is.na(envval)) + return(tolower(envval) %in% c("true", "t", "1")) + } + + # enable by default + TRUE + + }) + + # bail if we're not enabled + if (!enabled) { + + # if we're not enabled, we might still need to manually load + # the user profile here + profile <- Sys.getenv("R_PROFILE_USER", unset = "~/.Rprofile") + if (file.exists(profile)) { + cfg <- Sys.getenv("RENV_CONFIG_USER_PROFILE", unset = "TRUE") + if (tolower(cfg) %in% c("true", "t", "1")) + sys.source(profile, envir = globalenv()) + } + + return(FALSE) + + } + + # avoid recursion + if (identical(getOption("renv.autoloader.running"), TRUE)) { + warning("ignoring recursive attempt to run renv autoloader") + return(invisible(TRUE)) + } + + # signal that we're loading renv during R startup + options(renv.autoloader.running = TRUE) + on.exit(options(renv.autoloader.running = NULL), add = TRUE) + + # signal that we've consented to use renv + options(renv.consent = TRUE) + + # load the 'utils' package eagerly -- this ensures that renv shims, which + # mask 'utils' packages, will come first on the search path + library(utils, lib.loc = .Library) + + # unload renv if it's already been loaded + if ("renv" %in% loadedNamespaces()) + unloadNamespace("renv") + + # load bootstrap tools + ansify <- function(text) { + if (renv_ansify_enabled()) + renv_ansify_enhanced(text) + else + renv_ansify_default(text) + } + + renv_ansify_enabled <- function() { + + override <- Sys.getenv("RENV_ANSIFY_ENABLED", unset = NA) + if (!is.na(override)) + return(as.logical(override)) + + pane <- Sys.getenv("RSTUDIO_CHILD_PROCESS_PANE", unset = NA) + if (identical(pane, "build")) + return(FALSE) + + testthat <- Sys.getenv("TESTTHAT", unset = "false") + if (tolower(testthat) %in% "true") + return(FALSE) + + iderun <- Sys.getenv("R_CLI_HAS_HYPERLINK_IDE_RUN", unset = "false") + if (tolower(iderun) %in% "false") + return(FALSE) + + TRUE + + } + + renv_ansify_default <- function(text) { + text + } + + renv_ansify_enhanced <- function(text) { + + # R help links + pattern <- "`\\?(renv::(?:[^`])+)`" + replacement <- "`\033]8;;ide:help:\\1\a?\\1\033]8;;\a`" + text <- gsub(pattern, replacement, text, perl = TRUE) + + # runnable code + pattern <- "`(renv::(?:[^`])+)`" + replacement <- "`\033]8;;ide:run:\\1\a\\1\033]8;;\a`" + text <- gsub(pattern, replacement, text, perl = TRUE) + + # return ansified text + text + + } + + renv_ansify_init <- function() { + + envir <- renv_envir_self() + if (renv_ansify_enabled()) + assign("ansify", renv_ansify_enhanced, envir = envir) + else + assign("ansify", renv_ansify_default, envir = envir) + + } + + `%||%` <- function(x, y) { + if (is.null(x)) y else x + } + + catf <- function(fmt, ..., appendLF = TRUE) { + + quiet <- getOption("renv.bootstrap.quiet", default = FALSE) + if (quiet) + return(invisible()) + + msg <- sprintf(fmt, ...) + cat(msg, file = stdout(), sep = if (appendLF) "\n" else "") + + invisible(msg) + + } + + header <- function(label, + ..., + prefix = "#", + suffix = "-", + n = min(getOption("width"), 78)) + { + label <- sprintf(label, ...) + n <- max(n - nchar(label) - nchar(prefix) - 2L, 8L) + if (n <= 0) + return(paste(prefix, label)) + + tail <- paste(rep.int(suffix, n), collapse = "") + paste0(prefix, " ", label, " ", tail) + + } + + heredoc <- function(text, leave = 0) { + + # remove leading, trailing whitespace + trimmed <- gsub("^\\s*\\n|\\n\\s*$", "", text) + + # split into lines + lines <- strsplit(trimmed, "\n", fixed = TRUE)[[1L]] + + # compute common indent + indent <- regexpr("[^[:space:]]", lines) + common <- min(setdiff(indent, -1L)) - leave + text <- paste(substring(lines, common), collapse = "\n") + + # substitute in ANSI links for executable renv code + ansify(text) + + } + + startswith <- function(string, prefix) { + substring(string, 1, nchar(prefix)) == prefix + } + + bootstrap <- function(version, library) { + + friendly <- renv_bootstrap_version_friendly(version) + section <- header(sprintf("Bootstrapping renv %s", friendly)) + catf(section) + + # attempt to download renv + catf("- Downloading renv ... ", appendLF = FALSE) + withCallingHandlers( + tarball <- renv_bootstrap_download(version), + error = function(err) { + catf("FAILED") + stop("failed to download:\n", conditionMessage(err)) + } + ) + catf("OK") + on.exit(unlink(tarball), add = TRUE) + + # now attempt to install + catf("- Installing renv ... ", appendLF = FALSE) + withCallingHandlers( + status <- renv_bootstrap_install(version, tarball, library), + error = function(err) { + catf("FAILED") + stop("failed to install:\n", conditionMessage(err)) + } + ) + catf("OK") + + # add empty line to break up bootstrapping from normal output + catf("") + + return(invisible()) + } + + renv_bootstrap_tests_running <- function() { + getOption("renv.tests.running", default = FALSE) + } + + renv_bootstrap_repos <- function() { + + # get CRAN repository + cran <- getOption("renv.repos.cran", "https://cloud.r-project.org") + + # check for repos override + repos <- Sys.getenv("RENV_CONFIG_REPOS_OVERRIDE", unset = NA) + if (!is.na(repos)) { + + # check for RSPM; if set, use a fallback repository for renv + rspm <- Sys.getenv("RSPM", unset = NA) + if (identical(rspm, repos)) + repos <- c(RSPM = rspm, CRAN = cran) + + return(repos) + + } + + # check for lockfile repositories + repos <- tryCatch(renv_bootstrap_repos_lockfile(), error = identity) + if (!inherits(repos, "error") && length(repos)) + return(repos) + + # retrieve current repos + repos <- getOption("repos") + + # ensure @CRAN@ entries are resolved + repos[repos == "@CRAN@"] <- cran + + # add in renv.bootstrap.repos if set + default <- c(FALLBACK = "https://cloud.r-project.org") + extra <- getOption("renv.bootstrap.repos", default = default) + repos <- c(repos, extra) + + # remove duplicates that might've snuck in + dupes <- duplicated(repos) | duplicated(names(repos)) + repos[!dupes] + + } + + renv_bootstrap_repos_lockfile <- function() { + + lockpath <- Sys.getenv("RENV_PATHS_LOCKFILE", unset = "renv.lock") + if (!file.exists(lockpath)) + return(NULL) + + lockfile <- tryCatch(renv_json_read(lockpath), error = identity) + if (inherits(lockfile, "error")) { + warning(lockfile) + return(NULL) + } + + repos <- lockfile$R$Repositories + if (length(repos) == 0) + return(NULL) + + keys <- vapply(repos, `[[`, "Name", FUN.VALUE = character(1)) + vals <- vapply(repos, `[[`, "URL", FUN.VALUE = character(1)) + names(vals) <- keys + + return(vals) + + } + + renv_bootstrap_download <- function(version) { + + sha <- attr(version, "sha", exact = TRUE) + + methods <- if (!is.null(sha)) { + + # attempting to bootstrap a development version of renv + c( + function() renv_bootstrap_download_tarball(sha), + function() renv_bootstrap_download_github(sha) + ) + + } else { + + # attempting to bootstrap a release version of renv + c( + function() renv_bootstrap_download_tarball(version), + function() renv_bootstrap_download_cran_latest(version), + function() renv_bootstrap_download_cran_archive(version) + ) + + } + + for (method in methods) { + path <- tryCatch(method(), error = identity) + if (is.character(path) && file.exists(path)) + return(path) + } + + stop("All download methods failed") + + } + + renv_bootstrap_download_impl <- function(url, destfile) { + + mode <- "wb" + + # https://bugs.r-project.org/bugzilla/show_bug.cgi?id=17715 + fixup <- + Sys.info()[["sysname"]] == "Windows" && + substring(url, 1L, 5L) == "file:" + + if (fixup) + mode <- "w+b" + + args <- list( + url = url, + destfile = destfile, + mode = mode, + quiet = TRUE + ) + + if ("headers" %in% names(formals(utils::download.file))) { + headers <- renv_bootstrap_download_custom_headers(url) + if (length(headers) && is.character(headers)) + args$headers <- headers + } + + do.call(utils::download.file, args) + + } + + renv_bootstrap_download_custom_headers <- function(url) { + + headers <- getOption("renv.download.headers") + if (is.null(headers)) + return(character()) + + if (!is.function(headers)) + stopf("'renv.download.headers' is not a function") + + headers <- headers(url) + if (length(headers) == 0L) + return(character()) + + if (is.list(headers)) + headers <- unlist(headers, recursive = FALSE, use.names = TRUE) + + ok <- + is.character(headers) && + is.character(names(headers)) && + all(nzchar(names(headers))) + + if (!ok) + stop("invocation of 'renv.download.headers' did not return a named character vector") + + headers + + } + + renv_bootstrap_download_cran_latest <- function(version) { + + spec <- renv_bootstrap_download_cran_latest_find(version) + type <- spec$type + repos <- spec$repos + + baseurl <- utils::contrib.url(repos = repos, type = type) + ext <- if (identical(type, "source")) + ".tar.gz" + else if (Sys.info()[["sysname"]] == "Windows") + ".zip" + else + ".tgz" + name <- sprintf("renv_%s%s", version, ext) + url <- paste(baseurl, name, sep = "/") + + destfile <- file.path(tempdir(), name) + status <- tryCatch( + renv_bootstrap_download_impl(url, destfile), + condition = identity + ) + + if (inherits(status, "condition")) + return(FALSE) + + # report success and return + destfile + + } + + renv_bootstrap_download_cran_latest_find <- function(version) { + + # check whether binaries are supported on this system + binary <- + getOption("renv.bootstrap.binary", default = TRUE) && + !identical(.Platform$pkgType, "source") && + !identical(getOption("pkgType"), "source") && + Sys.info()[["sysname"]] %in% c("Darwin", "Windows") + + types <- c(if (binary) "binary", "source") + + # iterate over types + repositories + for (type in types) { + for (repos in renv_bootstrap_repos()) { + + # build arguments for utils::available.packages() call + args <- list(type = type, repos = repos) + + # add custom headers if available -- note that + # utils::available.packages() will pass this to download.file() + if ("headers" %in% names(formals(utils::download.file))) { + headers <- renv_bootstrap_download_custom_headers(repos) + if (length(headers) && is.character(headers)) + args$headers <- headers + } + + # retrieve package database + db <- tryCatch( + as.data.frame( + do.call(utils::available.packages, args), + stringsAsFactors = FALSE + ), + error = identity + ) + + if (inherits(db, "error")) + next + + # check for compatible entry + entry <- db[db$Package %in% "renv" & db$Version %in% version, ] + if (nrow(entry) == 0) + next + + # found it; return spec to caller + spec <- list(entry = entry, type = type, repos = repos) + return(spec) + + } + } + + # if we got here, we failed to find renv + fmt <- "renv %s is not available from your declared package repositories" + stop(sprintf(fmt, version)) + + } + + renv_bootstrap_download_cran_archive <- function(version) { + + name <- sprintf("renv_%s.tar.gz", version) + repos <- renv_bootstrap_repos() + urls <- file.path(repos, "src/contrib/Archive/renv", name) + destfile <- file.path(tempdir(), name) + + for (url in urls) { + + status <- tryCatch( + renv_bootstrap_download_impl(url, destfile), + condition = identity + ) + + if (identical(status, 0L)) + return(destfile) + + } + + return(FALSE) + + } + + renv_bootstrap_download_tarball <- function(version) { + + # if the user has provided the path to a tarball via + # an environment variable, then use it + tarball <- Sys.getenv("RENV_BOOTSTRAP_TARBALL", unset = NA) + if (is.na(tarball)) + return() + + # allow directories + if (dir.exists(tarball)) { + name <- sprintf("renv_%s.tar.gz", version) + tarball <- file.path(tarball, name) + } + + # bail if it doesn't exist + if (!file.exists(tarball)) { + + # let the user know we weren't able to honour their request + fmt <- "- RENV_BOOTSTRAP_TARBALL is set (%s) but does not exist." + msg <- sprintf(fmt, tarball) + warning(msg) + + # bail + return() + + } + + catf("- Using local tarball '%s'.", tarball) + tarball + + } + + renv_bootstrap_github_token <- function() { + for (envvar in c("GITHUB_TOKEN", "GITHUB_PAT", "GH_TOKEN")) { + envval <- Sys.getenv(envvar, unset = NA) + if (!is.na(envval)) + return(envval) + } + } + + renv_bootstrap_download_github <- function(version) { + + enabled <- Sys.getenv("RENV_BOOTSTRAP_FROM_GITHUB", unset = "TRUE") + if (!identical(enabled, "TRUE")) + return(FALSE) + + # prepare download options + token <- renv_bootstrap_github_token() + if (nzchar(Sys.which("curl")) && nzchar(token)) { + fmt <- "--location --fail --header \"Authorization: token %s\"" + extra <- sprintf(fmt, token) + saved <- options("download.file.method", "download.file.extra") + options(download.file.method = "curl", download.file.extra = extra) + on.exit(do.call(base::options, saved), add = TRUE) + } else if (nzchar(Sys.which("wget")) && nzchar(token)) { + fmt <- "--header=\"Authorization: token %s\"" + extra <- sprintf(fmt, token) + saved <- options("download.file.method", "download.file.extra") + options(download.file.method = "wget", download.file.extra = extra) + on.exit(do.call(base::options, saved), add = TRUE) + } + + url <- file.path("https://api.github.com/repos/rstudio/renv/tarball", version) + name <- sprintf("renv_%s.tar.gz", version) + destfile <- file.path(tempdir(), name) + + status <- tryCatch( + renv_bootstrap_download_impl(url, destfile), + condition = identity + ) + + if (!identical(status, 0L)) + return(FALSE) + + renv_bootstrap_download_augment(destfile) + + return(destfile) + + } + + # Add Sha to DESCRIPTION. This is stop gap until #890, after which we + # can use renv::install() to fully capture metadata. + renv_bootstrap_download_augment <- function(destfile) { + sha <- renv_bootstrap_git_extract_sha1_tar(destfile) + if (is.null(sha)) { + return() + } + + # Untar + tempdir <- tempfile("renv-github-") + on.exit(unlink(tempdir, recursive = TRUE), add = TRUE) + untar(destfile, exdir = tempdir) + pkgdir <- dir(tempdir, full.names = TRUE)[[1]] + + # Modify description + desc_path <- file.path(pkgdir, "DESCRIPTION") + desc_lines <- readLines(desc_path) + remotes_fields <- c( + "RemoteType: github", + "RemoteHost: api.github.com", + "RemoteRepo: renv", + "RemoteUsername: rstudio", + "RemotePkgRef: rstudio/renv", + paste("RemoteRef: ", sha), + paste("RemoteSha: ", sha) + ) + writeLines(c(desc_lines[desc_lines != ""], remotes_fields), con = desc_path) + + # Re-tar + local({ + old <- setwd(tempdir) + on.exit(setwd(old), add = TRUE) + + tar(destfile, compression = "gzip") + }) + invisible() + } + + # Extract the commit hash from a git archive. Git archives include the SHA1 + # hash as the comment field of the tarball pax extended header + # (see https://www.kernel.org/pub/software/scm/git/docs/git-archive.html) + # For GitHub archives this should be the first header after the default one + # (512 byte) header. + renv_bootstrap_git_extract_sha1_tar <- function(bundle) { + + # open the bundle for reading + # We use gzcon for everything because (from ?gzcon) + # > Reading from a connection which does not supply a 'gzip' magic + # > header is equivalent to reading from the original connection + conn <- gzcon(file(bundle, open = "rb", raw = TRUE)) + on.exit(close(conn)) + + # The default pax header is 512 bytes long and the first pax extended header + # with the comment should be 51 bytes long + # `52 comment=` (11 chars) + 40 byte SHA1 hash + len <- 0x200 + 0x33 + res <- rawToChar(readBin(conn, "raw", n = len)[0x201:len]) + + if (grepl("^52 comment=", res)) { + sub("52 comment=", "", res) + } else { + NULL + } + } + + renv_bootstrap_install <- function(version, tarball, library) { + + # attempt to install it into project library + dir.create(library, showWarnings = FALSE, recursive = TRUE) + output <- renv_bootstrap_install_impl(library, tarball) + + # check for successful install + status <- attr(output, "status") + if (is.null(status) || identical(status, 0L)) + return(status) + + # an error occurred; report it + header <- "installation of renv failed" + lines <- paste(rep.int("=", nchar(header)), collapse = "") + text <- paste(c(header, lines, output), collapse = "\n") + stop(text) + + } + + renv_bootstrap_install_impl <- function(library, tarball) { + + # invoke using system2 so we can capture and report output + bin <- R.home("bin") + exe <- if (Sys.info()[["sysname"]] == "Windows") "R.exe" else "R" + R <- file.path(bin, exe) + + args <- c( + "--vanilla", "CMD", "INSTALL", "--no-multiarch", + "-l", shQuote(path.expand(library)), + shQuote(path.expand(tarball)) + ) + + system2(R, args, stdout = TRUE, stderr = TRUE) + + } + + renv_bootstrap_platform_prefix <- function() { + + # construct version prefix + version <- paste(R.version$major, R.version$minor, sep = ".") + prefix <- paste("R", numeric_version(version)[1, 1:2], sep = "-") + + # include SVN revision for development versions of R + # (to avoid sharing platform-specific artefacts with released versions of R) + devel <- + identical(R.version[["status"]], "Under development (unstable)") || + identical(R.version[["nickname"]], "Unsuffered Consequences") + + if (devel) + prefix <- paste(prefix, R.version[["svn rev"]], sep = "-r") + + # build list of path components + components <- c(prefix, R.version$platform) + + # include prefix if provided by user + prefix <- renv_bootstrap_platform_prefix_impl() + if (!is.na(prefix) && nzchar(prefix)) + components <- c(prefix, components) + + # build prefix + paste(components, collapse = "/") + + } + + renv_bootstrap_platform_prefix_impl <- function() { + + # if an explicit prefix has been supplied, use it + prefix <- Sys.getenv("RENV_PATHS_PREFIX", unset = NA) + if (!is.na(prefix)) + return(prefix) + + # if the user has requested an automatic prefix, generate it + auto <- Sys.getenv("RENV_PATHS_PREFIX_AUTO", unset = NA) + if (is.na(auto) && getRversion() >= "4.4.0") + auto <- "TRUE" + + if (auto %in% c("TRUE", "True", "true", "1")) + return(renv_bootstrap_platform_prefix_auto()) + + # empty string on failure + "" + + } + + renv_bootstrap_platform_prefix_auto <- function() { + + prefix <- tryCatch(renv_bootstrap_platform_os(), error = identity) + if (inherits(prefix, "error") || prefix %in% "unknown") { + + msg <- paste( + "failed to infer current operating system", + "please file a bug report at https://github.com/rstudio/renv/issues", + sep = "; " + ) + + warning(msg) + + } + + prefix + + } + + renv_bootstrap_platform_os <- function() { + + sysinfo <- Sys.info() + sysname <- sysinfo[["sysname"]] + + # handle Windows + macOS up front + if (sysname == "Windows") + return("windows") + else if (sysname == "Darwin") + return("macos") + + # check for os-release files + for (file in c("/etc/os-release", "/usr/lib/os-release")) + if (file.exists(file)) + return(renv_bootstrap_platform_os_via_os_release(file, sysinfo)) + + # check for redhat-release files + if (file.exists("/etc/redhat-release")) + return(renv_bootstrap_platform_os_via_redhat_release()) + + "unknown" + + } + + renv_bootstrap_platform_os_via_os_release <- function(file, sysinfo) { + + # read /etc/os-release + release <- utils::read.table( + file = file, + sep = "=", + quote = c("\"", "'"), + col.names = c("Key", "Value"), + comment.char = "#", + stringsAsFactors = FALSE + ) + + vars <- as.list(release$Value) + names(vars) <- release$Key + + # get os name + os <- tolower(sysinfo[["sysname"]]) + + # read id + id <- "unknown" + for (field in c("ID", "ID_LIKE")) { + if (field %in% names(vars) && nzchar(vars[[field]])) { + id <- vars[[field]] + break + } + } + + # read version + version <- "unknown" + for (field in c("UBUNTU_CODENAME", "VERSION_CODENAME", "VERSION_ID", "BUILD_ID")) { + if (field %in% names(vars) && nzchar(vars[[field]])) { + version <- vars[[field]] + break + } + } + + # join together + paste(c(os, id, version), collapse = "-") + + } + + renv_bootstrap_platform_os_via_redhat_release <- function() { + + # read /etc/redhat-release + contents <- readLines("/etc/redhat-release", warn = FALSE) + + # infer id + id <- if (grepl("centos", contents, ignore.case = TRUE)) + "centos" + else if (grepl("redhat", contents, ignore.case = TRUE)) + "redhat" + else + "unknown" + + # try to find a version component (very hacky) + version <- "unknown" + + parts <- strsplit(contents, "[[:space:]]")[[1L]] + for (part in parts) { + + nv <- tryCatch(numeric_version(part), error = identity) + if (inherits(nv, "error")) + next + + version <- nv[1, 1] + break + + } + + paste(c("linux", id, version), collapse = "-") + + } + + renv_bootstrap_library_root_name <- function(project) { + + # use project name as-is if requested + asis <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT_ASIS", unset = "FALSE") + if (asis) + return(basename(project)) + + # otherwise, disambiguate based on project's path + id <- substring(renv_bootstrap_hash_text(project), 1L, 8L) + paste(basename(project), id, sep = "-") + + } + + renv_bootstrap_library_root <- function(project) { + + prefix <- renv_bootstrap_profile_prefix() + + path <- Sys.getenv("RENV_PATHS_LIBRARY", unset = NA) + if (!is.na(path)) + return(paste(c(path, prefix), collapse = "/")) + + path <- renv_bootstrap_library_root_impl(project) + if (!is.null(path)) { + name <- renv_bootstrap_library_root_name(project) + return(paste(c(path, prefix, name), collapse = "/")) + } + + renv_bootstrap_paths_renv("library", project = project) + + } + + renv_bootstrap_library_root_impl <- function(project) { + + root <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT", unset = NA) + if (!is.na(root)) + return(root) + + type <- renv_bootstrap_project_type(project) + if (identical(type, "package")) { + userdir <- renv_bootstrap_user_dir() + return(file.path(userdir, "library")) + } + + } + + renv_bootstrap_validate_version <- function(version, description = NULL) { + + # resolve description file + # + # avoid passing lib.loc to `packageDescription()` below, since R will + # use the loaded version of the package by default anyhow. note that + # this function should only be called after 'renv' is loaded + # https://github.com/rstudio/renv/issues/1625 + description <- description %||% packageDescription("renv") + + # check whether requested version 'version' matches loaded version of renv + sha <- attr(version, "sha", exact = TRUE) + valid <- if (!is.null(sha)) + renv_bootstrap_validate_version_dev(sha, description) + else + renv_bootstrap_validate_version_release(version, description) + + if (valid) + return(TRUE) + + # the loaded version of renv doesn't match the requested version; + # give the user instructions on how to proceed + dev <- identical(description[["RemoteType"]], "github") + remote <- if (dev) + paste("rstudio/renv", description[["RemoteSha"]], sep = "@") + else + paste("renv", description[["Version"]], sep = "@") + + # display both loaded version + sha if available + friendly <- renv_bootstrap_version_friendly( + version = description[["Version"]], + sha = if (dev) description[["RemoteSha"]] + ) + + fmt <- heredoc(" + renv %1$s was loaded from project library, but this project is configured to use renv %2$s. + - Use `renv::record(\"%3$s\")` to record renv %1$s in the lockfile. + - Use `renv::restore(packages = \"renv\")` to install renv %2$s into the project library. + ") + catf(fmt, friendly, renv_bootstrap_version_friendly(version), remote) + + FALSE + + } + + renv_bootstrap_validate_version_dev <- function(version, description) { + expected <- description[["RemoteSha"]] + is.character(expected) && startswith(expected, version) + } + + renv_bootstrap_validate_version_release <- function(version, description) { + expected <- description[["Version"]] + is.character(expected) && identical(expected, version) + } + + renv_bootstrap_hash_text <- function(text) { + + hashfile <- tempfile("renv-hash-") + on.exit(unlink(hashfile), add = TRUE) + + writeLines(text, con = hashfile) + tools::md5sum(hashfile) + + } + + renv_bootstrap_load <- function(project, libpath, version) { + + # try to load renv from the project library + if (!requireNamespace("renv", lib.loc = libpath, quietly = TRUE)) + return(FALSE) + + # warn if the version of renv loaded does not match + renv_bootstrap_validate_version(version) + + # execute renv load hooks, if any + hooks <- getHook("renv::autoload") + for (hook in hooks) + if (is.function(hook)) + tryCatch(hook(), error = warnify) + + # load the project + renv::load(project) + + TRUE + + } + + renv_bootstrap_profile_load <- function(project) { + + # if RENV_PROFILE is already set, just use that + profile <- Sys.getenv("RENV_PROFILE", unset = NA) + if (!is.na(profile) && nzchar(profile)) + return(profile) + + # check for a profile file (nothing to do if it doesn't exist) + path <- renv_bootstrap_paths_renv("profile", profile = FALSE, project = project) + if (!file.exists(path)) + return(NULL) + + # read the profile, and set it if it exists + contents <- readLines(path, warn = FALSE) + if (length(contents) == 0L) + return(NULL) + + # set RENV_PROFILE + profile <- contents[[1L]] + if (!profile %in% c("", "default")) + Sys.setenv(RENV_PROFILE = profile) + + profile + + } + + renv_bootstrap_profile_prefix <- function() { + profile <- renv_bootstrap_profile_get() + if (!is.null(profile)) + return(file.path("profiles", profile, "renv")) + } + + renv_bootstrap_profile_get <- function() { + profile <- Sys.getenv("RENV_PROFILE", unset = "") + renv_bootstrap_profile_normalize(profile) + } + + renv_bootstrap_profile_set <- function(profile) { + profile <- renv_bootstrap_profile_normalize(profile) + if (is.null(profile)) + Sys.unsetenv("RENV_PROFILE") + else + Sys.setenv(RENV_PROFILE = profile) + } + + renv_bootstrap_profile_normalize <- function(profile) { + + if (is.null(profile) || profile %in% c("", "default")) + return(NULL) + + profile + + } + + renv_bootstrap_path_absolute <- function(path) { + + substr(path, 1L, 1L) %in% c("~", "/", "\\") || ( + substr(path, 1L, 1L) %in% c(letters, LETTERS) && + substr(path, 2L, 3L) %in% c(":/", ":\\") + ) + + } + + renv_bootstrap_paths_renv <- function(..., profile = TRUE, project = NULL) { + renv <- Sys.getenv("RENV_PATHS_RENV", unset = "renv") + root <- if (renv_bootstrap_path_absolute(renv)) NULL else project + prefix <- if (profile) renv_bootstrap_profile_prefix() + components <- c(root, renv, prefix, ...) + paste(components, collapse = "/") + } + + renv_bootstrap_project_type <- function(path) { + + descpath <- file.path(path, "DESCRIPTION") + if (!file.exists(descpath)) + return("unknown") + + desc <- tryCatch( + read.dcf(descpath, all = TRUE), + error = identity + ) + + if (inherits(desc, "error")) + return("unknown") + + type <- desc$Type + if (!is.null(type)) + return(tolower(type)) + + package <- desc$Package + if (!is.null(package)) + return("package") + + "unknown" + + } + + renv_bootstrap_user_dir <- function() { + dir <- renv_bootstrap_user_dir_impl() + path.expand(chartr("\\", "/", dir)) + } + + renv_bootstrap_user_dir_impl <- function() { + + # use local override if set + override <- getOption("renv.userdir.override") + if (!is.null(override)) + return(override) + + # use R_user_dir if available + tools <- asNamespace("tools") + if (is.function(tools$R_user_dir)) + return(tools$R_user_dir("renv", "cache")) + + # try using our own backfill for older versions of R + envvars <- c("R_USER_CACHE_DIR", "XDG_CACHE_HOME") + for (envvar in envvars) { + root <- Sys.getenv(envvar, unset = NA) + if (!is.na(root)) + return(file.path(root, "R/renv")) + } + + # use platform-specific default fallbacks + if (Sys.info()[["sysname"]] == "Windows") + file.path(Sys.getenv("LOCALAPPDATA"), "R/cache/R/renv") + else if (Sys.info()[["sysname"]] == "Darwin") + "~/Library/Caches/org.R-project.R/R/renv" + else + "~/.cache/R/renv" + + } + + renv_bootstrap_version_friendly <- function(version, shafmt = NULL, sha = NULL) { + sha <- sha %||% attr(version, "sha", exact = TRUE) + parts <- c(version, sprintf(shafmt %||% " [sha: %s]", substring(sha, 1L, 7L))) + paste(parts, collapse = "") + } + + renv_bootstrap_exec <- function(project, libpath, version) { + if (!renv_bootstrap_load(project, libpath, version)) + renv_bootstrap_run(version, libpath) + } + + renv_bootstrap_run <- function(version, libpath) { + + # perform bootstrap + bootstrap(version, libpath) + + # exit early if we're just testing bootstrap + if (!is.na(Sys.getenv("RENV_BOOTSTRAP_INSTALL_ONLY", unset = NA))) + return(TRUE) + + # try again to load + if (requireNamespace("renv", lib.loc = libpath, quietly = TRUE)) { + return(renv::load(project = getwd())) + } + + # failed to download or load renv; warn the user + msg <- c( + "Failed to find an renv installation: the project will not be loaded.", + "Use `renv::activate()` to re-initialize the project." + ) + + warning(paste(msg, collapse = "\n"), call. = FALSE) + + } + + renv_json_read <- function(file = NULL, text = NULL) { + + jlerr <- NULL + + # if jsonlite is loaded, use that instead + if ("jsonlite" %in% loadedNamespaces()) { + + json <- tryCatch(renv_json_read_jsonlite(file, text), error = identity) + if (!inherits(json, "error")) + return(json) + + jlerr <- json + + } + + # otherwise, fall back to the default JSON reader + json <- tryCatch(renv_json_read_default(file, text), error = identity) + if (!inherits(json, "error")) + return(json) + + # report an error + if (!is.null(jlerr)) + stop(jlerr) + else + stop(json) + + } + + renv_json_read_jsonlite <- function(file = NULL, text = NULL) { + text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n") + jsonlite::fromJSON(txt = text, simplifyVector = FALSE) + } + + renv_json_read_default <- function(file = NULL, text = NULL) { + + # find strings in the JSON + text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n") + pattern <- '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]' + locs <- gregexpr(pattern, text, perl = TRUE)[[1]] + + # if any are found, replace them with placeholders + replaced <- text + strings <- character() + replacements <- character() + + if (!identical(c(locs), -1L)) { + + # get the string values + starts <- locs + ends <- locs + attr(locs, "match.length") - 1L + strings <- substring(text, starts, ends) + + # only keep those requiring escaping + strings <- grep("[[\\]{}:]", strings, perl = TRUE, value = TRUE) + + # compute replacements + replacements <- sprintf('"\032%i\032"', seq_along(strings)) + + # replace the strings + mapply(function(string, replacement) { + replaced <<- sub(string, replacement, replaced, fixed = TRUE) + }, strings, replacements) + + } + + # transform the JSON into something the R parser understands + transformed <- replaced + transformed <- gsub("{}", "`names<-`(list(), character())", transformed, fixed = TRUE) + transformed <- gsub("[[{]", "list(", transformed, perl = TRUE) + transformed <- gsub("[]}]", ")", transformed, perl = TRUE) + transformed <- gsub(":", "=", transformed, fixed = TRUE) + text <- paste(transformed, collapse = "\n") + + # parse it + json <- parse(text = text, keep.source = FALSE, srcfile = NULL)[[1L]] + + # construct map between source strings, replaced strings + map <- as.character(parse(text = strings)) + names(map) <- as.character(parse(text = replacements)) + + # convert to list + map <- as.list(map) + + # remap strings in object + remapped <- renv_json_read_remap(json, map) + + # evaluate + eval(remapped, envir = baseenv()) + + } + + renv_json_read_remap <- function(json, map) { + + # fix names + if (!is.null(names(json))) { + lhs <- match(names(json), names(map), nomatch = 0L) + rhs <- match(names(map), names(json), nomatch = 0L) + names(json)[rhs] <- map[lhs] + } + + # fix values + if (is.character(json)) + return(map[[json]] %||% json) + + # handle true, false, null + if (is.name(json)) { + text <- as.character(json) + if (text == "true") + return(TRUE) + else if (text == "false") + return(FALSE) + else if (text == "null") + return(NULL) + } + + # recurse + if (is.recursive(json)) { + for (i in seq_along(json)) { + json[i] <- list(renv_json_read_remap(json[[i]], map)) + } + } + + json + + } + + # load the renv profile, if any + renv_bootstrap_profile_load(project) + + # construct path to library root + root <- renv_bootstrap_library_root(project) + + # construct library prefix for platform + prefix <- renv_bootstrap_platform_prefix() + + # construct full libpath + libpath <- file.path(root, prefix) + + # run bootstrap code + renv_bootstrap_exec(project, libpath, version) + + invisible() + +}) diff --git a/renv/settings.json b/renv/settings.json new file mode 100644 index 0000000..ffdbb32 --- /dev/null +++ b/renv/settings.json @@ -0,0 +1,19 @@ +{ + "bioconductor.version": null, + "external.libraries": [], + "ignored.packages": [], + "package.dependency.fields": [ + "Imports", + "Depends", + "LinkingTo" + ], + "ppm.enabled": null, + "ppm.ignored.urls": [], + "r.version": null, + "snapshot.type": "implicit", + "use.cache": true, + "vcs.ignore.cellar": true, + "vcs.ignore.library": true, + "vcs.ignore.local": true, + "vcs.manage.ignores": true +}