Automatyczne umieszczanie etykiet dla map GIS w R.

Tworzę mapy GIS w R, używając sfpakietu (i powiązanych pakietów) do czytania w plikach kształtów oraz ggplot2(i znajomych) do kreślenia. Działa to dobrze, ale nie mogę znaleźć (automatycznie / programowo) sposobu umieszczania etykiet dla obiektów takich jak rzeki i drogi. Te cechy są zwykle liniami o nieregularnych kształtach. Zobacz obraz załączony na przykład z wikimedia.

ggrepelPakiet działa dobrze do znakowania punktów w sposób zautomatyzowany, ale to nie ma większego sensu dla innych obiektów geograficznych, które nie są dyskretne punkty Lat / Long.

Mógłbym to sobie wyobrazić, umieszczając indywidualne etykiety tekstowe dla każdej funkcji osobno, ale szukam czegoś bardziej zautomatyzowanego, jeśli to możliwe. Zdaję sobie sprawę, że taka automatyzacja nie jest trywialnym problemem, ale została już wcześniej rozwiązana (ArcGIS najwyraźniej ma taką możliwość z rozszerzeniem o nazwie maplex, ale nie mam dostępu do oprogramowania i chciałbym zostać w nim R, jeśli to możliwe).

Czy ktoś wie, jak to zrobić?

MWE tutaj:

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

Myślę, że mam coś, co może ci pomóc. Pozwoliłem sobie na zmianę twojego przykładu na coś bardziej realistycznego: kilka losowych „rzek” wykonanych za pomocą wygładzonych losowych spacerów, każde o długości 100 punktów:

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

Możemy wykreślić je według twojego przykładu:

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

Moje rozwiązanie polega w zasadzie na wydobywaniu punktów z linii i oznaczaniu ich. Podobnie jak obrazek na górze pytania, możesz potrzebować wielu kopii każdej etykiety wzdłuż długości linii, więc jeśli chcesz n etykiet, po prostu wyodrębnij n równo rozmieszczonych punktów.

Oczywiście chcesz mieć możliwość oznakowania obu rzek jednocześnie, bez kolizji etykiet, więc musisz przekazać wiele obiektów geograficznych jako listę nazwaną.

Oto funkcja, która robi to wszystko:

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

Więc jeśli umieścimy obiekty, które chcemy oznaczyć na nazwanej liście, takiej jak ta:

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

Następnie możemy to zrobić:

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