使用ggplot2在R中将网格外的数据点绘制为指向数据的箭头。

Question

我正在生成具有全球范围数据的地图，然后放大到特定区域。在缩放视图中，我想显示边界框外还有其他数据点，方法是从框的中心指向外部数据点的箭头。

注意: 我不需要是“大圆”路径，只需要是Mercator投影中的XY向量，因为我认为这对“正常”绘图也很有用。

这是一个示例，显示了数据范围的世界地图：

这是缩放视图，手动添加品红色箭头以显示我要生成的内容。

以下是我用于生成这两个基本图形的代码和数据。我需要的是一种生成箭头的方法。

require(ggplot2)

te = structure(list(lat = c(33.7399, 32.8571, 50.2214, 36.96263, 33.5835, 
33.54557, 47.76147, 48, 59.40289, 35.93411, 32.87962, 38.3241, 
50.03844, 37.44, 50.07774, 50.26668, 36.5944), lng = c(-118.37608, 
-117.25746, -5.3865, -122.00809, -117.86159, -117.79805, -124.45055, 
-126, -146.35157, -122.931472, -117.25285, -123.07331, -5.26339, 
25.4, -5.709894, -3.86828, -121.96201)), .Names = c("lat", "lng"
), class = "data.frame", row.names = c(NA, -17L))

all_states = map_data("world")

# world version:
wp = ggplot() + 
      geom_polygon(data = all_states, aes(x = long, y = lat, group = group), colour = "gray",
                   fill = "gray") +
      coord_cartesian(ylim = c(0, 80), xlim = c(-155, 45)) + 
      geom_point(data = te, aes(x = lng, y = lat), color = "blue", size = 5,alpha = 0.6)

print(wp)

#states plot
sp = ggplot() +
      geom_polygon(data = all_states, aes(x = long, y = lat, group = group), colour = "gray", fill = "gray") +
      coord_cartesian(ylim = c(30, 52), xlim = c(-128, -114)) + 
      geom_point(data = te, aes(x = lng, y = lat), color = "blue", size = 5, alpha = 0.6) 

print(sp)

- beroe

---

你可以添加一个 geom_segment 层，它们提供可选的箭头，并且在足够小的距离下，它是唯一可见的东西。 - baptiste

看一下这篇博客文章，或许可以给您一些灵感。 - shekeine

感谢评论。我担心的不是生成箭头，而是找到如何在正确的位置和方向绘制它们。最坏的情况下，我将不得不编写一个函数来检查超出边界框的点，然后为它们计算向量，解决该线与盒子侧面相交的x.y，然后在这些点处绘制旋转的三角形。但我希望有一个库或功能可能已经完成了此操作..！ - beroe

您需要箭头指向180度经线的另一侧，还是应该始终指向平面投影地图上的方向？ - Spacedman

棘手的部分可能是ggplot只有在绘制图形时才决定边界框，因此在添加箭头之前您不知道边缘坐标在哪里，而要在正确的位置添加箭头，您需要边缘坐标...这是一个进退两难的局面...我有一个想法... - Spacedman

Answer 1

这是我的尝试，也是我能做到的最接近结果。我使用了gcIntermediate()来计算你的美国地图中心点和位于bbox之外的数据点之间的最短距离。因此，箭头位置可能不是你想要的。我希望其他人能基于这个尝试提供更好的解决方案。

首先，我将你的df（即te）与美国缩放地图中心点一起排列。然后选择不在美国地图bbox范围内的数据点。接下来，添加两列以指示美国地图的中心点。重命名两列并使用gcIntermediate计算最短距离。

library(dplyr)
library(ggplot2)
library(geosphere)

filter(te, !between(lng, -128, -114) | !between(lat, 30, 52)) %>%
mutate(start_long = (-128 - 114) / 2,
       start_lat = (30 + 52) / 2) %>%
rename(end_lat = lat, end_long = lng) %>%
do(fortify(as(gcIntermediate(.[,c("start_long", "start_lat")],
                             .[,c("end_long", "end_lat")],
                             100,
                             breakAtDateLine = FALSE,
                             addStartEnd = TRUE,
                             sp = TRUE), "SpatialLinesDataFrame"))) -> foo

foo 包含100个数据点，用于绘制相应的线条。我选择了靠近bbox边界的数据点。我特别寻找每条线路的两个数据点，以便稍后使用 geom_segment() 。我承认我对筛选条件进行了一些调整。最终，在这种情况下，我没有使用纬度对数据进行子集划分。

filter(foo, between(long, -128, -126.5) | between(long, -115.5, -114)) %>%
group_by(group) %>%
slice(c(1,n())) -> mydf

在下一步中，我根据这个链接重新排列了数据框。

mutate(mydf, end_long = lag(long), end_lat = lag(lat)) %>%
slice(n()) -> mydf2

最后，我用箭头画了地图。希望这能为你提供一些基础，并希望其他SO用户能提供更好的解决方案。

ggplot() +
geom_polygon(data = all_states, aes(x = long, y = lat, group = group),
             colour = "gray", fill = "gray" ) +
coord_cartesian(ylim = c(30, 52), xlim = c(-128,-114)) +
geom_point(data = te, aes(x = lng,y = lat), color = "blue", size = 5,alpha = 0.6) +
geom_segment(data = mydf2, aes(x = end_long, xend = long,
                               y = end_lat, yend = lat, group = group),
                               arrow = arrow(length = unit(0.2, "cm"), ends = "last"))

- jazzurro

---

谢谢jazzurro。我喜欢你解决方案的某些方面，只希望它能计算与边界的交点，而不是从100个点中选择最近的一个。 - beroe

@beroe 谢谢您的评论。我想帮助您解决我所知道的问题。最终您得到了非常有用的答案。我为您感到非常高兴！ - jazzurro

Answer 2

这个解决方案使用了sp和rgeos包来操作空间数据，主要是通过相交的线和一个框型多边形来获取箭头的边缘点。然后如果使用geom_segment画箭头，并将宽度设为零，则线条是不可见的，只有箭头头部留下。

这个函数计算线段与框型的交点：

boxint <- function(xlim, ylim, xp, yp){
    ## build box as SpatialPolygons
    box = cbind(xlim[c(1,2,2,1,1)],
        ylim[c(1,1,2,2,1)])
    box <- sp::SpatialPolygons(list(sp::Polygons(list(sp::Polygon(box)),ID=1)))

    ## get centre of box
    x0=mean(xlim)
    y0=mean(ylim)

    ## construct line segments to points
    sl = sp::SpatialLines(
        lapply(1:length(xp),
               function(i){
                   sp::Lines(list(sp::Line(cbind(c(x0,xp[i]),c(y0,yp[i])))),ID=i)
               }
               )
        )
    ## intersect lines segments with boxes to make points
    pts = rgeos::gIntersection(sl, as(box, "SpatialLines"))
    as.data.frame(sp::coordinates(pts), row.names=1:length(xp))
}

这将返回带有箭头的 geom：

wherelse <- function(xlim, ylim, points){
    ## get points outside bounding box
    outsides = points[!(
        points$lng>=xlim[1] &
            points$lng <= xlim[2] &
                points$lat >= ylim[1] &
                    points$lat <= ylim[2]),]
    npts = nrow(outsides)
    ## get centre point of box
    x = rep(mean(xlim),npts)
    y = rep(mean(ylim),npts)

    ## compute box-point intersections
    pts = boxint(xlim, ylim, outsides$lng, outsides$lat)
    pts$x0=x
    pts$y0=y
    ## create arrow segments as invisible lines with visible arrowheads
    ggplot2::geom_segment(data=pts, aes(x=x0,y=y0,xend=x,yend=y),
       lwd=0, arrow=grid::arrow(length=unit(0.5,"cm"),
       type="closed"),col="magenta")
}

所以你的例子，基本情节是:

sp = ggplot() + 
  geom_polygon(
   data=all_states, 
    aes(x=long, y=lat, group = group),colour="gray",fill="gray" ) + 
    coord_cartesian(ylim=c(30, 52), xlim=c(-128,-114)) + 
    geom_point(data=te,aes(x=lng,y=lat),color="blue",size=5,alpha=0.6)

然后使用以下代码添加箭头：

sp + wherelse(c(-128,-114), c(30,52), te)

不确定是否有一个选项可以精确地绘制您想要的箭头！

- Spacedman

---

多年后再次回顾，我甚至喜欢你的函数名称：^）谢谢。 - beroe