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")
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)
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)
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)
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)
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)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With