CODEWITHSUNDEEP
rgeometryliner-sf
adl
adl

Reputation: 1441

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")

Upvotes: 14

Views: 5615

Answers (4)

SymbolixAU
SymbolixAU

Reputation: 26248

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)

Upvotes: 10

Michael Dorman
Michael Dorman

Reputation: 1020

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)

Upvotes: 12

HAVB
HAVB

Reputation: 1888

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)

Upvotes: 3

akrun
akrun

Reputation: 886948

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)

Upvotes: 7

Related Questions