Update to v0.3.9000
This commit is contained in:
parent
5e08875bea
commit
6af6fc044a
103 changed files with 3175 additions and 124 deletions
8
R/bar.R
8
R/bar.R
|
|
@ -21,7 +21,6 @@
|
|||
#' @param title_size The size of the title text. Defaults to 14.
|
||||
#' @param legend_position Position of the legend; Default to "right". Can take "right", "left", "top", "bottom" or "none".
|
||||
#' @param legend_rev Reverse the color in the guide? Default to TRUE.
|
||||
#' @param void Boolean to remove all elements from the plot. Default to FALSE.
|
||||
#' @param ... Other arguments to be passed to "ggblanket::gg_col"
|
||||
#'
|
||||
#' @description `ggblanket` as internals for deciding whether the bar chart is horizontally readable.
|
||||
|
|
@ -29,7 +28,7 @@
|
|||
#' @return A bar chart
|
||||
#'
|
||||
#' @export
|
||||
bar_reach <- function(df, x, y, group = NULL, percent = TRUE, palette = "main", reverse = FALSE, family = "Leelawadee", alpha = 1, width = 0.5, x_title = NULL, y_title = NULL, group_title = NULL, position = "dodge", title = NULL, subtitle = NULL, caption = NULL, text_size = 10, title_size = 14, legend_position = "right", legend_rev = TRUE, void = FALSE, ...){
|
||||
bar_reach <- function(df, x, y, group = NULL, percent = TRUE, palette = "main", reverse = FALSE, family = "Leelawadee", alpha = 1, width = 0.5, x_title = NULL, y_title = NULL, group_title = NULL, position = "dodge", title = NULL, subtitle = NULL, caption = NULL, text_size = 10, title_size = 14, legend_position = "right", legend_rev = TRUE, ...){
|
||||
|
||||
pal <- pal_reach(palette)
|
||||
|
||||
|
|
@ -64,9 +63,8 @@ bar_reach <- function(df, x, y, group = NULL, percent = TRUE, palette = "main",
|
|||
title_size = title_size,
|
||||
plot_background_pal = "#FFFFFF",
|
||||
panel_background_pal = "#FFFFFF",
|
||||
legend_reverse = legend_rev,
|
||||
void = FALSE
|
||||
),
|
||||
legend_reverse = legend_rev
|
||||
),
|
||||
...
|
||||
)
|
||||
|
||||
|
|
|
|||
93
R/data.R
Normal file
93
R/data.R
Normal file
|
|
@ -0,0 +1,93 @@
|
|||
#' 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"
|
||||
354
R/map.R
Normal file
354
R/map.R
Normal file
|
|
@ -0,0 +1,354 @@
|
|||
|
||||
|
||||
#' 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,
|
||||
...)
|
||||
}
|
||||
|
||||
|
|
@ -18,7 +18,6 @@
|
|||
#' @param text_size The size of all text other than the title, subtitle and caption. Defaults to 10.
|
||||
#' @param title_size The size of the title text. Defaults to 14.
|
||||
#' @param legend_position Position of the legend; Default to "right". Can take "right", "left", "top", "bottom" or "none".
|
||||
#' @param void Boolean to remove all elements from the plot. Default to FALSE.
|
||||
#' @param ... Other arguments to be passed to "ggblanket::gg_col"
|
||||
#'
|
||||
#' @description `ggblanket` as internals for deciding whether the bar chart is horizontally readable.
|
||||
|
|
@ -26,7 +25,7 @@
|
|||
#' @return A bar chart
|
||||
#'
|
||||
#' @export
|
||||
point_reach <- function(df, x, y, group = NULL, palette = "main", reverse = FALSE, family = "Leelawadee", alpha = 1, size = 1.5, x_title = NULL, y_title = NULL, group_title = NULL, title = NULL, subtitle = NULL, caption = NULL, text_size = 10, title_size = 14, legend_position = "right", void = FALSE, ...){
|
||||
point_reach <- function(df, x, y, group = NULL, palette = "main", reverse = FALSE, family = "Leelawadee", alpha = 1, size = 1.5, x_title = NULL, y_title = NULL, group_title = NULL, title = NULL, subtitle = NULL, caption = NULL, text_size = 10, title_size = 14, legend_position = "right", ...){
|
||||
|
||||
pal <- pal_reach(palette)
|
||||
|
||||
|
|
@ -56,8 +55,7 @@ point_reach <- function(df, x, y, group = NULL, palette = "main", reverse = FALS
|
|||
text_size = text_size,
|
||||
title_size = title_size,
|
||||
plot_background_pal = "#FFFFFF",
|
||||
panel_background_pal = "#FFFFFF",
|
||||
void = FALSE
|
||||
panel_background_pal = "#FFFFFF"
|
||||
),
|
||||
...
|
||||
)
|
||||
|
|
|
|||
|
|
@ -11,7 +11,6 @@
|
|||
#' @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_reverse Reverse the color in the guide? Default to TRUE.
|
||||
#' @param void Boolean to remove all elements from the plot. Default to FALSE.
|
||||
#' @param ... Additional arguments passed to `ggblanket::gg_theme()`.
|
||||
#'
|
||||
#'
|
||||
|
|
@ -29,7 +28,6 @@ theme_reach <- function(
|
|||
title_size = 14,
|
||||
plot_background_pal = "#FFFFFF",
|
||||
panel_background_pal = "#FFFFFF",
|
||||
void = FALSE,
|
||||
legend_position = "right",
|
||||
legend_direction = "vertical",
|
||||
legend_reverse = TRUE,
|
||||
|
|
@ -42,9 +40,7 @@ theme_reach <- function(
|
|||
text_size = text_size,
|
||||
title_size = title_size,
|
||||
plot_background_pal = plot_background_pal,
|
||||
panel_background_pal = panel_background_pal,
|
||||
void = void
|
||||
)
|
||||
panel_background_pal = panel_background_pal)
|
||||
|
||||
|
||||
# Default legend to right position
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue