Tries for moving tmap to ggplot2

R/internals.R

@@ -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

R/map.R

@@ -1,47 +1,38 @@
-
+#' Wrapper around `ggplot2::geom_sf()` with sane defaults for plotting choropleth
-
-#' 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 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 style Method to process the color scale for continuous numerical variables. See `classInt::classIntervals()` for details.
-#' @param color_na Fill color for missing data.
+#' @param intervals Boolean. TRUE, let's make classes. FALSE, let's use a gradient.
-#' @param text_na Legend text for missing data.
+#' @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 legend_positin Legend position.
-#' @param border_alpha Transparency of the border.
+#' @param drop Boolean. Drop missing data?
-#' @param border_col Color of the border.
+#' @param text_na Legend text for missing data.
-#' @param lwd Linewidth of the border.
+#' @param color_na Fill color for missing data.
-#' @param ... Other arguments to pass to `tmap::tm_polygons()`.
+#'
+#' @return A ggplot base choropleth.
 #'
-#' @return A tmap layer.
 #' @export
-#'
+add_indicator_layer <- function(poly,
-add_indicator_layer <- function(
-    poly,
                                 col,
-    buffer = NULL,
                                 n = 5,
+                                initiative = "reach",
+                                palette = "red_5",
                                 style = "pretty",
-    palette = pal_reach("red_5"),
+                                intervals = TRUE,
-    as_count = TRUE,
+                                font_family = "segoeui",
-    color_na = cols_reach("white"),
-    text_na = "Missing data",
                                 legend_title = "Proportion (%)",
-    legend_text_separator = " - ",
+                                legend_position = c(0, 0.95),
-    border_alpha = 1,
+                                drop = FALSE,
-    border_col = cols_reach("lt_grey_1"),
+                                text_na = "Missing data",
-    lwd = 1,
+                                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(
+    legend_labels <- c(levels(poly[[col_class_name]]), text_na)
-    poly,
+
-    bbox = buffer
+    discrete <- TRUE
-  ) +
+
-    tmap::tm_polygons(
+    layer <- ggplot2::ggplot() +
-      col = col_name,
+      ggplot2::geom_sf(data = poly, ggplot2::aes(fill = !!rlang::sym(col_class_name)), color = "transparent") +
-      n = n,
+      scale_fill(initiative = initiative, palette = palette, discrete = discrete, reverse_guide = FALSE, name = legend_title, labels = legend_labels, drop = drop, na.value = color_na)
-      style = style,
+
-      palette = palette,
+  } else {
-      as.count = as_count,
+
-      colorNA = color_na,
+    discrete <- FALSE
-      textNA = text_na,
+
-      title = legend_title,
+    layer <- ggplot2::ggplot() +
-      legend.format = list(text.separator = legend_text_separator),
+      ggplot2::geom_sf(data = poly, ggplot2::aes(fill = !!rlang::sym(col_name)), color = "transparent") +
-      borderl.col = border_col,
+      scale_fill(initiative = initiative, palette = palette, discrete = discrete, reverse_guide = FALSE, name = legend_title, na.value = color_na)
-      border.alpha = border_alpha,
+
-      lwd = lwd,
+  }
-      ...
+
+  #------ 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
+  if(is.null(map)) map <- ggplot2::ggplot()
-
-  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
 
@@ -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) +
+  layers <- map + ggplot2::geom_sf(data = lines[[1]], ggplot2::aes(color = .data[["label"]], linewidth = .data[["label"]]))
-    tmap::tm_lines(lwd = lwds[[1]], col = colors[[1]], ...)
 
-  if (length(lines) == 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]], ...)
+      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 +
+    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)
 
-    layers <- layers + legend_lines
 
   return(layers)
 
-  }
 }
 
 
@@ -225,39 +226,39 @@ add_layout <- function(
 #' @return A tmap layer.
 #' @export
 #'
-add_admin_labels <- function(point,
+add_text_labels <- function(map = NULL,
+                            point,
                             text,
                             size = 0.5,
                             fontface = "bold",
                             fontfamily = "Leelawadee",
-                             shadow = TRUE,
+                            halo_radius = 0.15,
-                             auto_placement = FALSE,
+                            halo_color = "white",
-                             remove_overlap = FALSE,
+                            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(
-  point <- sf::st_make_valid(point)
+      data = point,
-
+      ggplot2::aes(
-  #------ Other checks
+        x = X,
-
+        y = Y,
-  text_name <- rlang::as_name(rlang::enquo(text))
+        label = !!rlang::sym(col_name)),
-  if_not_in_stop(point, text_name, "point", "text")
+      crs = sf::st_crs(point)$input,
-
+      force = force,
-  #------ Point text layer
+      force_pull = force_pull,
-
+      size = 3,
-  layer <- tmap::tm_shape(point) +
+      angle = angle,
-    tmap::tm_text(text = text_name,
-                  size = size,
       fontface = fontface,
-                  fontfamily = fontfamily,
+      family = fontfamily,
-                  shadow = shadow,
+      bg.r = halo_radius,
-                  auto.placement = auto_placement,
+      bg.color = halo_color)
-                  remove.overlap = remove_overlap,
+
-                  ...)
 
   return(layer)