更新 sf linestring 的（第一个和最后一个）坐标 object

Question

I have a large sf-object with LINESTRING-geometry (~ 100000 rows). Of this object, I want to change the first and last coordinate/point of each linestring.

I know I can do this by casting the linestrings to points, change the geometry of the first and last row/point of each linestring id, and the cast back to linestring. But this seems like a lot of extra (unnecessairy?) steps and calculations. I have got a feeling this can be done in a more direct way... but I don't know how.

library(sf)
library(tidyverse)

#sample data
mypoints <- data.frame(id = 1, lon = 1:5, lat = 1:5)

line1 <- mypoints %>% 
  st_as_sf(coords = c("lon", "lat"), crs = 4326) %>%
  dplyr::group_by(id) %>% 
  dplyr::summarise() %>% 
  st_cast("LINESTRING") 

# desired output
# change first coordinate of line from (1,1) to (1,2), 
# and last coordinate from (5,5) to (5,4)
# so in the end, line 1 should look like line2
mypoints2 <- data.frame(id = 1, lon = c(1:5), lat = c(2,2:4,4))

line2 <- mypoints2 %>% 
  st_as_sf(coords = c("lon", "lat"), crs = 4326) %>%
  dplyr::group_by(id) %>% 
  dplyr::summarise() %>% 
  st_cast("LINESTRING")

# old = blue, new = red
ggplot() + 
  geom_sf(data = line1, color = "blue", linewidth  = 6) +
  geom_sf(data = line2, color = "red", linewidth  = 3)

my current method:

# cast LINESTRINGs to POINTs
line2 <- line1 %>% st_cast("POINT")

# create sf object with net start ans endpoints
new_start_end <- data.frame(id = c("first", "last"), 
                            lon = c(1,5),
                            lat = c(2,4)) %>% 
                       st_as_sf(coords = c("lon", "lat"), crs = 4326)
# set first and last value of geometry to new values
st_geometry(line2[c(1,nrow(line2)),]) <- st_geometry(new_start_end)

line2 %>% 
  dplyr::group_by(id) %>% 
  dplyr::summarise() %>% 
  st_cast("LINESTRING")
# Simple feature collection with 1 feature and 1 field
# Geometry type: LINESTRING
# Dimension:     XY
# Bounding box:  xmin: 1 ymin: 2 xmax: 5 ymax: 4
# Geodetic CRS:  WGS 84
# # A tibble: 1 × 2
#        id                  geometry
#     <dbl>          <LINESTRING [°]>
#   1     1 (1 2, 2 2, 3 3, 4 4, 5 4)

Answer 1

Here is a way to do this via purrr::modify . You can change the desired way of modification in the custom function.

Setup

library(sf)
#> Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1; sf_use_s2() is TRUE
library(tidyverse)

# CHANGED sample data -> poc that it works with multiple lines as well
mypoints <- data.frame(id = c(rep(1:2, 5)), lon = 1:10, lat = 1:10)

line12 <- mypoints %>% 
  st_as_sf(coords = c("lon", "lat"), crs = 4326) %>%
  dplyr::group_by(id) %>% 
  dplyr::summarise() %>% 
  st_cast("LINESTRING") 

Solution

# example modification: replace first and last value with 0
modify_fun <- function(g) {
  g[c(1, length(g))] <- c(0,0)
  return(g)
}

# keep old object for comparison
line12_mod <- line12

# modify lines
line12_mod$geometry <- purrr::modify(line12$geometry, .f = modify_fun)
line12_mod
#> Simple feature collection with 2 features and 1 field
#> Geometry type: LINESTRING
#> Dimension:     XY
#> Bounding box:  xmin: 1 ymin: 1 xmax: 10 ymax: 10
#> Geodetic CRS:  WGS 84
#> # A tibble: 2 × 2
#>      id                   geometry
#> * <int>           <LINESTRING [°]>
#> 1     1  (0 1, 3 3, 5 5, 7 7, 9 0)
#> 2     2 (0 2, 4 4, 6 6, 8 8, 10 0)

Plot

ggplot() + 
  geom_sf(data = line12,     color = "blue", linewidth = 6) +
  geom_sf(data = line12_mod, color = "red",  linewidth = 3)