Parallel routing and performance with stplanr

devtools::install_github("ropensci/stplanr", "par")
#> Skipping install of 'stplanr' from a github remote, the SHA1 (fc2b49e2) has not changed since last install.
#>   Use `force = TRUE` to force installation
library(stplanr)
library(sf)
#> Linking to GEOS 3.8.0, GDAL 3.0.2, PROJ 6.2.1
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(tmap)

With old route_cyclestreets function

# ?route
l = flowlines_sf %>% 
  dplyr::filter()
t1 = Sys.time()
routes_route_cyclestreet = line2route(l)
#> Warning in value[[3L]](cond): Fail for line number 1
#> 10 % out of 49 distances calculated
#> Warning in value[[3L]](cond): Fail for line number 9
#> 20 % out of 49 distances calculated
#> 31 % out of 49 distances calculated
#> Warning in value[[3L]](cond): Fail for line number 17
#> 41 % out of 49 distances calculated
#> Warning in value[[3L]](cond): Fail for line number 25
#> 51 % out of 49 distances calculated
#> 61 % out of 49 distances calculated
#> Warning in value[[3L]](cond): Fail for line number 33
#> 71 % out of 49 distances calculated
#> 82 % out of 49 distances calculated
#> Warning in value[[3L]](cond): Fail for line number 41
#> 92 % out of 49 distances calculated
#> Warning in value[[3L]](cond): Fail for line number 49
Sys.time() - t1
#> Time difference of 6.912262 secs
ncol(routes_route_cyclestreet)
#> [1] 18
nrow(routes_route_cyclestreet)
#> [1] 49
names(routes_route_cyclestreet)
#>  [1] "plan"        "start"       "finish"      "length"      "time"       
#>  [6] "waypoint"    "cum_hill"    "change_elev" "dif_max_min" "up_tot"     
#> [11] "down_tot"    "av_incline"  "co2_saving"  "calories"    "busyness"   
#> [16] "error"       "id"          "geometry"
routes_route_cyclestreet_joined = dplyr::inner_join(routes_route_cyclestreet, sf::st_drop_geometry(l))
#> Joining, by = "id"
Sys.time() - t1
#> Time difference of 6.920068 secs
rnet_go_dutch = overline(routes_route_cyclestreet_joined, "All")
#> 2020-01-25 12:42:19 constructing segments
#> 2020-01-25 12:42:19 building geometry
#> 2020-01-25 12:42:19 simplifying geometry
#> 2020-01-25 12:42:19 aggregating flows
#> 2020-01-25 12:42:19 rejoining segments into linestrings
Sys.time() - t1
#> Time difference of 7.029445 secs
tm_shape(rnet_go_dutch) +
  tm_lines(lwd = 5, col = "All", breaks = c(0, 10, 100, 500, 1000), palette = "viridis")

With new route function

# ?route
t1 = Sys.time()
routes_journey = route(l = l, route_fun = cyclestreets::journey)
#> Most common output is sf
#> These routes failed: 1, 9, 17, 25, 33, 41, 49
#> The first of which was:
#> <simpleError in FUN(ldf[i, 1:2], ldf[i, 3:4]): Error: Too short: journeys must be longer than 4 metres. (Your requested journey was 0 metres).>
ncol(routes_journey)
#> [1] 26
nrow(routes_journey)
#> [1] 472

Sys.time() - t1
#> Time difference of 6.951836 secs
names(routes_journey)
#>  [1] "name"                                
#>  [2] "distances"                           
#>  [3] "time"                                
#>  [4] "busynance"                           
#>  [5] "elevations"                          
#>  [6] "start_longitude"                     
#>  [7] "start_latitude"                      
#>  [8] "finish_longitude"                    
#>  [9] "finish_latitude"                     
#> [10] "route_number"                        
#> [11] "Area.of.residence"                   
#> [12] "Area.of.workplace"                   
#> [13] "All"                                 
#> [14] "Work.mainly.at.or.from.home"         
#> [15] "Underground..metro..light.rail..tram"
#> [16] "Train"                               
#> [17] "Bus..minibus.or.coach"               
#> [18] "Taxi"                                
#> [19] "Motorcycle..scooter.or.moped"        
#> [20] "Driving.a.car.or.van"                
#> [21] "Passenger.in.a.car.or.van"           
#> [22] "Bicycle"                             
#> [23] "On.foot"                             
#> [24] "Other.method.of.travel.to.work"      
#> [25] "id"                                  
#> [26] "geometry"
rnet_go_dutch_journey = overline(routes_journey, "All")
#> 2020-01-25 12:42:27 constructing segments
#> 2020-01-25 12:42:27 building geometry
#> 2020-01-25 12:42:27 simplifying geometry
#> 2020-01-25 12:42:27 aggregating flows
#> 2020-01-25 12:42:27 rejoining segments into linestrings
Sys.time() - t1
#> Time difference of 7.06483 secs
rnet_go_dutch_agg = overline(routes_journey, "All")
#> 2020-01-25 12:42:27 constructing segments
#> 2020-01-25 12:42:27 building geometry
#> 2020-01-25 12:42:27 simplifying geometry
#> 2020-01-25 12:42:27 aggregating flows
#> 2020-01-25 12:42:27 rejoining segments into linestrings
Sys.time() - t1
#> Time difference of 7.171166 secs
tm_shape(rnet_go_dutch_agg) +
  tm_lines(lwd = 5, col = "All", breaks = c(0, 10, 100, 500, 1000), palette = "viridis")

With new route function in parallel

# ?route
t1 = Sys.time()


# load parallel stuff
library(parallel)
library(cyclestreets)
cl <- makeCluster(detectCores())
clusterExport(cl, c("journey"))
Sys.time() - t1
#> Time difference of 0.9242601 secs
routes_journey_par = route(l = l, route_fun = cyclestreets::journey, cl = cl) # multi-core
#> Most common output is sf
#> These routes failed: 1, 9, 17, 25, 33, 41, 49
#> The first of which was:
#> <simpleError in FUN(ldf[i, 1:2], ldf[i, 3:4]): Error: Too short: journeys must be longer than 4 metres. (Your requested journey was 0 metres).>
stopCluster(cl) # kill cluster

Sys.time() - t1
#> Time difference of 4.143059 secs
Sys.time() - t1
#> Time difference of 4.144155 secs
names(routes_journey_par)
#>  [1] "name"                                
#>  [2] "distances"                           
#>  [3] "time"                                
#>  [4] "busynance"                           
#>  [5] "elevations"                          
#>  [6] "start_longitude"                     
#>  [7] "start_latitude"                      
#>  [8] "finish_longitude"                    
#>  [9] "finish_latitude"                     
#> [10] "route_number"                        
#> [11] "Area.of.residence"                   
#> [12] "Area.of.workplace"                   
#> [13] "All"                                 
#> [14] "Work.mainly.at.or.from.home"         
#> [15] "Underground..metro..light.rail..tram"
#> [16] "Train"                               
#> [17] "Bus..minibus.or.coach"               
#> [18] "Taxi"                                
#> [19] "Motorcycle..scooter.or.moped"        
#> [20] "Driving.a.car.or.van"                
#> [21] "Passenger.in.a.car.or.van"           
#> [22] "Bicycle"                             
#> [23] "On.foot"                             
#> [24] "Other.method.of.travel.to.work"      
#> [25] "id"                                  
#> [26] "geometry"
rnet_go_dutch_journey = overline(routes_journey_par, "All")
#> 2020-01-25 12:42:31 constructing segments
#> 2020-01-25 12:42:31 building geometry
#> 2020-01-25 12:42:31 simplifying geometry
#> 2020-01-25 12:42:31 aggregating flows
#> 2020-01-25 12:42:31 rejoining segments into linestrings
Sys.time() - t1
#> Time difference of 4.281573 secs
rnet_go_dutch_agg = overline(routes_journey_par, "All")
#> 2020-01-25 12:42:31 constructing segments
#> 2020-01-25 12:42:31 building geometry
#> 2020-01-25 12:42:31 simplifying geometry
#> 2020-01-25 12:42:31 aggregating flows
#> 2020-01-25 12:42:31 rejoining segments into linestrings
Sys.time() - t1
#> Time difference of 4.394014 secs
tm_shape(rnet_go_dutch_agg) +
  tm_lines(lwd = 5, col = "All", breaks = c(0, 10, 100, 500, 1000), palette = "viridis")

Tests