# packages
library(sf)
#> Linking to GEOS 3.9.0, GDAL 3.2.1, PROJ 7.2.1
library(tidygraph)
#>
#> Attaching package: 'tidygraph'
#> The following object is masked from 'package:stats':
#>
#> filter
library(sfnetworks)
#> Registered S3 method overwritten by 'spatstat.geom':
#> method from
#> print.boxx cli
library(osmdata)
#> Data (c) OpenStreetMap contributors, ODbL 1.0. https://www.openstreetmap.org/copyright
library(tmap)
# download data
my_osm_data <- opq(c(9.366765, 45.812190, 9.484896, 45.906143)) %>%
add_osm_feature(key = "highway") %>%
osmdata_sf(quiet = FALSE)
#> Issuing query to Overpass API ...
#> Rate limit: 0
#> Query complete!
#> converting OSM data to sf format
my_osm_data <- osm_poly2line(my_osm_data)
# Create sfnetwork object
my_roads <- my_osm_data$osm_lines
my_sfn <- as_sfnetwork(my_roads[, c("osm_id", "name", "highway")], directed = FALSE)
# Apply to_spatial_subdivision morpher and select only edges in the first
# component (simpler plot)
my_sfn <- my_sfn %>%
convert(to_spatial_subdivision, .clean = TRUE) %>%
convert(to_components, .select = 1, .clean = TRUE)
#> Warning: to_spatial_subdivision assumes attributes are constant over geometries
# Add weights
my_sfn <- my_sfn %E>% mutate(weight = as.numeric(edge_length()))
# Create and plot two points in the road network
my_from <- st_sfc(st_point(c(9.42029, 45.84701)), crs = 4326)
my_to <- st_sfc(st_point(c(9.412025, 45.900548)), crs = 4326)
tm_shape(my_sfn %>% st_as_sf("edges")) +
tm_lines(col = "darkgrey") +
tm_shape(my_from) +
tm_dots(col = "red", size = 0.1) +
tm_shape(my_to) +
tm_dots(col = "blue", size = 0.1)
# Estimate and plot the shortest path
idxs_shortest_path_v1 <- st_network_paths(my_sfn, my_from, my_to)
#> although coordinates are longitude/latitude, st_nearest_points assumes that they are planar
#> although coordinates are longitude/latitude, st_nearest_points assumes that they are planar
idx_edges_v1 <- idxs_shortest_path_v1 %>% pull(edge_paths) %>% unlist()
shortest_path_sf_v1 <- my_sfn %>%
slice(idx_edges_v1) %>%
st_as_sf("edges")
tm_shape(my_sfn %>% st_as_sf("edges")) +
tm_lines(col = "darkgrey") +
tm_shape(shortest_path_sf_v1) +
tm_lines(col = "orange", lwd = 2) +
tm_shape(my_from) +
tm_dots(col = "red", size = 0.1) +
tm_shape(my_to) +
tm_dots(col = "blue", size = 0.1)
# Multiply the weights of all edges in the shortest path by 1000
old_weight <- my_sfn %E>% pull(weight)
new_weight <- old_weight
new_weight[idx_edges_v1] <- new_weight[idx_edges_v1] * 1000
my_sfn <- my_sfn %E>% mutate(weight = new_weight)
# Re-estimate shortest path
idxs_shortest_path_v2 <- st_network_paths(my_sfn, my_from, my_to)
#> although coordinates are longitude/latitude, st_nearest_points assumes that they are planar
#> although coordinates are longitude/latitude, st_nearest_points assumes that they are planar
idx_edges_v2 <- idxs_shortest_path_v2 %>% pull(edge_paths) %>% unlist()
shortest_path_sf_v2 <- my_sfn %>%
slice(idx_edges_v2) %>%
st_as_sf("edges")
tm_shape(my_sfn %>% st_as_sf("edges")) +
tm_lines(col = "darkgrey") +
tm_shape(shortest_path_sf_v1) +
tm_lines(col = "orange", lwd = 2) +
tm_shape(shortest_path_sf_v2) +
tm_lines(col = "purple", lwd = 2) +
tm_shape(my_from) +
tm_dots(col = "red", size = 0.1) +
tm_shape(my_to) +
tm_dots(col = "blue", size = 0.1)
# On the other hand, if you want to modify the weights associated to all edges
# with the same osm_id as the edges in the shortest path, then you can proceed
# as follows:
(my_osm_id <- my_sfn %>% slice(idx_edges_v2) %>% pull(osm_id))
#> [1] "28128336" "51015527" "51015527" "51015527" "51085277" "51085277"
#> [7] "51236954" "51236954" "51236954" "51236962" "51236962" "51236962"
#> [13] "51236962" "51236962" "51236967" "51236969" "51236969" "51236969"
#> [19] "51236970" "51240871" "51240871" "51240871" "51240871" "51240871"
#> [25] "92105418" "92105418" "92105418" "122374667" "148969977" "161363117"
#> [31] "161363117" "161363117" "161363117" "161363117" "161363117" "171722736"
#> [37] "171722752" "171722753" "171722754" "171722754" "171722754" "171722758"
#> [43] "171722758" "171722763" "171722769" "174586119" "174586119" "174586119"
#> [49] "174586119" "174586119" "186618044" "224200694" "304375816" "304375818"
#> [55] "304375818" "306599129" "307086999" "307220713" "307220713" "307220713"
#> [61] "307220713" "307220713" "309139421" "309139421" "309139422" "309139422"
#> [67] "309139424" "309139428" "310600655" "310600695" "310600703" "310729940"
#> [73] "310729940" "310729944" "311344423" "312147419" "312147422" "312147424"
#> [79] "312147426" "312147429" "312147433" "331370016" "331370017" "355176132"
#> [85] "355176132" "355176132" "369940528" "411370718" "411370718" "443105418"
#> [91] "532448264" "532448268" "559887883" "559887883" "571637583" "810839084"
#> [97] "922312140" "922312141" "922312142" "922312143" "922312144" "922312145"
#> [103] "532448263" "532448263"
my_sfn <- my_sfn %E>%
mutate(weight = ifelse(osm_id %in% my_osm_id, weight * 1000, weight))
# Re-estimate shortest path
idxs_shortest_path_v3 <- st_network_paths(my_sfn, my_from, my_to)
#> although coordinates are longitude/latitude, st_nearest_points assumes that they are planar
#> although coordinates are longitude/latitude, st_nearest_points assumes that they are planar
idx_edges_v3 <- idxs_shortest_path_v3 %>% pull(edge_paths) %>% unlist()
shortest_path_sf_v3 <- my_sfn %>%
slice(idx_edges_v3) %>%
st_as_sf("edges")
tm_shape(my_sfn %>% st_as_sf("edges")) +
tm_lines(col = "darkgrey") +
tm_shape(shortest_path_sf_v1) +
tm_lines(col = "orange", lwd = 2) +
tm_shape(shortest_path_sf_v2) +
tm_lines(col = "purple", lwd = 2) +
tm_shape(shortest_path_sf_v3) +
tm_lines(col = "darkgreen", lwd = 2) +
tm_shape(my_from) +
tm_dots(col = "red", size = 0.1) +
tm_shape(my_to) +
tm_dots(col = "blue", size = 0.1)
Created on 2021-03-28 by the reprex package (v1.0.0)
Session info
sessioninfo::session_info()
#> - Session info ---------------------------------------------------------------
#> setting value
#> version R version 4.0.4 (2021-02-15)
#> os Windows 10 x64
#> system x86_64, mingw32
#> ui RTerm
#> language (EN)
#> collate Italian_Italy.1252
#> ctype Italian_Italy.1252
#> tz Europe/Berlin
#> date 2021-03-28
#>
#> - Packages -------------------------------------------------------------------
#> package * version date lib
#> abind 1.4-5 2016-07-21 [1]
#> assertthat 0.2.1 2019-03-21 [1]
#> backports 1.2.1 2020-12-09 [1]
#> base64enc 0.1-3 2015-07-28 [1]
#> class 7.3-18 2021-01-24 [2]
#> classInt 0.4-3 2020-04-07 [1]
#> cli 2.3.1 2021-02-23 [1]
#> codetools 0.2-18 2020-11-04 [2]
#> colorspace 2.0-0 2020-11-11 [1]
#> crayon 1.4.1 2021-02-08 [1]
#> crosstalk 1.1.1 2021-01-12 [1]
#> curl 4.3 2019-12-02 [1]
#> DBI 1.1.1 2021-01-15 [1]
#> deldir 0.2-10 2021-02-16 [1]
#> dichromat 2.0-0 2013-01-24 [1]
#> digest 0.6.27 2020-10-24 [1]
#> dplyr 1.0.5 2021-03-05 [1]
#> e1071 1.7-6 2021-03-18 [1]
#> ellipsis 0.3.1 2020-05-15 [1]
#> evaluate 0.14 2019-05-28 [1]
#> fansi 0.4.2 2021-01-15 [1]
#> fs 1.5.0 2020-07-31 [1]
#> generics 0.1.0 2020-10-31 [1]
#> ggplot2 3.3.3 2020-12-30 [1]
#> glue 1.4.2 2020-08-27 [1]
#> goftest 1.2-2 2019-12-02 [1]
#> gtable 0.3.0 2019-03-25 [1]
#> highr 0.8 2019-03-20 [1]
#> htmltools 0.5.1.1 2021-01-22 [1]
#> htmlwidgets 1.5.3 2020-12-10 [1]
#> httr 1.4.2 2020-07-20 [1]
#> igraph 1.2.6 2020-10-06 [1]
#> jsonlite 1.7.2 2020-12-09 [1]
#> KernSmooth 2.23-18 2020-10-29 [2]
#> knitr 1.31 2021-01-27 [1]
#> lattice 0.20-41 2020-04-02 [2]
#> leafem 0.1.3 2020-07-26 [1]
#> leaflet 2.0.4.1 2021-01-07 [1]
#> leafsync 0.1.0 2019-03-05 [1]
#> lifecycle 1.0.0 2021-02-15 [1]
#> lubridate 1.7.10 2021-02-26 [1]
#> lwgeom 0.2-5 2020-06-12 [1]
#> magrittr 2.0.1 2020-11-17 [1]
#> Matrix 1.3-2 2021-01-06 [2]
#> mgcv 1.8-33 2020-08-27 [2]
#> mime 0.10 2021-02-13 [1]
#> munsell 0.5.0 2018-06-12 [1]
#> nlme 3.1-152 2021-02-04 [2]
#> osmdata * 0.1.4.034 2021-03-08 [1]
#> pillar 1.5.1 2021-03-05 [1]
#> pkgconfig 2.0.3 2019-09-22 [1]
#> png 0.1-7 2013-12-03 [1]
#> polyclip 1.10-0.001 2021-03-16 [1]
#> proxy 0.4-25 2021-03-05 [1]
#> purrr 0.3.4 2020-04-17 [1]
#> R6 2.5.0 2020-10-28 [1]
#> raster 3.4-5 2020-11-14 [1]
#> RColorBrewer 1.1-2 2014-12-07 [1]
#> Rcpp 1.0.6 2021-01-15 [1]
#> reprex 1.0.0 2021-01-27 [1]
#> rlang 0.4.10 2020-12-30 [1]
#> rmarkdown 2.7 2021-02-19 [1]
#> rpart 4.1-15 2019-04-12 [2]
#> rvest 1.0.0 2021-03-09 [1]
#> scales 1.1.1 2020-05-11 [1]
#> sessioninfo 1.1.1 2018-11-05 [1]
#> sf * 0.9-8 2021-03-17 [1]
#> sfheaders 0.4.0 2020-12-01 [1]
#> sfnetworks * 0.5.1 2021-03-26 [1]
#> sp 1.4-5 2021-01-10 [1]
#> spatstat 2.0-1 2021-03-13 [1]
#> spatstat.core 2.0-0 2021-03-16 [1]
#> spatstat.data 2.1-0 2021-03-16 [1]
#> spatstat.geom 2.0-0 2021-03-18 [1]
#> spatstat.linnet 2.0-0 2021-03-18 [1]
#> spatstat.sparse 2.0-0 2021-03-16 [1]
#> spatstat.utils 2.1-0 2021-03-16 [1]
#> stars 0.5-1 2021-01-25 [1]
#> stringi 1.5.3 2020-09-09 [1]
#> stringr 1.4.0 2019-02-10 [1]
#> styler 1.3.2 2020-02-23 [1]
#> tensor 1.5 2012-05-05 [1]
#> tibble 3.1.0 2021-02-25 [1]
#> tidygraph * 1.2.0 2020-05-12 [1]
#> tidyr 1.1.3 2021-03-03 [1]
#> tidyselect 1.1.0 2020-05-11 [1]
#> tmap * 3.3-1 2021-03-09 [1]
#> tmaptools 3.1-1 2021-01-19 [1]
#> units 0.7-1 2021-03-16 [1]
#> utf8 1.2.1 2021-03-12 [1]
#> vctrs 0.3.6 2020-12-17 [1]
#> viridisLite 0.3.0 2018-02-01 [1]
#> withr 2.4.1 2021-01-26 [1]
#> xfun 0.22 2021-03-11 [1]
#> XML 3.99-0.5 2020-07-23 [1]
#> xml2 1.3.2 2020-04-23 [1]
#> yaml 2.2.1 2020-02-01 [1]
#> source
#> CRAN (R 4.0.3)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.3)
#> CRAN (R 4.0.3)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.3)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.3)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> Github (ropensci/osmdata@8b89f32)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.3)
#> Github (baddstats/polyclip@55623e8)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.3)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> Github (luukvdmeer/sfnetworks@5752fd4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> Github (spatstat/spatstat.core@22b0c87)
#> Github (spatstat/spatstat.data@1611456)
#> Github (spatstat/spatstat.geom@ecdc5ca)
#> Github (baddstats/spatstat.linnet@4d457b9)
#> CRAN (R 4.0.4)
#> Github (spatstat/spatstat.utils@840166e)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.3)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.3)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> Github (mtennekes/tmap@10aa8b0)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.3)
#> CRAN (R 4.0.4)
#> CRAN (R 4.0.3)
#>
#> [1] C:/Users/Utente/Documents/R/win-library/4.0
#> [2] C:/Program Files/R/R-4.0.4/library