354 lines
10 KiB
R
354 lines
10 KiB
R
|
|
|
|
#' 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,
|
|
...)
|
|
}
|
|
|