From 947747a42ccf7fe7185acb17c198f2cba293bc85 Mon Sep 17 00:00:00 2001 From: gnoblet Date: Wed, 31 May 2023 21:55:59 +0200 Subject: [PATCH] Tries for moving tmap to ggplot2 --- R/internals.R | 408 ++++++++++++++++++++++++++++++++++++++++++++++++-- R/map.R | 223 +++++++++++++-------------- 2 files changed, 507 insertions(+), 124 deletions(-) diff --git a/R/internals.R b/R/internals.R index 0f145b5..8580190 100644 --- a/R/internals.R +++ b/R/internals.R @@ -13,10 +13,10 @@ abort_bad_argument <- function(arg, must, not = NULL) { } rlang::abort("error_bad_argument", - message = msg, - arg = arg, - must = must, - not = not + message = msg, + arg = arg, + must = must, + not = not ) } @@ -30,11 +30,10 @@ abort_bad_argument <- function(arg, must, not = NULL) { #' @param arg Default to NULL. #' #' @return A stop statement -if_not_in_stop <- function(.tbl, cols, df, arg = NULL){ +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 { + } else { msg <- glue::glue("The following column/s from `{arg}` is/are missing in `{df}`:") } if (!all(cols %in% colnames(.tbl))) { @@ -45,7 +44,8 @@ if_not_in_stop <- function(.tbl, cols, df, arg = NULL){ msg, paste( subvec_not_in(cols, colnames(.tbl)), - collapse = ", ") + collapse = ", " + ) ) ) ) @@ -62,11 +62,10 @@ if_not_in_stop <- function(.tbl, cols, df, arg = NULL){ #' @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_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 { + } else { msg <- glue::glue("The following element/s from `{arg}` is/are missing in `{vec_name}`:") } if (!all(cols %in% vec)) { @@ -77,7 +76,8 @@ if_vec_not_in_stop <- function(vec, cols, vec_name, arg = NULL){ msg, paste( subvec_not_in(cols, vec), - collapse = ", ") + collapse = ", " + ) ) ) ) @@ -90,6 +90,388 @@ if_vec_not_in_stop <- function(vec, cols, vec_name, arg = NULL){ #' @param set A set-vector #' #' @return A subset of vector not in set -subvec_not_in <- function(vector, set){ +subvec_not_in <- function(vector, set) { vector[!(vector %in% set)] } + + + + +# Map helpers ------------------------------------------------------------- + + +# Thanks to https://github.com/r-tmap/tmap/blob/master/R/map_num2pal.R +pretty_count <- function(x, n, ...) { + x <- na.omit(x) + if (!length(x)) { + return(x) + } + + if (!is.integer(x)) x <- as.integer(x) + + + mn <- min(x) + mx <- max(x) + + any0 <- any(x == 0) + + if (mn < 0) { + n <- floor(n / 2) + pneg <- -rev(pretty_count(-x[x < 0], n = n, ...)) + 1L + pneg <- pneg[pneg != 0L] + x <- x[x > 0] + any0 <- TRUE + } else { + pneg <- integer() + } + + if (any0) x <- x[x != 0L] + + p <- pretty(x - 1L, n = n, ...) + 1L + + p <- p[(p %% 1) == 0] + p <- p[p != 0L] + + if (length(x) < 2) { + if (any0) { + return(c(0L, p)) + } else { + return(p) + } + } + + + step <- p[2] - p[1] + if (p[length(p)] == mx) p <- c(p, mx + step) + + if (any0) { + c(pneg, 0L, p) + } else { + c(pneg, p) + } +} + + +breaks <- pretty_count(indicator_admin1$opn_dfc, n = 5) +style <- "fixed" +# +q <- num2breaks(indicator_admin1$opn_dfc, n = 5, style = style, breaks = breaks, interval.closure = "left", var = var, as.count = T, args = style.args) + + + +breaks_n <- function(breaks, as_count = TRUE) + + +fancy_breaks(breaks, intervals = TRUE, as.count = TRUE) + + +fancy_breaks <- function(vec, as.count = FALSE, intervals=FALSE, interval.closure="left", fun=NULL, scientific=FALSE, big.num.abbr = c("mln" = 6, "bln" = 9), prefix = "", suffix = "", text.separator="to", text.less.than=c("less", "than"), text.or.more=c("or", "more"), text.align="left", text.to.columns=FALSE, digits=NA, html.escape = TRUE, ...) { + args <- list(...) + n <- length(vec) + + if (!is.null(fun)) { + x <- do.call(fun, list(vec)) + } else if (all(is.infinite(vec))) { + x <- as.character(vec) + } else { + # calculate magnitude, needed to determine digits and big number abbreviations + vec_fin <- unique(vec[!is.infinite(vec)]) + frm <- gsub(" ", "", sprintf("%20.10f", abs(vec_fin))) + mag <- max(nchar(frm)-11) + + if (as.count) { + steps <- (vec[-1] - vec[-n]) + vec <- c(vec, vec - 1L, vec + 1L) # needed for: {1, 2, ... 9} + digits <- 0 + } else { + # get number of decimals (which is number of decimals in vec, which is reduced when mag is large) + ndec <- max(10 - nchar(frm) + nchar(sub("0+$","",frm))) + if (is.na(digits)) { + digits <- max(min(ndec, 4-mag), 0) + + # add sign to frm + frm_sign <- unique(paste0(ifelse(vec_fin<0, "-", "+"), frm)) + + # test if number of digits is sufficient for unique labels + if (!scientific) { + while (anyDuplicated(substr(frm_sign, 1, nchar(frm_sign)-10 + digits)) && (digits < 10)) { + digits <- digits + 1 + } + } + + } + } + + if (!scientific || as.count) { + + # check whether big number abbrevations should be used + ext <- "" + if (!is.na(big.num.abbr[1])) { + big.num.abbr <- sort(big.num.abbr, decreasing = TRUE) + for (i in 1:length(big.num.abbr)) { + o <- unname(big.num.abbr[i]) + if (mag>(o+2) || (mag > o && all(vec - floor(vec/(10^o))*(10^o) < 1))) { + vec <- vec / (10^o) + ext <- paste0(" ", names(big.num.abbr)[i]) + break + } + } + } + + # set default values + if (!("big.mark" %in% names(args))) args$big.mark <- "," + if (!("format" %in% names(args))) args$format <- "f" + if (!("preserve.width" %in% names(args))) args$preserve.width <- "none" + x <- paste(do.call("formatC", c(list(x=vec, digits=digits), args)), ext, sep="") + x <- paste0(prefix, x, suffix) + + + } else { + if (!("format" %in% names(args))) args$format <- "g" + x <- do.call("formatC", c(list(x=vec, digits=digits), args)) + } + + if (as.count) { + x1 <- x[1:(n-1)] + x2 <- x[(n+2):(2*n)] + x1p1 <- x[(2*n+1):(3*n-1)] + } + # x <- formatC(vec, format = "f", digits = 0) + # x1 <- x[-n] + # x2 <- formatC(vec[-1] - 1L, format = "f", digits = 0) + # xs <- (vec[-1] - vec[-n]) + # x1p1 <- formatC(vec[-n] + 1L, format = "f", digits = 0) + } + + if (intervals) { + if (scientific) { + if (as.count) { + # discrete + lbls <- paste("{", x1, "}", sep = "") + lbls[steps == 2] <- paste("{", x1[steps == 2], ", ", x2[steps == 2], "}", sep="") + lbls[steps > 2] <- paste("{", x1[steps > 2], ", ", x1p1[steps > 2], ", ..., ", x2[steps > 2], "}", sep="") + } else { + # continuous + if (interval.closure=="left") { + lbls <- paste("[", x[-n], ", ", x[-1], ")", sep="") + lbls[n-1] <- paste(substr(lbls[n-1], 1, nchar(lbls[n-1])-1), "]", sep="") + } else { + lbls <- paste("(", x[-n], ", ", x[-1], "]", sep="") + lbls[1] <- paste("[", substr(lbls[1], 2, nchar(lbls[1])), sep="") + } + } + + + } else { + if (as.count) { + lbls <- x1 + lbls[steps>1] <- paste(x1[steps>1], x2[steps>1], sep = paste0(" ", text.separator, " ")) + if (vec[n]==Inf) lbls[n-1] <- paste(x1[n-1], paste(text.or.more, collapse = " "), sep = " ") + } else { + x[vec==-Inf] <- "" + + lbls <- paste(x[-n], x[-1], sep = paste0(" ", text.separator, " ")) + if (vec[1]==-Inf) lbls[1] <- paste(paste(text.less.than, collapse = " "), x[2], sep = " ") + if (vec[n]==Inf) lbls[n-1] <- paste(x[n-1], paste(text.or.more, collapse = " "), sep = " ") + } + + if (text.to.columns) { + #xtra <- as.numeric(!is.na(text.align) && text.align=="right") + + + nc1 <- nchar(paste(x[-n], " ", sep = "")) + 1 + nc2 <- rep(nchar(paste(text.separator, " ", sep = "")), n-1) + + lbls_breaks <- matrix(c(nc1, nc1+nc2), ncol=2) + + if (vec[1]==-Inf) { + if (length(text.less.than)==1) { + lbls_breaks[1,] <- rep(nchar(paste(text.less.than[1], " ", sep = "")) + 1, 2) + } else { + lbls_breaks[1,] <- cumsum(c(nchar(paste(text.less.than[1], " ", sep = "")) + 1, nchar(text.less.than[2])+1)) + } + } + if (vec[n]==Inf) { + if (length(text.or.more)==1) { + lbls_breaks[n-1,] <- rep(nchar(paste(x[n-1], " ", sep = "")) + 1, 2) + } else { + lbls_breaks[n-1,] <- cumsum(c(nchar(paste(x[n-1], " ", sep = "")) + 1, nchar(text.or.more[1])+1)) + } + + } + attr(lbls, "brks") <- lbls_breaks + } + + + + + } + } + + y <- if (intervals) lbls else x + attr(y, "align") <- text.align + y +} + + +num2breaks <- function(x, n, style, breaks, approx=FALSE, interval.closure="left", var = NULL, as.count = FALSE, args = list()) { + + tmapOptions = get("tmapOptions", envir = .TMAP_CACHE) + show.warnings <- tmapOptions$show.warnings + + nobs <- sum(!is.na(x)) + # create intervals and assign colors + if (style=="fixed") { + q <- list(var=x, + brks=breaks) + if (any(na.omit(x) < min(breaks)) && show.warnings) warning("Values have found that are less than the lowest break", call. = FALSE) + if (any(na.omit(x) > max(breaks)) && show.warnings) warning("Values have found that are higher than the highest break", call. = FALSE) + attr(q, "style") <- "fixed" + attr(q, "nobs") <- nobs + attr(q, "intervalClosure") <- interval.closure + class(q) <- "classIntervals" + } else { + if (nobs==0) { + if (!is.null(var)) { + stop("Numerical variable \"", var, "\" only contains missing values.", call.=FALSE) + } else { + stop("Numerical variable only contains missing values.", call.=FALSE) + } + } + + nunique <- length(na.omit(unique(x))) + + + if (nunique == 1 && style!="pretty" && show.warnings) { + if (!is.null(var)) { + warning("Single unique value found for the variable \"", var, "\", so style set to \"pretty\"", call. = FALSE) + } else { + warning("Single unique value found, so style set to \"pretty\"", call. = FALSE) + } + } + + tempx <- nunique <= n + + if (tempx) { + x_orig <- x + if (length(na.omit(unique(x))) == 1) x <- pretty(x) + x <- seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length.out = n + 1) + } + + q <- suppressWarnings(do.call(classInt::classIntervals, c(list(x, n, style= style, intervalClosure=interval.closure), args))) + + if (tempx) q$var <- x_orig + + } + + if (approx && style != "fixed") { + if (n >= length(unique(x)) && style=="equal") { + # to prevent classIntervals to set style to "unique" + q <- list(var=x, brks=seq(min(x, na.rm=TRUE), max(x, na.rm=TRUE), length.out=n)) + attr(q, "intervalClosure") <- interval.closure + class(q) <- "classIntervals" + } else { + brks <- q$brks + + # to prevent ugly rounded breaks such as -.5, .5, ..., 100.5 for n=101 + qm1 <- suppressWarnings(do.call(classInt::classIntervals, c(list(x, n-1, style= style, intervalClosure=interval.closure), args))) + brksm1 <- qm1$brks + qp1 <- suppressWarnings(do.call(classInt::classIntervals, c(list(x, n+1, style= style, intervalClosure=interval.closure), args))) + brksp1 <- qp1$brks + if (min(brksm1) > min(brks) && max(brksm1) < max(brks)) { + q <- qm1 + } else if (min(brksp1) > min(brks) && max(brksp1) < max(brks)) { + q <- qp1 + } + } + } + q +} + + +cont_breaks <- function(breaks, n=101) { + x <- round(seq(1, 101, length.out=length(breaks))) + + + unlist(lapply(1L:(length(breaks)-1L), function(i) { + y <- seq(breaks[i], breaks[i+1], length.out=x[i+1]-x[i]+1) + if (i!=1) y[-1] else y + }), use.names = FALSE) +} + + +num2breaks <- function(x, n, style = "fixed", breaks, approx = FALSE, interval.closure = "left", var = NULL, as.count = FALSE, args = list()) { + + show.warnings <- TRUE + + nobs <- sum(!is.na(x)) + # create intervals and assign colors + if (style == "fixed") { + q <- list( + var = x, + brks = breaks + ) + if (any(na.omit(x) < min(breaks)) && show.warnings) warning("Values have found that are less than the lowest break", call. = FALSE) + if (any(na.omit(x) > max(breaks)) && show.warnings) warning("Values have found that are higher than the highest break", call. = FALSE) + attr(q, "style") <- "fixed" + attr(q, "nobs") <- nobs + attr(q, "intervalClosure") <- interval.closure + class(q) <- "classIntervals" + } else { + if (nobs == 0) { + if (!is.null(var)) { + stop("Numerical variable \"", var, "\" only contains missing values.", call. = FALSE) + } else { + stop("Numerical variable only contains missing values.", call. = FALSE) + } + } + + nunique <- length(na.omit(unique(x))) + + + if (nunique == 1 && style != "pretty" && show.warnings) { + if (!is.null(var)) { + warning("Single unique value found for the variable \"", var, "\", so style set to \"pretty\"", call. = FALSE) + } else { + warning("Single unique value found, so style set to \"pretty\"", call. = FALSE) + } + } + + tempx <- nunique <= n + + if (tempx) { + x_orig <- x + if (length(na.omit(unique(x))) == 1) x <- pretty(x) + x <- seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length.out = n + 1) + } + + q <- suppressWarnings(do.call(classInt::classIntervals, c(list(x, n, style = style, intervalClosure = interval.closure), args))) + + if (tempx) q$var <- x_orig + } + + if (approx && style != "fixed") { + if (n >= length(unique(x)) && style == "equal") { + # to prevent classIntervals to set style to "unique" + q <- list(var = x, brks = seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length.out = n)) + attr(q, "intervalClosure") <- interval.closure + class(q) <- "classIntervals" + } else { + brks <- q$brks + + # to prevent ugly rounded breaks such as -.5, .5, ..., 100.5 for n=101 + qm1 <- suppressWarnings(do.call(classInt::classIntervals, c(list(x, n - 1, style = style, intervalClosure = interval.closure), args))) + brksm1 <- qm1$brks + qp1 <- suppressWarnings(do.call(classInt::classIntervals, c(list(x, n + 1, style = style, intervalClosure = interval.closure), args))) + brksp1 <- qp1$brks + if (min(brksm1) > min(brks) && max(brksm1) < max(brks)) { + q <- qm1 + } else if (min(brksp1) > min(brks) && max(brksp1) < max(brks)) { + q <- qp1 + } + } + } + q +} + +breaks[length(breaks)] <- breaks[length(breaks)] + 1L diff --git a/R/map.R b/R/map.R index 3e9ac1b..52c7363 100644 --- a/R/map.R +++ b/R/map.R @@ -1,47 +1,38 @@ - - -#' Wrapper around `tmap::tm_polygons()` with sane defaults for plotting indicator values +#' Wrapper around `ggplot2::geom_sf()` with sane defaults for plotting choropleth #' #' @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 initiative One of "reach", "agora", or "default" #' @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 style Method to process the color scale for continuous numerical variables. See `classInt::classIntervals()` for details. +#' @param intervals Boolean. TRUE, let's make classes. FALSE, let's use a gradient. +#' @param font_family Font family. #' @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()`. +#' @param legend_positin Legend position. +#' @param drop Boolean. Drop missing data? +#' @param text_na Legend text for missing data. +#' @param color_na Fill color for missing data. +#' +#' @return A ggplot base choropleth. #' -#' @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, - ...){ +add_indicator_layer <- function(poly, + col, + n = 5, + initiative = "reach", + palette = "red_5", + style = "pretty", + intervals = TRUE, + font_family = "segoeui", + legend_title = "Proportion (%)", + legend_position = c(0, 0.95), + drop = FALSE, + text_na = "Missing data", + color_na = cols_reach("white")){ #------ 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 @@ -54,29 +45,43 @@ add_indicator_layer <- function( #------ Prepare data - if(!is.null(buffer)){ buffer <- buffer_bbox(poly, buffer) } else { buffer <- NULL } + if (intervals) { + classes <- classInt::classIntervals(poly[[col_name]], n = n, style = style) + col_class_name <- paste0(col_name, "_class") - #------ Polygon layer + poly <- poly |> + dplyr::mutate("{col_class_name}" := cut({{ col }}, classes$brks, include.lowest = TRUE)) - 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, - ... + legend_labels <- c(levels(poly[[col_class_name]]), text_na) + + discrete <- TRUE + + layer <- ggplot2::ggplot() + + ggplot2::geom_sf(data = poly, ggplot2::aes(fill = !!rlang::sym(col_class_name)), color = "transparent") + + scale_fill(initiative = initiative, palette = palette, discrete = discrete, reverse_guide = FALSE, name = legend_title, labels = legend_labels, drop = drop, na.value = color_na) + + } else { + + discrete <- FALSE + + layer <- ggplot2::ggplot() + + ggplot2::geom_sf(data = poly, ggplot2::aes(fill = !!rlang::sym(col_name)), color = "transparent") + + scale_fill(initiative = initiative, palette = palette, discrete = discrete, reverse_guide = FALSE, name = legend_title, na.value = color_na) + + } + + #------ Make map layer + + layer <- layer + + ggplot2::theme_void() + + ggplot2::theme( + # legend.justification defines the edge of the legend that the legend.position coordinates refer to + legend.justification = c(0, 1), + # Set the legend flush with the left side of the plot, and just slightly below the top of the plot + legend.position = legend_position, + # Set fontfamily + text = ggplot2::element_text(family = font_family) ) return(layer) @@ -88,6 +93,7 @@ add_indicator_layer <- function( #' Add admin boundaries (lines) and the legend #' +#' @param map Is there a previous map layer? Default to NULL. #' @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. @@ -99,13 +105,10 @@ add_indicator_layer <- function( #' @return A tmap layer. #' @export #' -add_admin_boundaries <- function(lines, colors, labels, lwds, title = "", buffer = NULL, ...){ +add_admin_boundaries <- function(map = NULL, lines, colors, labels, lwds, legend_title = ""){ - #------ Package check - - rlang::check_installed("tmap", reason = "Package \"tmap\" needed for `add_admin_boundaries()` to work. Please install it.") - + if(is.null(map)) map <- ggplot2::ggplot() #------ Check that the length of vectors is identical between arguments @@ -120,40 +123,38 @@ add_admin_boundaries <- function(lines, colors, labels, lwds, title = "", buffer 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 } + for (i in 1:length(lines)) { + lines[[i]] <- lines[[i]] |> + dplyr::mutate(color = colors[[i]], + label = labels[[i]], + lwd = lwds[[i]]) + } - layers <- tmap::tm_shape(lines[[1]], bbox = buffer) + - tmap::tm_lines(lwd = lwds[[1]], col = colors[[1]], ...) + layers <- map + ggplot2::geom_sf(data = lines[[1]], ggplot2::aes(color = .data[["label"]], linewidth = .data[["label"]])) - if (length(lines) == 1) { - - layers <- layers + legend_lines - - return(layers) - - } else { + if (length(lines) > 1){ for(i in 2:length(lines)){ - layers <- layers + tmap::tm_shape(shp = lines[[i]]) + tmap::tm_lines(lwd = lwds[[i]], col = colors[[i]], ...) + data <- lines[[i]] + color <- labels[[i]] + size <- labels[[i]] + + layers <- layers + ggplot2::geom_sf(data = data, ggplot2::aes(color = .data[["label"]], linewidth = .data[["label"]])) + } - - layers <- layers + legend_lines - - return(layers) - } + # + layers <- layers + + ggplot2::scale_color_manual(name = legend_title, values = setNames(colors, labels), breaks = labels) + + ggplot2::scale_discrete_manual("linewidth", name = legend_title, values = setNames(lwds, labels), breaks = labels) + + + return(layers) + } @@ -225,39 +226,39 @@ add_layout <- function( #' @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, - ...){ +add_text_labels <- function(map = NULL, + point, + text, + size = 0.5, + fontface = "bold", + fontfamily = "Leelawadee", + halo_radius = 0.15, + halo_color = "white", + angle = 0, + force = 0, + force_pull = 0){ + if(is.null(map)) map <- ggplot() - #------ Restrictive sf checks (might not be necessary depending on the desired behaviour) + col_name <- rlang::as_name(rlang::enquo(text)) - rlang::check_installed("tmap", reason = "Package \"tmap\" needed for `add_indicator_layer()` to work. Please install it.") + layer <- map + + ggspatial::geom_spatial_text_repel( + data = point, + ggplot2::aes( + x = X, + y = Y, + label = !!rlang::sym(col_name)), + crs = sf::st_crs(point)$input, + force = force, + force_pull = force_pull, + size = 3, + angle = angle, + fontface = fontface, + family = fontfamily, + bg.r = halo_radius, + bg.color = halo_color) - 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)