r - Create linestring from two points in same row in dataframe

问题

I was wondering if there is a way to create linestring from two points given in the same row in a dataframe in a new geometry column. In other words longitudes and latitudes of the two points are given in a dataframe like the following:

df <- data.frame(id = c("a", "b"), lon1 = c(1,2), lat1 = c(3,4), lon2 = c(5,6), lat2 = c(7,8))

where lon1 and lat1 represent the coordinates of the first point and lon2 and lat2 are the coordinates of the second point. The desired dataframe would have two rows and two columns - the id column and a geometry column.

I tried with sf::st_linestring but seems this function only works with matrices.

Desired dataframe:

desired_df <- data.frame(id = c("a", "a", "b", "b"), lon = c(1,2,5,6), lat = c(3,4,7,8)) %>% st_as_sf(coords = c("lon", "lat"), dim = "XY") %>% st_set_crs(4236) %>% group_by(id) %>% summarise(geometry = st_union(geometry), do_union = FALSE) %>% st_cast("LINESTRING")

回答1:

Update - 30th Jan 2021

The issue with my original answer is it doesn't correctly set the bounding box.

Today I would use this approach using sfheaders and data.table

library(data.table)
library(sfheaders)

dt <- as.data.table(df)

## To use `sfheaders` the data needs to be in long form

dt1 <- dt[, .(id, lon = lon1, lat = lat1)]
dt2 <- dt[, .(id, lon = lon2, lat = lat2)]

## Add on a 'sequence' variable so we know which one comes first
dt1[, seq := 1L ]
dt2[, seq := 2L ]

## put back together
dt <- rbindlist(list(dt1, dt2), use.names = TRUE)
setorder(dt, id, seq)

sf <- sfheaders::sf_linestring(
  obj = dt
  , x = "lon"
  , y = "lat"
  , linestring_id = "id"
)

sf

# Simple feature collection with 2 features and 1 field
# geometry type:  LINESTRING
# dimension:      XY
# bbox:           xmin: 1 ymin: 3 xmax: 6 ymax: 8
# CRS:            NA
#   id              geometry
# 1  a LINESTRING (1 3, 5 7)
# 2  b LINESTRING (2 4, 6 8)

Original Answer

An alternative approach using data.table

require(data.table)

dt <- as.data.table(df)

sf <- dt[
    , {
        geometry <- sf::st_linestring(x = matrix(c(lon1, lon2, lat1, lat2), nrow = 2, ncol = 2))
        geometry <- sf::st_sfc(geometry)
        geometry <- sf::st_sf(geometry = geometry)
    }
    , by = id
]

sf::st_as_sf(sf)
# Simple feature collection with 2 features and 1 field
# geometry type:  LINESTRING
# dimension:      XY
# bbox:           xmin: 1 ymin: 3 xmax: 5 ymax: 7
# epsg (SRID):    NA
# proj4string:    NA
# id              geometry
# 1  a LINESTRING (1 3, 5 7)
# 2  b LINESTRING (2 4, 6 8)

回答2:

We can loop through the rows, with pmap and apply the st_linestring on a matrix created

library(tidyverse)
library(sf)
out <- pmap(df[-1], ~
               c(...) %>%
                matrix(., , ncol=2, byrow = TRUE) %>% 
                st_linestring) %>%
          reduce(st_sfc) %>%
          mutate(df, geometry = .)

out$geometry
#Geometry set for 2 features 
#geometry type:  LINESTRING
#dimension:      XY
#bbox:           xmin: 1 ymin: 3 xmax: 6 ymax: 8
#epsg (SRID):    NA
#proj4string:    NA
#LINESTRING (1 3, 5 7)
#LINESTRING (2 4, 6 8)

回答3:

This solution also uses purrr's pmap, obtaining the result in the desired format

library(tidyverse)
library(sf) 

df <- data.frame(id = c("a", "b"), lon1 = c(1,2), lat1 = c(3,4), lon2 = c(5,6), lat2 = c(7,8))  

make_line <- function(lon1, lat1, lon2, lat2) {
    st_linestring(matrix(c(lon1, lon2, lat1, lat2), 2, 2))
}

df %>%
    select(-id) %>% 
    pmap(make_line) %>% 
    st_as_sfc(crs = 4326) %>% 
    {tibble(id = df$id, geometry = .)} %>% 
    st_sf()

Result:

Simple feature collection with 2 features and 1 field
geometry type:  LINESTRING
dimension:      XY
bbox:           xmin: 1 ymin: 3 xmax: 6 ymax: 8
epsg (SRID):    4326
proj4string:    +proj=longlat +datum=WGS84 +no_defs
# A tibble: 2 x 2
  id            geometry
  <fct> <LINESTRING [°]>
1 a           (1 3, 5 7)
2 b           (2 4, 6 8)

回答4:

df = data.frame(id = c("a", "b"), lon1 = c(1,2), lat1 = c(3,4), lon2 = c(5,6), lat2 = c(7,8))  
df

##   id lon1 lat1 lon2 lat2
## 1  a    1    3    5    7
## 2  b    2    4    6    8

Here is another way, going through WKT:

library(sf)
df$geom = sprintf("LINESTRING(%s %s, %s %s)", df$lon1, df$lat1, df$lon2, df$lat2)
df = st_as_sf(df, wkt = "geom")
df

## Simple feature collection with 2 features and 5 fields
## geometry type:  LINESTRING
## dimension:      XY
## bbox:           xmin: 1 ymin: 3 xmax: 6 ymax: 8
## CRS:            NA
##   id lon1 lat1 lon2 lat2                  geom
## 1  a    1    3    5    7 LINESTRING (1 3, 5 7)
## 2  b    2    4    6    8 LINESTRING (2 4, 6 8)

来源：https://stackoverflow.com/questions/51918536/r-create-linestring-from-two-points-in-same-row-in-dataframe

标签

geometry

line