从R + SF中的GPS点创建线段

编程问答 2022-06-05

问题描述

我将带时间戳的动物运动GPS坐标作为简单的特征集合（8068个特征），几何类型点。我需要将这些点转换为8067线段。从带有分组＃321的点创建线的解决方案：https://github.com/r-spatial/sf/issues/321需要一个分组字段将点连接到多条线。但是，对于GPS数据，点是连续的，没有组字段。

ArcGIS有一个解决方案，XY TO行：https://pro.arcgis.com/en/pro-app/tool-reference/data-management/xy-to-line.htm。有等效于此功能的R吗？

解决方法

sftraj步骤的说明准确地描述了我要执行的操作：https://mablab.org/post/sftraj-model/： 此解决方案也非常有帮助：Plotting lines between two sf POINT features in r 

library(readr)
library(sf)
library(tidyverse)

# Read-in GPS data. Data is in ascending order by date.
gps <- read_csv("X:/gps_xyt_data.csv")

# Create a unique ID column starting at 1 
gps <- tibble::rowid_to_column(gps,"KeyID")

# Create a second unique ID column starting at 0
gps$JoinID <- gps$KeyID - 1

# Select coordinates and KeyId 
start_xy <- gps %>% select(start_x = utm_e,start_y = utm_n,KeyID)

# Select coordinates and JoinID  
end_xy <- gps %>% select(end_x = utm_e,end_y = utm_n,JoinID) 

# Inner join to have start/end coordinate pairs for each record 
start_end_xy <- inner_join(start_xy,end_xy,by = c("KeyID" = "JoinID"))

# Select for start geometries and convert to sf object
pnts_start <- start_end_xy %>% st_as_sf( coords = c("start_x","start_y"),crs = 26911)

# Select for end geometries and convert to sf object
pnts_end <- start_end_xy %>% st_as_sf(coords = c("end_x","end_y"),crs = 26911)

# Combine start and end geometries
cbind(pnts_start,pnts_end) -> points_ready 

# Generate line segments via union of paired geometries
line_segments <- as.data.frame(st_sfc(mapply(function(a,b){st_cast(st_union(a,b),"LINESTRING")},points_ready$geometry,points_ready$geometry.1,SIMPLIFY=FALSE)))

# Add a unique ID to line segments
line_segments <- tibble::rowid_to_column(trj_lines,"KeyID")

# Join the attribute data to line segments
line_segments <- inner_join(line_segments,gps,by = c("KeyID" = "KeyID"))
,

稍微更简洁的 tidyverse 解决方案：

source_file <- 'INSERT_FILENAME_HERE'

empty <- st_as_sfc("POINT(EMPTY)",crs = 4326)

sf::st_read(source_file) %>% 
  # great circle distances
  st_set_crs(4326) %>% 
  mutate(
    geometry_lagged = lag(geometry,default = empty)
  ) %>%
  # drop the NA row created by lagging
  slice(-1) %>% 
  mutate(
    line = st_sfc(purrr::map2(
      .x = geometry,.y = geometry_lagged,.f = ~{st_union(c(.x,.y)) %>% st_cast("LINESTRING")}
    ))) -> track_lines
gisgpsrrsf