Автоматичне розміщення міток для GIS-карт в R

Я створюю GIS-карти в R, використовуючи sfпакет (та пов'язані з ним пакети) для читання у формі файлів та ggplot2(та друзів) для побудови графіків. Це прекрасно працює, але я не можу знайти (автоматично / програмно) створити мітки міток для таких функцій, як річки та дороги. Ці риси, як правило, є рядками з неправильною формою. Дивіться зображення, що додається, наприклад, з wikimedia.

ggrepelПакет добре працює для маркування точок в автоматичному режимі, але це не має особливого сенсу для інших географічних об'єктів, які не є дискретними Lat / Long точки.

Я міг би собі це зробити, розміщуючи окремі текстові мітки на кожній функції окремо, але я шукаю щось більш автоматизоване, якщо це можливо. Я усвідомлюю, що така автоматизація не є тривіальною проблемою, але вона була вирішена раніше (ArcGIS, мабуть, має змогу зробити це з розширенням під назвою maplex, але я не маю доступу до програмного забезпечення, і я хотів би залишитися в R, якщо можливо).

Хтось знає про спосіб цього?

MWE тут:

#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")

Я думаю, що у мене є щось, що може працювати для тебе. Я взяв на себе сміливість змінити ваш приклад на щось більш реалістичне: пару випадкових «річок», зроблених згладженими випадковими прогулянками, кожні 100 балів завдовжки:

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") 

Ми можемо побудувати їх за вашим прикладом:

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

Моє рішення полягає в тому, щоб витягнути точки з рядків і позначити їх. Як і малюнок у верхній частині запитання, вам може знадобитися кілька копій кожної мітки по довжині рядкової рядка, тому, якщо ви хочете n міток, ви просто отримаєте n однаково розташованих точок.

Звичайно, ви хочете мати можливість позначати обидві річки одночасно без зіткнення міток, тому вам потрібно буде мати можливість передати декілька географічних ознак як названий список.

Ось функція, яка виконує все, що:

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"))
}

Отже, якщо ми помістимо об'єкти, які ми хочемо позначити в такому іменованому списку:

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

Тоді ми можемо це зробити:

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")