Vị trí nhãn tự động cho bản đồ GIS trong R

Tôi đang tạo bản đồ GIS trong R bằng cách sử dụng sfgói (và các gói có liên quan) để đọc trong shapefiles và ggplot2(và bạn bè) để vẽ đồ thị. Điều này hoạt động tốt, nhưng tôi không thể tìm cách (tự động / lập trình) tạo các vị trí nhãn cho các tính năng như sông và đường. Các tính năng này thường là linestrings, với hình dạng không đều. Xem hình ảnh đính kèm ví dụ từ wikidia.

Các ggrepelgói hoạt động tốt cho ghi nhãn điểm một cách tự động, nhưng điều này không có ý nghĩa nhiều đối với đặc điểm địa lý khác mà không phải là rời rạc điểm Lat / Long.

Tôi có thể tưởng tượng làm điều này bằng cách đặt các nhãn văn bản riêng lẻ trên từng tính năng, nhưng tôi đang tìm kiếm thứ gì đó tự động hơn, nếu có thể. Tôi nhận ra tự động hóa như vậy không phải là một vấn đề nhỏ, nhưng nó đã được giải quyết trước đây (ArcGIS rõ ràng có cách thực hiện điều này với một phần mở rộng gọi là maplex, nhưng tôi không có quyền truy cập vào phần mềm và tôi muốn ở lại R nếu có thể).

Có ai biết một cách làm điều này?

MWE ở đây:

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

Tôi nghĩ rằng tôi có một cái gì đó có thể làm việc cho bạn. Tôi đã tự do thay đổi ví dụ của bạn thành một cái gì đó thực tế hơn một chút: một vài "dòng sông" ngẫu nhiên được thực hiện với các bước đi ngẫu nhiên được làm mịn, mỗi chiều dài 100 điểm:

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

Chúng tôi có thể vẽ chúng theo ví dụ của bạn:

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

Giải pháp của tôi về cơ bản là trích xuất các điểm từ linestrings và dán nhãn cho chúng. Giống như hình ảnh ở đầu câu hỏi của bạn, bạn có thể muốn có nhiều bản sao của mỗi nhãn dọc theo chiều dài của dòng, vì vậy nếu bạn muốn n nhãn, bạn chỉ cần trích xuất n điểm cách đều nhau.

Tất nhiên, bạn muốn có thể gắn nhãn cả hai con sông cùng một lúc mà không bị xung đột nhãn, vì vậy bạn sẽ cần có thể vượt qua nhiều tính năng địa lý dưới dạng danh sách được đặt tên.

Đây là một chức năng thực hiện tất cả điều đó:

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

Vì vậy, nếu chúng ta đặt các đối tượng chúng ta muốn gắn nhãn vào một danh sách có tên như thế này:

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

Sau đó chúng ta có thể làm điều này:

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