用箭头连接两组SFC点

问题描述

我有一个数据框,其中两列是sfc点列表。

 > head(moves)
   hiring                      start                        end
 1      1 POINT (-2.030474 51.36306) POINT (-2.250102 51.41609)
 2      2 POINT (-2.319776 51.46162) POINT (-2.491189 51.41029)
 3      4 POINT (-2.025846 51.47712) POINT (-2.063781 51.49158)
 4      6 POINT (-2.426711 51.38076) POINT (-2.132722 51.46999)
 5      7  POINT (-2.116654 51.4887) POINT (-2.204403 51.51874)
 6      8  POINT (-2.122917 51.5861) POINT (-2.134635 51.51806)

我需要逐行绘制从一个点到另一个点的线(理想情况下是尖的)。我的问题似乎是我的文件(移动)不是sf对象。我需要将其制成一种,还是将其中的数据转换成其他格式?

 > dput(head(moves))
 structure(list(hiring = c(1L,2L,4L,6L,7L,8L),start = list(
     structure(c(-2.03047447566941,51.3630641761757),class = c("XY","POINT","sfg")),structure(c(-2.31977575385362,51.4616210429381
     ),structure(c(-2.02584648038463,51.4771163047678),structure(c(-2.42671091326068,51.3807643595824),structure(c(-2.1166538974769,51.4887039877758),structure(c(-2.12291705783767,51.5860957106472),"sfg"))),end = list(
     structure(c(-2.25010169528537,51.4160891285008),structure(c(-2.49118920138511,51.4102939905029
     ),structure(c(-2.06378098244424,51.491583244303),structure(c(-2.13272163343155,51.469987047928),structure(c(-2.20440279315621,51.5187438721622),structure(c(-2.1346350057738,51.5180564842074),"sfg")))),row.names = c(NA,6L),class = "data.frame")

解决方法

带有基本图形的简单箭头,其背景为空(无图)。

编辑:使用原始帖子中给出的数据,我意识到moves$startmoves$end不是sfc对象,而只是sfg对象的列表。可以使用sfc将它们转换为sf::st_as_sfc对象,然后可以提取坐标。完整的代码是:

library(sf)
#> Linking to GEOS 3.8.0,GDAL 3.0.4,PROJ 6.3.1
moves <- structure(
  list(hiring = c(1L,2L,4L,6L,7L,8L),start = list(
         structure(c(-2.03047447566941,51.3630641761757),class = c("XY","POINT","sfg")),structure(c(-2.31977575385362,51.4616210429381),structure(c(-2.02584648038463,51.4771163047678),structure(c(-2.42671091326068,51.3807643595824),structure(c(-2.1166538974769,51.4887039877758),structure(c(-2.12291705783767,51.5860957106472),"sfg"))),end = list(
         structure(c(-2.25010169528537,51.4160891285008),structure(c(-2.49118920138511,51.4102939905029),structure(c(-2.06378098244424,51.491583244303),structure(c(-2.13272163343155,51.469987047928),structure(c(-2.20440279315621,51.5187438721622),structure(c(-2.1346350057738,51.5180564842074),"sfg")))),w.names = c(NA,6L),class = "data.frame")

co_s <- st_coordinates(st_as_sfc(moves$start))
co_e <- st_coordinates(st_as_sfc(moves$end))
s_lon <- co_s[,"X"]
s_lat <- co_s[,"Y"]
e_lon <- co_e[,"X"]
e_lat <- co_e[,"Y"]
plot(c(s_lon,e_lon),c(s_lat,e_lat),col = rep(c("red","blue"),each = 6),pch = 20,cex = 2,xlab = "lon",ylab = "lat")
arrows(s_lon,s_lat,e_lon,e_lat)

,

很好的问题。抱歉,没有箭头。结果只有直线。为了回答这个问题,我需要将“运动”数据转换为两个矩阵对象:一个矩阵作为起点,第二个矩阵作为终点。

s_lon <- c(-2.030474,-2.319776,-2.025846,-2.426711,-2.116654,-2.122917)
s_lat <- c(51.36306,51.46162,51.47712,51.38076,51.4887,51.5861)
e_lon <- c(-2.250102,-2.491189,-2.063781,-2.132722,-2.204403,-2.134635)
e_lat <- c(51.41609,51.41029,51.49158,51.46999,51.51874,51.51806)

# Create matrixes from data

m_s <- matrix(data = c(s_lon,s_lat),nrow = 6,ncol = 2,byrow = FALSE)
m_e <- matrix(data = c(e_lon,byrow = FALSE)

然后使用循环将每个矩阵中的数据转换为简单特征几何点,并将每对(起点和终点)组合成一个列表。

然后绘制每对起点/终点以及连接它们的字符串。

n <- c(1:6)

myplotfct <- function(i,s1,e1,pt_s1.sfg,pt_e1.sfg,mylist) {
if(i == 1) {
    plot(mylist,axes = TRUE,xlim = c(-2.5,-1.8),ylim = c(51.3,51.65),pch = 19,cex = 3,col = "red",)
    ln1 <- st_nearest_points(pt_s1.sfg,pt_e1.sfg) 
    plot(ln1,add = TRUE) 
 } else {    
    plot(mylist,add = TRUE,col = "blue")
    ln1 <- st_nearest_points(pt_s1.sfg,add = TRUE)
    
    }
 }

my_s <- function(n,.) {   # Start Pt Function
    m_s[n,]    
}


my_e <- function(n,.) {     # End Pt Function
    m_e[n,]
}

for(i in 1:6) {
    s1 <- my_s(i,m_s[x,])     #  Fct call
    e1 <- my_e(i,m_e[x,])
    
    pt_s1.sfg <- st_point(x = c(s1),dim = "XY")  # convert s1 to geometric 
    pt_e1.sfg <- st_point(x = c(e1),dim = "XY")   # convert e1 to geometric
    mylist <- c(pt_s1.sfg,pt_e1.sfg)              # create a list of the two geometric points (start - end)
    myplotfct(i,mylist)
   
}

如果需要,可以通过更改每对颜色来改善输出。可以从此link:

查看输出