Skip to content

Robinlovelace/erum18-transport

Repository files navigation

---
title: "Geocomputation for active transport planning"
subtitle: "🚲<br/>a case study of cycle network design<br/>Slides: [github.com/Robinlovelace/erum18-transport](https://github.com/Robinlovelace/erum18-transport) "
author: "Robin Lovelace"
date: "`r Sys.Date()`"
bibliography: references.bib
output:
  xaringan::moon_reader:
    lib_dir: libs2
    nature:
      highlightStyle: github
      highlightLines: true
      countIncrementalSlides: false
---

```{r setup, include=FALSE}
options(htmltools.dir.version = FALSE)
library(RefManageR)
BibOptions(check.entries = FALSE, 
           bib.style = "authoryear", 
           cite.style = 'alphabetic', 
           style = "markdown",
           first.inits = FALSE,
           hyperlink = FALSE, 
           dashed = FALSE)
my_bib = ReadBib("references.bib", check = FALSE)
# [@lovelace_propensity_2017] [@lovelace_geocomputation_2018a]
```

# Outline

.pull-left[

##  The problem

## Solutions

## How R can help

]

--

.pull-right[

![](https://media.giphy.com/media/oedEsOtNFyODC/giphy.gif)

]

---

# whoami

.pull-left[
- Environmental geographer

- Learned R for PhD on energy and transport

- Now work at the University of Leeds (ITS and LIDA)

- Working on Geocomputation with R

```{r, eval=FALSE}
devtools::install_github("r-rust/gifski")
system("youtube-dl https://youtu.be/CzxeJlgePV4 -o v.mp4")
system("ffmpeg -i v.mp4 -t 00:00:03 -c copy out.mp4")
system("ffmpeg -i out.mp4 frame%04d.png ")
f = list.files(pattern = "frame")
gifski::gifski(f, gif_file = "g.gif", width = 200, height = 200)
```

]

--

.pull-right[
Image credit: Jeroen Ooms + others

```{r, out.width="100%"}
knitr::include_graphics("https://user-images.githubusercontent.com/1825120/39661313-534efd66-5047-11e8-8d99-a5597fe160ff.gif")
```

]

---

class: inverse, center, middle

# The problem

---
background-image: url(https://pbs.twimg.com/media/DOH94nXUIAAgcll.jpg)
background-position: 50% 50%
class: center, bottom, inverse

# Cities look a bit like this

---

# Transport: growing source of emissions

.pull-left[

```{r}
knitr::include_graphics("https://raw.githubusercontent.com/Robinlovelace/erum18-transport/master/transport-projections-ipcc.png")
```

]

--

.pull-right[

- People like to travel!

- Does not 'saturate' with income

- Hard to decarbonise via technology

![](https://media2.giphy.com/media/3o7TKOB6oTdYPFXJmw/giphy.gif)
![](https://media1.giphy.com/media/YlQQYUIEAZ76o/200w.gif)

]

---
class: inverse, center, middle

# Solutions

---

# Make cycling the natural choice

```{r, echo=FALSE, out.width="70%"}
knitr::include_graphics("https://pbs.twimg.com/media/DJaWCo0U8AAzQGW.jpg:large")
```

Source: [Brent Toderian](https://twitter.com/BrentToderian)

--

## For everyone: a political problem

---

# Another problem...

```{r, echo=FALSE, out.width="80%"}
knitr::include_graphics("https://larrycuban.files.wordpress.com/2015/02/data-overload-2.jpg")
```

--

## Data overload

<!-- Source: [Larry Cuban](https://larrycuban.files.wordpress.com/2015/02/data-overload-2.jpg) -->

---
class: inverse, center, middle

# Technical solutions

---

# Simplify the data deluge

Cycling network in Seville: 'basic' (77 km) and ‘complementary’ (120 km, dashed line) cycleways (from Marqués et al. 2015). Led to fourfold increase in cycling. 

```{r, echo=FALSE}
knitr::include_graphics("https://raw.githubusercontent.com/ATFutures/who/master/fig/sevnet2.png")
```

---

## Estimate cycling pontential: the Propensity to Cycle Tool - see [w](http://npct0.vs.mythic-beasts.com/shiny_interface/?r=west-yorkshire)[ww.pct.bike](www.pct.bike)

Included in UK policy (CWIS) used by many local authorities (LCWIP)
`r Citep(my_bib, "lovelace_propensity_2017", .opts = list(cite.style = "authoryear"))`


```{r, echo=FALSE, out.width="70%"}
knitr::include_graphics("https://raw.githubusercontent.com/npct/pct-team/master/figures/front-page-leeds-pct-demo.png")
```

---

# Build infrastructure

- Link between infrastructure and uptake between 2001 and 2011 in English regions
- But how to ensure that infrastructure is effective?

```{r, echo=FALSE, out.width="80%"}
knitr::include_graphics("https://raw.githubusercontent.com/cyipt/cyipt-website/master/images/ttwa-uptake.png")
```

---

# Identify cost-effective schemes: the CyIPT

- A ~~publicly available~~ password protected web app providing accessible evidence on cycling infrastructure hosted at [www.cyipt.bike](https://www.cyipt.bike/)

```{r, echo=FALSE}
knitr::include_graphics("https://www.cyipt.bike/images/home-example.png")
```

---
class: inverse, center, middle

# How R can help

An open source language for statistical computing
`r Citep(my_bib, "rcoreteam_language_2018", .opts = list(cite.style = "authoryear"))`

---

# Scalability

```{r, tidy=FALSE, message=FALSE, echo=FALSE}
d = readr::read_csv("https://github.com/npct/pct-team/raw/master/data-sources/cycle-tools.csv")
DT::datatable(
  d,
  fillContainer = FALSE, options = list(pageLength = 8)
)
```

---

# Visualisation

- Live demo...

```{r, eval=FALSE}
# try it!
shiny::runGitHub("robinlovelace/erum18-transport")
```

- More on shiny-leaflet integration: [Section 9.5](http://geocompr.robinlovelace.net/adv-map.html#mapping-applications) in
`r Citep(my_bib, "lovelace_geocomputation_2018a", .opts = list(cite.style = "authoryear"))`

- **stplanr**
`r Citep(my_bib, "R-sf", .opts = list(cite.style = "authoryear"))`
making use of **sf**
`r Citep(my_bib, "R-stplanr", .opts = list(cite.style = "authoryear"))`

---

# Some example shiny code

```{r, eval=FALSE}
# non-reproducible snippet
getroads = reactive({                 
  roads[roads$highway == input$type, ]
})
renderLeaflet({
  m = tm_shape(getroads()) +
    tm_lines(col = "red", lwd = 5) +
  tmap_leaflet(m) # you can use tmap in shiny!
})
```

---

# Local routing

.pull-left[

```{r, eval=FALSE}
fr = stplanr::geo_code(
  "Budapest airport")
to = stplanr::geo_code(
  "akvarium budapest")
# install.packages("cyclestreets")
library(cyclestreets)
r = journey(fr, to)
```

```{r, echo=FALSE}
r = sf::read_sf("r.geojson")
```

```{r}
# From Martin's workshop:
library(tmap)
bm = leaflet::providers
bm_cycle = bm$Thunderforest.OpenCycleMap
m = tm_shape(r) +
  tm_lines(col = "busynance",
           lwd = 5) +
  tm_scale_bar()
```


]

.pull-right[

See: [rpubs.com/RobinLovelace/389709](http://rpubs.com/RobinLovelace/389709)

```{r, out.width="350", out.height="400", message=FALSE}
tmap_leaflet(m)
```

]

---

# Extracting data from routes

```{r}
r$distances[1:5]
r$time[1:5]
sum(r$distances) / 1000
```

For something on remote routing see **stplanr** or **dodgr** packages.

- Vignette on fast local routing: [cran.r-project.org/package=dodgr](https://cran.r-project.org/web/packages/dodgr/vignettes/dodgr.html)

---
class: center, middle

# Thanks and safe 🚶, 🚲 +  🚀!

- Reproducible slides + app: [github.com/Robinlovelace/erum18-transport](https://github.com/Robinlovelace/erum18-transport)

- Transport chapter in Geocomputation with R (feedback welcome):
[geocompr.robinlovelace.net](http://geocompr.robinlovelace.net/transport.html)

Slides created via the R package [**xaringan**](https://github.com/yihui/xaringan).

---
class: small

# References
```{r, 'refs', results="asis", echo=FALSE}
PrintBibliography(my_bib)
```


```{r, echo=FALSE, out.height="100", fig.show='hold'}
knitr::include_graphics(
  c(
    "https://www.cyipt.bike/images/logo.png",
    "https://raw.githubusercontent.com/cyipt/cyipt/master/figures/its-logo-square.png"
    ))
```

About

Repo to host a small web app and slides for my talk at eRum 2018, Budapest

Resources

License

Stars

Watchers

Forks

Releases

No releases published

Packages

No packages published