collapsing_polygons.md

Collapsing polygons

mackaszechno 27 February 2026

Problem

see https://rmarkdown.rstudio.com/github_document_format.html for reference here to creating github document (rmarkdown custom template)

Note: what follows is a very crude github md to demonstrate key points.

Current restrictions are based on polygons from kerbside to centreline of road. New procedures require that these be made into polylines that mimick roadmarkings that follow the kerbline.

Issue 1: not all polygons touch kerbline. Buffering either to extract affected kerbline not sufficient.

Issue 2: simply casting polygons to linestrings, insufficient.

Solution: cast polygons to points and, for those vertices not already on the kerbline, compute

Setup

Libraries used:

library(sf)
library(dplyr)
library(mapgl)
library(mapview)
library(units)

Data files:

pow <- read_sf("./shapefile/CPE_PROHIBITION_OF_WAITING.shp")
kerb <- read_sf("./shapefile/mm_TopographicLine.shp") 
area <- read_sf("./shapefile/mm_TopographicArea.shp")

Initial mapping

maplibre_view(kerb) |> add_view(pow, color = "red")

Linestrings

line1 <- pow |> st_cast("LINESTRING") |> mutate(ID = 1:n(), .before = 1)
maplibre_view(kerb1) |> add_view(line1, color = "red")

Points

p1 <- pow |> filter(MI_PRINX == 17407)
pt1 <- p1 |> st_cast("POINT") |> mutate(ID = 1:n(), .before = 1)
maplibre_view(kerb) |> add_view(pt1, color = "red")

Using st_nearest_points

Selecting one point clearly not on kerbline and finding st_nearest_points

pt10 <- pt1 |> filter(ID == 10)
bob1 <- st_nearest_points(pt10, kerb) |> st_as_sf()

Using st_length to sort by distance

bob1 <- bob1 |> mutate(dist = st_length(st_geometry(bob1)))
bob1 <- bob1 |> filter(dist < set_units(10, "m"))

Sorting length and slicing top one

bob1 <- bob1 |> arrange(dist) |> slice(1)

Casting to points and finding endpoint

bob1 <- bob1 |> arrange(dist) |> slice(1) |> st_cast("POINT")
bob1end <- lwgeom::st_endpoint(bob1) |> st_sfc() |> st_as_sf()

Checking

Confirming that endpoint is new location on kerb and not existing vertices on kerb

kerb1osgb1000002048044915 <- kerb1 |> filter(gml_id == "osgb1000002048044915") |> st_cast("POINT")

maplibre_view(bob1, color = "blue", legend = TRUE, layer_id = "bob1") |> 
  add_view(bob1end, color = "red", layer_id = "bob1end") |> 
  add_view(pt10, color = "green", layer_id = "pt10") |> 
  add_view(kerb1, color = "yellow", layer_id = "osmm line") |> 
  add_view(kerb1osgb1000002048044915, color = "orange", layer = "target feature") |> 
  add_layers_control()

todo

Wrap the above up into a lowlevel helper function and then create a high level function that checks for vertices on/off kerbline and returns attributes from original polygon and new points. Make new points into new linestring to replace original polygon.

todo 2

Potentially investigate direction required to allow drawing offset symbology to appear to left of linestring (ie on the road) given location of centreline of road.

Further reading:
https://stackoverflow.com/questions/51292952/snap-a-point-to-the-closest-point-on-a-line-segment-using-sf
https://gis.stackexchange.com/questions/288570/find-nearest-point-along-polyline-using-sf-package-in-r

Source - https://stackoverflow.com/a/51300037

Posted by TimSalabim, modified by community. See post 'Timeline' for change history

Retrieved 2026-02-27, License - CC BY-SA 4.0

library(sf)
library(mapview)

st_snap_points = function(x, y, max_dist = 1000) {

  if (inherits(x, "sf")) n = nrow(x)
  if (inherits(x, "sfc")) n = length(x)

  out = do.call(c,
                lapply(seq(n), function(i) {
                  nrst = st_nearest_points(st_geometry(x)[i], y)
                  nrst_len = st_length(nrst)
                  nrst_mn = which.min(nrst_len)
                  if (as.vector(nrst_len[nrst_mn]) > max_dist) return(st_geometry(x)[i])
                  return(st_cast(nrst[nrst_mn], "POINT")[2])
                })
  )
  return(out)
}

brew = st_transform(breweries, st_crs(trails))

tst = st_snap_points(brew, trails, 500)

mapview(breweries) + mapview(tst, col.regions = "red") + trails