In ITSLeeds/pct: Propensity to Cycle Tool

knitr::opts_chunk$set(eval = FALSE)

devtools::install_github("robinlovelace/ukboundaries")
# install.packages(c("snakecase"))
library(tidyverse)
library(stplanr)
library(sf)
# Download file from:
# https://wicid.ukdataservice.ac.uk/cider/wicid/downloads.php
download.file("https://s3-eu-west-1.amazonaws.com/statistics.digitalresources.jisc.ac.uk/dkan/files/FLOW/wu03ew_v2/wu03ew_v2.zip", "~/Downloads/wu03ew_v2.zip")
unzip("~/Downloads/wu03ew_v2.zip")
od_all = read_csv("wu03ew_v2.csv")
names(od_all) = snakecase::to_snake_case(names(od_all))
names(od_all)[3] = "all"
names(od_all)[4] = "home"
names(od_all)[5] = "metro"
names(od_all)[7] = "bus"
names(od_all)[9] = "motorcycle"
names(od_all)[10] = "drive"
names(od_all)[11] = "passenger"
names(od_all)[14] = "other"
summodes = colSums(od_all[4:14])
barplot(summodes)

zones_leeds = ukboundaries::msoa2011_vsimple[
  ukboundaries::msoa2011_vsimple$msoa11cd %in%
    ukboundaries::msoa2011_lds$geo_code,] 
summary(zones_leeds$msoa11cd %in% od_all$area_of_residence)
od_leeds = od_all %>% 
  filter(area_of_residence %in% zones_leeds$msoa11cd & area_of_workplace %in% zones_leeds$msoa11cd) %>% 
  filter(area_of_residence != area_of_workplace) %>% 
  top_n(10, all)
# usethis::use_data(od_leeds, overwrite = TRUE)

desire_lines_leeds = od2line(flow = od_leeds, zones_leeds)
plot(desire_lines_leeds)
routes_fast_leeds = line2route(l = desire_lines_leeds)
# todo: replace with route() and call new cyclestreets package
mapview::mapview(routes_fast_leeds)
# pryr::object_size(routes_fast_leeds)
# usethis::use_data(routes_fast_leeds)

# model to predict cycling levels
# note: function to combine these 2 geometries sensible
routes_leeds = cbind(
  st_drop_geometry(desire_lines_leeds),
  st_drop_geometry(routes_fast_leeds)
  )
routes_leeds = sf::st_sf(routes_leeds, geometry = routes_fast_leeds$geometry)
routes_leeds$geometry_straight = desire_lines_leeds$geometry

plot(routes_leeds)
mod1 = lm(formula = bicycle ~ all + length, data = routes_leeds)
routes_leeds$scenario_1 = predict(object = mod1, routes_leeds) * 2

plot(routes_leeds$bicycle, routes_leeds$scenario_1)

rnet_leeds = overline2(routes_leeds, c("bicycle", "scenario_1"))

plot(rnet_leeds)
usethis::use_data(rnet_leeds)
usethis::use_data(desire_lines_leeds)
usethis::use_data(zones_leeds, overwrite = TRUE)

Uber

# download Travel_Time and LEEDS_MSOA.JSON from
# https://movement.uber.com/explore/leeds/travel-times/query?lang=en-GB&lat.=53.7892619&lng.=-1.6582168&z.=10.47&si=260&ti=145&ag=msoa&dt[tpb]=ALL_DAY&dt[wd;]=1,2,3,4,5,6,7&dt[dr][sd]=2018-01-01&dt[dr][ed]=2018-01-31&cd=&sa;=-1.5490774,53.8007554&sdn=Leeds,%20UK&ta;=&tdn=

mtt = read_csv("~/Downloads/Travel_Times.csv")
leeds_msoa = sf::st_read("~/Downloads/leeds_msoa.json")
# names(mtt)
# nrow(mtt)
# mapview::mapview(leeds_msoa)
# summary(mtt$`Mean Travel Time (Seconds)`)
# head(mtt$`Destination Display Name`)
# summary(mtt$`Destination Display Name` %in% leeds_msoa$DISPLAY_NAME)
geometry = leeds_msoa$geometry[leeds_msoa$DISPLAY_NAME %in% mtt$`Destination Display Name`] # subset based on mtt not msoa
mtt = sf::st_sf(mtt, geometry)
# journeys under 15 mins, Uber provides all despite map selection.
mtt = mtt[mtt$`Mean Travel Time (Seconds)` <= 15 * 60,]
leeds_uber_sample = top_n(mtt[order(mtt$`Mean Travel Time (Seconds)`), ], 10)
object.size(leeds_uber_sample) # ~18,664 bytes
# mapview::mapview(leeds_uber_sample)
# usethis::use_data(leeds_uber_sample)

Mode names data

download.file("https://s3-eu-west-1.amazonaws.com/statistics.digitalresources.jisc.ac.uk/dkan/files/FLOW/wu03ew_v2/wu03ew_v2.zip", "~/Downloads/wu03ew_v2.zip")
unzip("~/Downloads/wu03ew_v2.zip")
od_all = read_csv("wu03ew_v2.csv")
census_names = names(od_all)
mode_names = readr::read_csv("https://github.com/npct/pct-shiny/raw/master/regions_www/www/static/02_codebooks/commute/od_l_rf_codebook.csv")
names(mode_names) = c("variable", "description")
mode_names$census_name = NA
census_names
row_from_home = c("from_home", "Works mainly from home", NA)
mode_names = rbind(
  mode_names[1:10, ],
  row_from_home,
  mode_names[11:nrow(mode_names), ]
)
cbind(
  mode_names$variable[c(2:3, 10:21)],
  census_names[c(1:4, 12, 13, 10:11, 6, 5, 7:9, 14)]
)
mode_names$census_name[c(2:3, 10:21)] = census_names[c(1:4, 12, 13, 10:11, 6, 5, 7:9, 14)]
# usethis::use_data(mode_names)

PCT Regions

pct_regions = sf::read_sf("https://github.com/npct/pct-shiny/raw/master/regions_www/pct_regions_highres.geojson")
pryr::object_size(pct_regions)
#> 458 kB
pct_regions = rmapshaper::ms_simplify(pct_regions, keep = 0.1,)
pryr::object_size(pct_regions)
#> 81.8 kB
pct_regions = pct_regions[2]
# usethis::use_data(pct_regions)

Get LA names + lookup

lads = sf::st_centroid(ukboundaries::lad2016_simple)
pct_lads = sf::st_join(lads, pct_regions)
pct_regions_lookup = pct_lads[c("lad16cd", "lad16nm", "region_name")]
pct_regions_lookup = sf::st_drop_geometry(pct_regions_lookup)
for(i in names(pct_regions_lookup))
  pct_regions_lookup[[i]] = as.character(pct_regions_lookup[[i]])
names(pct_regions_lookup)
od = get_od()
pct_lad_names = unique(od$la_1)
summary({sel = pct_regions_lookup$lad16nm %in% od$la_1})
pct_lads$lad16nm[!sel]
summary({sel = pct_lad_names %in% pct_regions_lookup$lad16nm })
new_names = pct_lad_names[!sel]
pct_regions_lookup$lad16nm[grepl("Hull", pct_regions_lookup$lad16nm)] =
  new_names[grepl("Hull", new_names)]
pct_regions_lookup$lad16nm[grepl("Hereford", pct_regions_lookup$lad16nm)] =
  new_names[grepl("Hereford", new_names)]
pct_regions_lookup$lad16nm[grepl("Bristol", pct_regions_lookup$lad16nm)] =
  new_names[grepl("Bristol", new_names)]
head(pct_regions_lookup)
usethis::use_data(pct_regions_lookup)