Search code examples
rgisspatialr-sfggrepel

Automatic Label Placement for GIS maps in R

I'm making GIS maps in R using the sf package (and related packages) to read in shapefiles, and ggplot2 (and friends) for plotting. This works fine, but I can find no way to (automatically/programmatically) create label placements for features such as rivers and roads. These features are typically linestrings, with irregular shapes. See image attached for example from wikimedia.

enter image description here

The ggrepel package works well for labeling points in an automated way, but this doesn't make much sense for other geographic features that aren't discrete Lat/Long points.

I could imagine doing this by placing individual text labels on each feature individually, but I'm looking for something more automated, if possible. I realize such automation isn't a trivial problem, but it's been solved before (ArcGIS apparently has a way of doing this with an extension called maplex, but I don't have access to the software, and I'd like to stay in R if possible).

Does anyone know of a way of doing this?

MWE here:

#MWE Linestring labeling

library(tidyverse)
library(sf)
library(ggrepel)
set.seed(120)

#pick a county from the built-in North Carolina dataset
BuncombeCounty <- st_read(system.file("shapes/", package="maptools"), "sids") %>% 
  filter(NAME == "Buncombe") 

#pick 4 random points in that county
pts_sf <- data.frame(
  x = seq(-82.3, -82.7, by=-0.1) %>% 
    sample(4),
  y = seq(35.5, 35.7, by=0.05) %>% 
    sample(4),
  placenames = c("A", "B", "C", "D")
) %>% 
  st_as_sf(coords = c("x","y")) 

#link those points into a linestring
linestring_sf <- pts_sf %>% 
  st_coordinates() %>%
  st_linestring()
  st_cast("LINESTRING") 

#plot them with labels, using geom_text_repel() from the `ggrepel` package
ggplot() +
  geom_sf(data = BuncombeCounty) +
  geom_sf(data = linestring_sf) +
  geom_label_repel(data = pts_sf,
                  stat = "sf_coordinates",
                  aes(geometry = geometry,
                      label = placenames),
                  nudge_y = 0.05,
                  label.r = 0, #don't round corners of label boxes
                  min.segment.length = 0,
                  segment.size = 0.4,
                  segment.color = "dodgerblue")

enter image description here

Solution

  • I think I have something that might work for you. I've taken the liberty of changing your example to something a bit more realistic: a couple of random "rivers" made with smoothed random walks, each 100 points long:

    library(tidyverse)
library(sf)
library(ggrepel)

BuncombeCounty <- st_read(system.file("shapes/", package = "maptools"), "sids") %>% 
                  filter(NAME == "Buncombe")
set.seed(120)

x1 <- seq(-82.795, -82.285, length.out = 100)
y1 <- cumsum(runif(100, -.01, .01))
y1 <- predict(loess(y1 ~ x1, span = 0.1)) + 35.6

x2 <- x1 + 0.02
y2 <- cumsum(runif(100, -.01, .01))
y2 <- predict(loess(y2 ~ x2, span = 0.1)) + 35.57

river_1 <- data.frame(x = x1, y = y1)     %>% 
           st_as_sf(coords = c("x", "y")) %>%
           st_coordinates()               %>%
           st_linestring()                %>%
           st_cast("LINESTRING") 

river_2 <- data.frame(x = x2, y = y2)     %>% 
           st_as_sf(coords = c("x", "y")) %>%
           st_coordinates()               %>%
           st_linestring()                %>%
           st_cast("LINESTRING")

    We can plot them as per your example:

    riverplot  <- ggplot() +
              geom_sf(data = BuncombeCounty) +
              geom_sf(data = river_1, colour = "blue", size = 2) +
              geom_sf(data = river_2, colour = "blue", size = 2)

riverplot

    enter image description here

    My solution is basically to extract points from the linestrings and label them. Like the picture at the top of your question, you might want multiple copies of each label along the length of the linestring, so if you want n labels you just extract n equally-spaced points.

    Of course, you want to be able to label both rivers at once without the labels clashing, so you'll need to be able to pass multiple geographical features as a named list.

    Here is a function that does all that:

    linestring_labels <- function(linestrings, n)
{
  do.call(rbind, mapply(function(linestring, label)
  {
  n_points <- length(linestring)/2
  distance <- round(n_points / (n + 1))
  data.frame(x = linestring[1:n * distance],
             y = linestring[1:n * distance + n_points],
             label = rep(label, n))
  }, linestrings, names(linestrings), SIMPLIFY = FALSE)) %>%
  st_as_sf(coords = c("x","y"))
}

    So if we put the objects we want to label in a named list like this:

    river_list <- list("River 1" = river_1, "River 2" = river_2)

    Then we can do this:

    riverplot + 
   geom_label_repel(data = linestring_labels(river_list, 3),
                    stat = "sf_coordinates",
                    aes(geometry = geometry, label = label),
                    nudge_y = 0.05,
                    label.r = 0, #don't round corners of label boxes
                    min.segment.length = 0,
                    segment.size = 0.4,
                    segment.color = "dodgerblue")

    enter image description here