Automati c Размещение меток для карт ГИС в R - PullRequest
Новая
       74

Automati c Размещение меток для карт ГИС в R

9 голосов
/ 06 февраля 2020

Я делаю ГИС-карты в R, используя пакет sf (и связанные с ним пакеты) для чтения в шейп-файлах и ggplot2 (и друзья) для построения графиков. Это работает нормально, но я не могу найти способ (автоматически / программно) создать места размещения меток для таких объектов, как реки и дороги. Эти особенности обычно представляют собой линейные линии неправильной формы. Смотрите изображение, прикрепленное, например, из Викимедиа.

enter image description here

Пакет ggrepel хорошо подходит для автоматической маркировки точек, но это не имеет особого смысла для других регионов c особенности, которые не являются дискретными точками широты и долготы.

Я мог бы представить это, поместив отдельные текстовые метки на каждую функцию в отдельности, но я ищу что-то более автоматизированное, если это возможно. Я понимаю, что такая автоматизация не является тривиальной проблемой, но она была решена раньше (очевидно, у 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")

enter image description here

1 Ответ

8 голосов
/ 19 февраля 2020

Я думаю, у меня есть кое-что, что может сработать для вас. Я позволил себе сменить ваш пример на что-то более реалистичное c: пара случайных "рек", сделанных сглаженными случайными блужданиями, каждая длиной 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

enter image description here

Мое решение в основном состоит в извлечении точек из линейных линий и маркировке их. Как и на картинке вверху вашего вопроса, вам может потребоваться несколько копий каждой метки по всей длине строки, поэтому, если вы хотите, чтобы 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")

enter image description here

...