Is there a way to merge contiguous multilinestrings sf object in R?

Viewed 658

I hope anyone could help me. Say, I have seven line segments the first four are contiguous as well as the last three. There's no attribute that could be used to group them. Is there a way to merge the first four line segments into a single feature as well as the last three line segment?

Thank you in advance and stay safe!

library(sf)

s1 <- st_multilinestring(list(rbind(c(0,3), c(0,4))))
s2 <- st_multilinestring(list(rbind(c(0,4), c(1,5))))
s3 <- st_multilinestring(list(rbind(c(1,5), c(2,5))))
s4 <- st_multilinestring(list(rbind(c(2,5), c(2.5,5))))
s5 <- st_multilinestring(list(rbind(c(2.7,5), c(4,5))))
s6 <- st_multilinestring(list(rbind(c(4,5), c(4.5,4))))
s7 <- st_multilinestring(list(rbind(c(4.5,4), c(5,4))))

sf_ml <- st_sf(section = 1 ,geometry=st_sfc(list(s1,s2,s3,s4,s5,s6,s7)))
plot(sf_ml)

plot output

I was hoping to get something like this:

Simple feature collection with 2 features and 1 field
geometry type:  MULTILINESTRING
dimension:      XY
bbox:           xmin: 0 ymin: 3 xmax: 5 ymax: 5
CRS:            NA
# A tibble: 2 × 2
  section                                           geometry
*   <dbl>                                  <MULTILINESTRING>
1       1 ((0 3, 0 4), (0 4, 1 5), (1 5, 2 5), (2 5, 2.5 5))
2       1         ((2.7 5, 4 5), (4 5, 4.5 4), (4.5 4, 5 4))
1 Answers

I think you can use the following approach. The idea is to use a “geometric binary predicate” to calculate groups of connected and contiguous lines, extract their ID(s), and then merge the lines after grouping by the ID(s). First, load packages:

library(sf)
#> Linking to GEOS 3.9.0, GDAL 3.2.1, PROJ 7.2.1
library(igraph)
#> 
#> Attaching package: 'igraph'
#> The following objects are masked from 'package:stats':
#> 
#>     decompose, spectrum
#> The following object is masked from 'package:base':
#> 
#>     union
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:igraph':
#> 
#>     as_data_frame, groups, union
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

Create data

s1 <- st_multilinestring(list(rbind(c(0,3), c(0,4))))
s2 <- st_multilinestring(list(rbind(c(0,4), c(1,5))))
s3 <- st_multilinestring(list(rbind(c(1,5), c(2,5))))
s4 <- st_multilinestring(list(rbind(c(2,5), c(2.5,5))))
s5 <- st_multilinestring(list(rbind(c(2.7,5), c(4,5))))
s6 <- st_multilinestring(list(rbind(c(4,5), c(4.5,4))))
s7 <- st_multilinestring(list(rbind(c(4.5,4), c(5,4))))
sf_ml <- st_sf(section = 1 ,geometry=st_sfc(list(s1,s2,s3,s4,s5,s6,s7)))

Run st_touches to find the ids of those lines that share a boundary point.

(my_idx_touches <- st_touches(sf_ml))
#> Sparse geometry binary predicate list of length 7, where the predicate
#> was `touches'
#>  1: 2
#>  2: 1, 3
#>  3: 2, 4
#>  4: 3
#>  5: 6
#>  6: 5, 7
#>  7: 6

We can see that the first and second geometries share a boundary point and so on. Then, we convert this object into a graph object.

(my_igraph <- graph_from_adj_list(my_idx_touches))
#> IGRAPH fb199d0 D--- 7 10 -- 
#> + edges from fb199d0:
#>  [1] 1->2 2->1 2->3 3->2 3->4 4->3 5->6 6->5 6->7 7->6

Again, we can see that the first multilinestring is connected to the second multilinestring and so on. Finally, we can extract the groups of connected lines using the object named membership returned by the output of the function components().

(my_components <- components(my_igraph)$membership)
#> [1] 1 1 1 1 2 2 2

The first four geometries belong to one group, the other three geometries to another group. Finally, we can merge the lines in the same group using summarise()

sf_ml2 <- sf_ml %>% 
  group_by(section = as.character({{my_components}})) %>% 
  summarise()

Check the print

sf_ml2
#> Simple feature collection with 2 features and 1 field
#> Geometry type: MULTILINESTRING
#> Dimension:     XY
#> Bounding box:  xmin: 0 ymin: 3 xmax: 5 ymax: 5
#> CRS:           NA
#> # A tibble: 2 x 2
#>   section                                           geometry
#>   <chr>                                    <MULTILINESTRING>
#> 1 1       ((0 3, 0 4), (0 4, 1 5), (1 5, 2 5), (2 5, 2.5 5))
#> 2 2               ((2.7 5, 4 5), (4 5, 4.5 4), (4.5 4, 5 4))

and a plot

plot(sf_ml2, lwd = 2)

Created on 2021-09-14 by the reprex package (v2.0.1)

Related