In mountainMath/rtraveltime: R bindings to traveltimeapp API

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
library(dplyr)
library(sf)
library(rtraveltime)
library(lubridate)
library(ggplot2)

As starting locations we pick UBC and SFU

start_locations <- sf::read_sf('{
  "type": "FeatureCollection",
  "features": [
    {
      "type": "Feature",
      "properties": {"id":"UBC"},
      "geometry": {
        "type": "Point",
        "coordinates": [
          -123.25235366821289,
          49.264668080750134
        ]
      }
    },
    {
      "type": "Feature",
      "properties": {"id":"SFU"},
      "geometry": {
        "type": "Point",
        "coordinates": [
          -122.9138159751892,
          49.278514652253975
        ]
      }
    }
  ]
}')

isochrones <- get_departure_isochrone(start_locations %>% 
                                        mutate(travel_time=45*60,
                                               mode_type="public_transport",
                                               departure_time=ymd_hms("2019-11-05 08:00:00")))


get_vector_tiles <- function(bbox){
  rmapzen::mz_set_tile_host_nextzen(getOption("nextzen_API_key"))
  mx_box=rmapzen::mz_rect(bbox$xmin,bbox$ymin,bbox$xmax,bbox$ymax)
  rmapzen::mz_vector_tiles(mx_box)
}

bbox <- sf::st_bbox(isochrones)
vector_tiles <- get_vector_tiles(bbox)
roads <- rmapzen::as_sf(vector_tiles$roads) %>% filter(kind != "ferry")
water <- rmapzen::as_sf(vector_tiles$water)



ggplot(isochrones) +
  geom_sf(aes(fill=id),alpha=0.8,color=NA) +
  geom_sf(data = water, fill = "lightblue", colour = NA) +
  geom_sf(data=roads,size=0.1,color="black",fill=NA) +
  coord_sf(datum=NA,
         xlim=c(bbox$xmin,bbox$xmax),
         ylim=c(bbox$ymin,bbox$ymax)) +
  theme(legend.position = "bottom") +
  labs(title="Isochrone demo",fill="45 minutes\ncycling from",caption="traveltimeplatform.com isochrone API")

#ggsave("../images/cycling_example.png",height = 3.5)

Multiple travel times

start_data <- start_locations %>% 
  filter(id=="UBC") %>%
  mutate(travel_time=10*60) %>%
  bind_rows(
    mutate(.,travel_time=20*60),
    mutate(.,travel_time=30*60),
    mutate(.,travel_time=40*60),
    mutate(.,travel_time=50*60),
    mutate(.,travel_time=60*60)
  ) %>%
  sf::st_sf(crs=sf::st_crs(start_locations)) %>%
  mutate(mode_type="public_transport",departure_time=ymd_hms("2019-09-06 18:00:00"),id=paste0(id,"_",row_number()))

stacked_isochrones <- get_departure_isochrone(start_data)

bbox2 <- sf::st_bbox(stacked_isochrones)

for (i in rev(seq(2,nrow(stacked_isochrones)))){
  stacked_isochrones[i,"geometry"]=sf::st_difference(stacked_isochrones[i,"geometry"],stacked_isochrones[i-1,"geometry"])
}

cycling_labels <- setNames(paste0(start_data$travel_time/60," min"),start_data$id)

ggplot(stacked_isochrones) +
  scale_fill_viridis_d(direction=-1,labels=cycling_labels) +
  geom_sf(aes(fill=id),color=NA) +
  geom_sf(data = water, fill = "lightblue", colour = NA) +
  geom_sf(data=roads,size=0.1,color="black",fill=NA) +
  coord_sf(datum=NA,
         xlim=c(bbox2$xmin,bbox2$xmax),
         ylim=c(bbox2$ymin,bbox2$ymax)) +
  labs(title="Isochrone demo",fill="Cycling range",caption="traveltimeplatform.com isochrone API")

#ggsave("../images/cycling_ubc.png")

Multiple modes

start_data <- read_sf('{
  "type": "FeatureCollection",
  "features": [
    {
      "type": "Feature",
      "properties": {"id":"Canada Place"},
      "geometry": {
        "type": "Point",
        "coordinates": [
          -123.11339378356932,
          49.28751493905931
        ]
      }
    }
  ]
}') %>%
  mutate(mode_type="driving") %>%
  bind_rows(
    mutate(.,mode_type="public_transport"),
    mutate(.,mode_type="cycling"),
    mutate(.,mode_type="walking")
  ) %>%
  mutate(travel_time=45*60) %>%
  mutate(id=mode_type) %>%
  as_tibble() %>%
  sf::st_sf(crs=4326) %>%
  mutate(departure_time=ymd_hms("2019-09-06 18:00:00"),id=paste0(id,"_",row_number()))

mode_isochrones <- get_departure_isochrone(start_data) 

mode_isochrones <- mode_isochrones %>% filter(id!="driving_1")
bbox2 <- sf::st_bbox(mode_isochrones)



mode_labels <- c("driving_1"="Driving","public_transport_2"="Transit","cycling_3"="Cycling","walking_4"="Walking")

ggplot(mode_isochrones) +
  scale_fill_brewer(palette="Set1",direction=-1,labels=mode_labels) +
  geom_sf(aes(fill=id),color=NA,alpha=0.5) +
  geom_sf(data = water, fill = "lightblue", colour = NA) +
  geom_sf(data=roads,size=0.1,color="black",fill=NA) +
  coord_sf(datum=NA,
         xlim=c(bbox2$xmin,bbox2$xmax),
         ylim=c(bbox2$ymin,bbox2$ymax)) +
  labs(title="Isochrone demo, 45 miuntes from Canada Place",fill="Mode",caption="traveltimeplatform.com isochrone API")

#ggsave("../images/mode_comparison.png")

mountainMath/rtraveltime documentation built on Nov. 8, 2019, 9:31 a.m.