Filling road network data gaps

Question

I have a motorway network with count points that can be matched to road links. However, they only match around half the osm links. The network is uni directional and it should be possible to assign data from joining links to the missing links.

I currently have a rather ugly and long solution based on a WHILE loop that sequentially fills the connecting links. However, I think a more elegant solution might be possible by using an sfnetwork or spatial lines network. The packages stplanr, sfnetwork and dodger closely match what I want to do, but all seem to focus on routing and origin destination data.

Below is a reproducible example that uses a small area of UK motorway network and removes a random sample of half the links and generates flow and speed data for the half remaining.

How do I fill in the missing links with data from either end of the missing links?

library(tidyverse)
library(mapview)
library(sf)
library(osmdata)

## define area to import osm data
x_max <- -2.31
x_min <- -2.38
y_max <- 51.48
y_min <- 51.51

##create a data frame to setup a polygon generation
df <- data.frame(X = c(x_min, x_max, x_max, x_min),
                 Y = c(y_max, y_max, y_min, y_min))

##generate a polygon of the area
rd_area <- df %>%
  st_as_sf(coords = c("X", "Y"), crs = 4326) %>%
  dplyr::summarise(geometry = st_combine(geometry)) %>%
  st_cast("POLYGON")

##get osm geometry for motorway links for defined area
x <- opq(bbox = rd_area) %>% 
  add_osm_feature(key = c('highway'), value = c('motorway', 
                                                'motorway_link')) %>% osmdata_sf()

## extract line geometry, generate a unique segment ID and get rid of excess columns
rdz <- x$osm_lines %>% 
  mutate(seg_id = paste0("L", sprintf("%02d", 1:NROW(bicycle)))) %>% 
  select(seg_id)

## pretend we only have traffic counts and speeds for half the links
osm_dat <- rdz[c(3,4,5,7,11,14,15),]

## links without data
osm_nodat <- filter(rdz, !seg_id %in% osm_dat$seg_id)

## visualise links with data and without
mapview(osm_dat, color = "green")+mapview(osm_nodat, color = "red")

## make up some data to work with
pretend_counts <- st_centroid(osm_dat)

## assign some random annual average daily flow and speed averages
pretend_counts$aadt <- sample(200:600, nrow(pretend_counts))
pretend_counts$speed <- sample(40:80, nrow(pretend_counts))

Answer 1

Here is one quick and elegant solution from the Cyipt project https://github.com/cyipt/cyipt/blob/master/scripts/prep_data/get_traffic.R

It uses the code from the get.aadt.class function and uses Voroni polygons to give the flows and speeds to the nearest roads. However, it doesn't distribute, i.e. split the flows where one links meets two and it sometimes results in opposing directions having the same flows and speeds.

library(dismo) ## dismo package for voroni polygon generation

  #Make voronoi polygons and convert to SF
  voronoi <- dismo::voronoi(x = st_coordinates(pretend_counts))
  voronoi <- as(voronoi, "sf")
  st_crs(voronoi) <- st_crs(pretend_counts)

  #Find Intersections of roads with vernoi polygons
  inter <- st_intersects(osm_nodat,voronoi)
  #Get aadt and ncycle values
  osm_nodat$aadt <- as.numeric(lapply(1:nrow(osm_nodat),function(x){as.numeric(round(mean(pretend_counts$aadt[inter[[x]]])),0)}))
  osm_nodat$speed <- as.numeric(lapply(1:nrow(osm_nodat),function(x){as.numeric(round(mean(pretend_counts$speed[inter[[x]]])),0)}))

  #Remove Unneded Data
  all_osm <- as.data.frame(rbind(osm_dat, osm_nodat))
  st_geometry(all_osm) <- all_osm$geometry
  flows <- dplyr::select(all_osm, aadt)
  mapview(flows)