st_network_blend unable to blend count locations into bike network

[abdirashiddahir]

Describe the bug

st_network_blend is unable to blend count locations into a bike network. Most count locations are located 1 to 5 m away from the bike network. When I blend without tolerance, I get the following error:

> blended_col = st_network_blend(bike_columbus, columbus_count)
Error in data.frame(geom = edge_pts, edge_id = pts_idxs, feat_id = NA,  : 
  arguments imply differing number of rows: 89296, 132606, 1
In addition: Warning message:
st_network_blend assumes attributes are constant over geometries

However, when I blend the count locations into the bike network with tolerance, the function results in this warning message:

> tol = units::set_units(2, "m")
> blended_with_tolerance = st_network_blend(bike_columbus,columbus_count, tolerance = tol)
Warning message:
No points were blended. Increase the tolerance distance?

Reproducible example

#Libraries

library(sf)
#> Warning: package 'sf' was built under R version 4.2.2
#> Linking to GEOS 3.9.3, GDAL 3.5.2, PROJ 8.2.1; sf_use_s2() is TRUE
library(tmap)
#> Warning: package 'tmap' was built under R version 4.2.2
library(tidyverse)
#> Warning: package 'tidyverse' was built under R version 4.2.2
#> Warning: package 'ggplot2' was built under R version 4.2.2
#> Warning: package 'tibble' was built under R version 4.2.2
#> Warning: package 'tidyr' was built under R version 4.2.2
#> Warning: package 'readr' was built under R version 4.2.2
#> Warning: package 'purrr' was built under R version 4.2.2
#> Warning: package 'stringr' was built under R version 4.2.2
#> Warning: package 'forcats' was built under R version 4.2.2
library(sfnetworks)
#> Warning: package 'sfnetworks' was built under R version 4.2.3
library(igraph)
#> Warning: package 'igraph' was built under R version 4.2.2
#> 
#> Attaching package: 'igraph'
#> The following objects are masked from 'package:dplyr':
#> 
#>     as_data_frame, groups, union
#> The following objects are masked from 'package:purrr':
#> 
#>     compose, simplify
#> The following object is masked from 'package:tidyr':
#> 
#>     crossing
#> The following object is masked from 'package:tibble':
#> 
#>     as_data_frame
#> The following objects are masked from 'package:stats':
#> 
#>     decompose, spectrum
#> The following object is masked from 'package:base':
#> 
#>     union
library(ggraph)
#> Warning: package 'ggraph' was built under R version 4.2.2
library(tidygraph)
#> Warning: package 'tidygraph' was built under R version 4.2.2
#> 
#> Attaching package: 'tidygraph'
#> The following object is masked from 'package:igraph':
#> 
#>     groups
#> The following object is masked from 'package:stats':
#> 
#>     filter
library(reprex)
#> Warning: package 'reprex' was built under R version 4.2.3

# Data

#Network data

network_16 <- st_read("Networks.gdb", layer = "NWmodel16")  
crs <- st_crs(4326)
network_16 <- st_set_crs(network_16, crs)

columbus_network <- network_16 |>
  filter(City == "Columbus")

columbus_network <- st_transform(columbus_network, "+proj=utm +zone=17 +datum=WGS84 +units=km")

# count_data

df_count16 <- st_read("CountLocation.gdb", layer = "Loc_2016") 
head(df_count16)

columbus_count <- df_count16 |>
  filter(MetroArea == "Columbus")

# Match network and count data

columbus_count=st_transform(columbus_count,crs = st_crs(columbus_network))

# Data cleaning

## Network visualization

# Count locations on road network

tm_shape(columbus_network) +
  tm_lines(col = 'firebrick4', lwd = 1.5, alpha = 0.8)+
  tm_shape(columbus_count) +
  tm_dots(size=0.15, col="black")+
  tm_layout(title= 'Columbus count locations', 
            title.position = c('center', 'top'),
            frame = FALSE)

## Convert to network data

columbus_lines <- st_cast(columbus_network, "LINESTRING")

st_geometry(columbus_lines) = st_geometry(columbus_lines) %>%
  lapply(function(x) round(x, 0)) %>%
  st_sfc(crs = st_crs(columbus_lines))

bike_columbus <- as_sfnetwork(columbus_lines, directed = FALSE)

bike_columbus %>%
  sf_attr("agr", "edges")  # BREAK

bike_columbus %>%
  class()

par(mar = c(1, 1, 1, 1), bg = NA)  
plot(bike_columbus)

## Blending count locations into bike network 

blended_col = st_network_blend(bike_columbus, columbus_count)
#> Error in data.frame(geom = edge_pts, edge_id = pts_idxs, feat_id = NA,  : 
  arguments imply differing number of rows: 89296, 132606, 1
In addition: Warning message:
st_network_blend assumes attributes are constant over geometries

## Blend with tolerance

tol = units::set_units(2, "m")
blended_with_tolerance = st_network_blend(bike_columbus,columbus_count, tolerance = tol)
#>Warning message:
No points were blended. Increase the tolerance distance? 

^{Created on 2023-06-18 with reprex v2.0.2}

Expected behavior

I want this function to successfully blend count locations located around segments into the edge and count locations at intersections into the nodes of the bike network.

[agila5]

Hi @abdirashiddahir. Could you please share the relevant data? Otherwise it's difficult to reproduce your example.

[abdirashiddahir]

Hi @agila5 , I've sorted out the problem by taking the following steps.

• First, I dropped Z and/or M dimensions from my feature geometries.

network_16 <- sf::st_zm(sf::st_read("Networks.gdb",
                           layer="NWmodel16"), drop=TRUE, what="ZM")
sf::st_geometry(network_16) <- "geometry"

class(network_16)

head(network_16)

• Second, I have done away with the metric system for the projection and instead decided to stick with the WGS84 CRS 4326

columbus_network <- st_transform(columbus_network, "+proj=utm +zone=17 +datum=WGS84 +units=km")

• I have not rounded the coordinates

  st_geometry(columbus_lines) = st_geometry(columbus_lines) %>%
  lapply(function(x) round(x, 0)) %>%
  st_sfc(crs = st_crs(columbus_lines))

• Below is the clean code that blended count locations into the bike network

#Libraries

library(sf)
#> Warning: package 'sf' was built under R version 4.2.2
#> Linking to GEOS 3.9.3, GDAL 3.5.2, PROJ 8.2.1; sf_use_s2() is TRUE
library(tmap)
#> Warning: package 'tmap' was built under R version 4.2.2
library(tidyverse)
#> Warning: package 'tidyverse' was built under R version 4.2.2
#> Warning: package 'ggplot2' was built under R version 4.2.2
#> Warning: package 'tibble' was built under R version 4.2.2
#> Warning: package 'tidyr' was built under R version 4.2.2
#> Warning: package 'readr' was built under R version 4.2.2
#> Warning: package 'purrr' was built under R version 4.2.2
#> Warning: package 'stringr' was built under R version 4.2.2
#> Warning: package 'forcats' was built under R version 4.2.2
library(sfnetworks)
#> Warning: package 'sfnetworks' was built under R version 4.2.3
library(igraph)
#> Warning: package 'igraph' was built under R version 4.2.2
#> 
#> Attaching package: 'igraph'
#> The following objects are masked from 'package:dplyr':
#> 
#>     as_data_frame, groups, union
#> The following objects are masked from 'package:purrr':
#> 
#>     compose, simplify
#> The following object is masked from 'package:tidyr':
#> 
#>     crossing
#> The following object is masked from 'package:tibble':
#> 
#>     as_data_frame
#> The following objects are masked from 'package:stats':
#> 
#>     decompose, spectrum
#> The following object is masked from 'package:base':
#> 
#>     union
library(ggraph)
#> Warning: package 'ggraph' was built under R version 4.2.2
library(tidygraph)
#> Warning: package 'tidygraph' was built under R version 4.2.2
#> 
#> Attaching package: 'tidygraph'
#> The following object is masked from 'package:igraph':
#> 
#>     groups
#> The following object is masked from 'package:stats':
#> 
#>     filter
library(reprex)
#> Warning: package 'reprex' was built under R version 4.2.3

# Columbus bike network Data

columbus_network <- st_read("columbus_bike.shp")

crs <- st_crs(4326)
columbus_network <- st_set_crs(columbus_network, crs)

# count_data

columbus_count <- st_read("count_Data.shp")

# Match network and count data

columbus_count=st_transform(columbus_count,crs = st_crs(columbus_network))

## Network visualization

# Count locations on road network

tm_shape(columbus_network) +
  tm_lines(col = 'firebrick4', lwd = 1.5, alpha = 0.8)+
  tm_shape(columbus_count) +
  tm_dots(size=0.15, col="black")+
  tm_layout(title= 'Columbus count locations', 
            title.position = c('center', 'top'),
            frame = FALSE)

## Convert to network data

columbus_lines <- columbus_network

bike_columbus <- as_sfnetwork(columbus_lines, directed = FALSE)

par(mar = c(1, 1, 1, 1), bg = NA)  
plot(bike_columbus)

## Blending count locations into bike network 

> blended_col = st_network_blend(bike_columbus, columbus_count)
Warning message:
st_network_blend assumes attributes are constant over geometries 
> 
> # #Blend with tolerance
> 
> tol = units::set_units(2, "m")
> blended_with_tolerance = st_network_blend(bike_columbus,columbus_count, tolerance = tol)
Warning message:
st_network_blend assumes attributes are constant over geometries

^{Created on 2023-06-19 with reprex v2.0.2}

[abdirashiddahir]

@agila5 I want to mention that I wrote bike data (LINESTRING geometry) and count data (Point geometry) as shapefiles from file geodatabase (.gdb) using the following code:

#Libraries

library(sf)
library(tmap)
library(tidyverse)
library(sfnetworks)
library(igraph)
library(ggraph)
library(tidygraph)
library(reprex)

# Data

#Network data

network_16 <- sf::st_zm(sf::st_read("Networks.gdb",
                           layer="NWmodel16"), drop=TRUE, what="ZM")
sf::st_geometry(network_16) <- "geometry"

class(network_16)

head(network_16)

columbus_network <- network_16 |>
  filter(City == "Columbus")

col_bike <- columbus_network |>
  dplyr:: rename(FID = FID_LocalAndSecondaryRoadsPortla8, factype = FacilityType,
                 length = Shape_Length,street = StreetName, year = YearBuilt )

head(col_bike)

st_write(col_bike, "columbus_bike.shp")

# count_data

df_count16 <- st_read("CountLocation.gdb", layer = "Loc_2016") 
head(df_count16)

columbus_count <- df_count16 |>
  filter(MetroArea == "Columbus")

# Match network and count data

columbus_count=st_transform(columbus_count,crs = st_crs(columbus_network))

head(columbus_count)

st_write(columbus_count, "count_data.shp")

• For MULTILINESTRING geometry

columbus_lines <- st_cast(columbus_network, "LINESTRING")

[Robinlovelace]

Sounds like you resolved this issue, right? Great work, thanks for sharing code and please share results and feedback if you get a chance. The https://github.com/luukvdmeer/sfnetworks/discussions page may be idea for that.

[abdirashiddahir]

@Robinlovelace Thank you! I will post results and feedback on the discussions page.