如何对不以格林威治为中心的 sf 对象使用 `ggplot2::geom_segment()` 或 `ggspatial::geom_spatial_segment()`？

Question

我想将路径添加到使用 ggplot2 中的

geom_sf

生成的地图中。

我熟悉使用以格林威治为中心的标准地图。但是当我改变地图设计时（？

crs

），通常的方法就失败了。

“正常”地图工作正常

point_df=data.frame(
  location=c('Tokyo','Brasilia','France'),
  lat=c(35.65,-15.79,48.86),
  long=c(139.84,-47.88,2.35)
)
point_df2=data.frame(
  from_location=c('Tokyo','Brasilia'),
  from_lat=c(35.65,-15.79),
  from_long=c(139.84,-47.88),
  to_location=c('France'),
  to_lat=c(48.86),
  to_long=c(2.35)
)

library("rnaturalearth")
world <- ne_countries(scale = "medium", returnclass = "sf")
transpoint = st_as_sf(point_df,coords=c("long","lat"),crs=4326)
world_sf <- st_transform(world, crs=4326)

ggplot(world_sf)+geom_sf()+
  geom_point(data=transpoint,aes(geometry=geometry,color=location),
stat="sf_coordinates")+
  geom_text_repel(data=transpoint,aes(geometry=geometry,label=location),
stat="sf_coordinates")+
  geom_curve(data=point_df2,
             aes(x=from_long,y=from_lat,xend=to_long,yend=to_lat),
colour='blue')

不起作用：地图具有不同的 CSR 或不以格林威治为中心

但是，如果我更喜欢以太平洋为中心的地图或椭圆形地图，它们就会失败。

以太平洋为中心的地图，带有

sf::st_break_antimeridian()

对于以太平洋为中心的地图，我使用了改编自 使用 geom_sf 穿越日期线时地图上的闭合边界的代码 请注意

geom_point()

效果很好。

geom_segment()

彻底失败了...

robinson <- "+proj=robin +lon_0=-90 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs"

world_pac <- world_sf %>%
  st_break_antimeridian(lon_0 = -90) %>% 
  st_transform(crs = robinson)

transpoint = st_as_sf(point_df,coords=c("long","lat"),crs=4326)
dtran = st_transform(transpoint,robinson)
library(ggrepel)
ggplot(world_pac)+geom_sf()+
  geom_point(data=dtran,aes(geometry=geometry,color=location),stat="sf_coordinates")+
  geom_text_repel(data=dtran,aes(geometry=geometry,label=location),stat="sf_coordinates")+
  geom_segment(data=point_df2, aes(x=from_long,y=from_lat,xend=to_long,yend=to_lat),
                       colour='blue')

ggspatial::geom_spatial_segment()

显示曲线/线段，但它们很奇怪。

ggplot(world_pac)+geom_sf()+
  geom_point(data=dtran,aes(geometry=geometry,color=location),stat="sf_coordinates")+
  geom_text_repel(data=dtran,aes(geometry=geometry,label=location),stat="sf_coordinates")+
  geom_spatial_segment(data=point_df2, aes(x=from_long,y=from_lat,xend=to_long,yend=to_lat),crs=4326,
                       wrap_dateline = FALSE,
                       colour='blue')

省略号地图

如果我转变为

geom_segment()

，我也无法使

geom_spatial_segment()

或

crs=2163

工作。

world_ellipse <- world_sf %>%
  st_transform(crs=2163)

transpoint = st_as_sf(point_df,coords=c("long","lat"),crs=4326)
dtran = st_transform(transpoint,crs=2163)

ggplot(world_ellipse)+geom_sf()+
  geom_point(data=dtran,aes(geometry=geometry,color=location),stat="sf_coordinates")+
  geom_text_repel(data=dtran,aes(geometry=geometry,label=location),stat="sf_coordinates")
geom_spatial_segment(data=point_df2,
                     aes(from_long, from_lat, xend = to_long, yend = to_lat),crs = 2163,
                     wrap_dateline = FALSE)

我在这里缺少什么？ 当我们使用不同的 CSR 时，如何与

geom_segment()

和/或

geom_spatial_segment()

与

ggplot2::geom_sf()

一起使用？

Answer 1

为了避免您面临的问题，最简单的方法是在您的兴趣点之间生成线条，然后

geom_curve()

这些线条。此示例使用

sf

对象，因为我相信这是绘制空间数据时最稳健的方法。

我从这个例子中删除了

ggrepel

，因为它就像玩打地鼠一样，以获得令人满意的结果。我已经调整了线条的曲率，因为默认值使法国/东京线弯曲离开地图，您可以调整这些值以适应。如果您想演示方向，示例图包含一个箭头选项（已注释掉）。

这是完整的工作代表：

library(rnaturalearth)
library(sf)
library(dplyr)
library(ggplot2)

# Your point data
point_df <- data.frame(
  location = c("Tokyo", "Brasilia", "France"),
  lat = c(35.65,-15.79,48.86),
  long = c(139.84,-47.88,2.35))

robinson <- "+proj=robin +lon_0=-90 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs"

# Create 90W-centred version of ne_countries with custiom CRS
world_pac <- ne_countries(scale = "medium", returnclass = "sf") %>%
  st_break_antimeridian(lon_0 = -90) %>% 
  st_transform(robinson)

# Create sf of your point data
transpoint <- st_as_sf(point_df, coords = c("long","lat"), crs = 4326) %>%
  st_transform(robinson)

# Generate lines between France and the rest
sf_line <- transpoint %>%
  st_set_geometry("to") %>%
  mutate(from = to[location == "France"],
         line_geom = st_union(to, from, by_feature = TRUE)) %>%
  filter(!location == "France") %>%
  st_set_geometry("line_geom") %>%
  st_cast("LINESTRING") %>%
  mutate(x1 = st_coordinates(from)[,1],
         y1 = st_coordinates(from)[,2],
         x2 = st_coordinates(to)[,1],
         y2 = st_coordinates(to)[,2])

#Plot
ggplot() +
  geom_sf(data = world_pac, colour = "grey70") +
  geom_sf(data = transpoint, colour = "#DF536B", size = 3) +
  geom_curve(data = sf_line, 
             aes(x = x1, y = y1, 
                 xend = x2, yend = y2), 
             colour = "#0072B2",
             # arrow = arrow(length = unit(0.03, "npc"), type="closed"),
             curvature = 0.4) +
  geom_sf_text(data = transpoint,
               aes(label = location),
               size = 4,
               fun.geometry = st_centroid,
               vjust = 2,
               colour = "black") +
  theme(axis.title = element_blank())