R 中 GIS 地图的自动标签放置

Automatic Label Placement for GIS maps in R

我在 R 中使用 sf 包(和相关包)读取 shapefile,并使用 ggplot2(和朋友)进行绘图来制作 GIS 地图。这很好用,但我找不到 (automatically/programmatically) 为河流和道路等要素创建标签放置的方法。这些特征通常是线串,具有不规则的形状。参见例如来自维基媒体的附加图片。

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

我想我有一些东西可能对你有用。我已经冒昧地将您的示例更改为更现实的东西:几个随机 "rivers" 使用平滑的随机游走制作,每个 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")

现在使用 geomtextpath 包更容易做到这一点。使用与上面相同的示例数据,我们现在可以:

library(geomtextpath)

ggplot() +
  geom_sf(data = BuncombeCounty, fill = "#DADABA") +
  geom_textsf(data = river_1, size = 4, vjust = -1, text_smoothing = 30,
              label = paste(rep("River 1", 3), collapse = "\t\t\t\t\t\t\t\t"),
              linecolour = "blue3") +
  geom_textsf(data = river_2, size = 4, vjust = -0.5, text_smoothing = 30,
              label = paste(rep("River 2", 3), collapse = "\t\t\t\t\t\t\t\t"),
              linecolour = "blue3")