Landing page

[Robinlovelace]

Simple example below.

---
title: "CRUSE"
output:
  html_document:
    theme:
      bg: "#FFFFFF"
      fg: "#000000"
      highlight: "#000000"
      primary: "#000000"
      base_font:
        google: "Prompt"
      code_font:
        google: "JetBrains Mono"
---
  
  
```{r setup, include=FALSE}
# Aim: Load libs and counties dataframe
library(sf)
library(stringr)
library(dplyr)
library(leaflet)
library(mapboxapi)
library(DT)
library(htmlwidgets)
knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE)
has_pub_key = nchar(Sys.getenv("MAPBOX_PUBLIC_TOKEN")) > 5
knitr::opts_chunk$set(eval = has_pub_key)

The Cycle Route Uptake & Scenario Estimation tool for Transport Infrastructure Ireland (TII)

Note: the project is in public Beta phase and information on this site should be treated as work in progress. Complete the feedback survey to help improve the tool.

```{css, echo=FALSE}

.loader-bg {
position: fixed;
z-index: 999999;
background: #fff;
width: 100%;
height: 100%
}

.loader {
border: 0 solid transparent;
border-radius: 50%;
width: 150px;
height: 150px;
position: absolute;
top: calc(50vh - 75px);
left: calc(50vw - 75px)
}

.loader:after,
.loader:before {
content: '';
border: 1em solid #ff5733;
border-radius: 50%;
width: inherit;
height: inherit;
position: absolute;
top: 0;
left: 0;
animation: loader 2s linear infinite;
opacity: 0
}

.loader:before {
animation-delay: .5s
}

@Keyframes loader {
0% {
transform: scale(0);
opacity: 0
}

50% {
opacity: 1
}

100% {
transform: scale(1);
opacity: 0
}
}
.title{
text-align:center !important
}
.html-widget {
margin: auto;
width: 100% !important;
}
img {
width: 85%;
padding: 2em;
}
.main-container{
max-width: 70%;
}

.iframe{
display: block;
margin: auto;
}
#the-cycle-route-uptake-scenario-estimation-tool-for-transport-infrastructure-ireland > h2:nth-child(1){
text-align:center !important;
margin-top: -0.5em !important;
}
.leaflet-popup-content {
font-size: large;
color: black;
}
.leaflet-popup-content > a:nth-child(1){
color: white;
font-size: large;
}
.leaflet-marker-label {
width: auto !important;
height: auto !important;
position: fixed;
top: 0;
right: 0;
}
.nav-link, .nav-tabs > li > a, .nav-pills > li > a, ul.nav.navbar-nav > li > a {
display: block;
padding: .5rem 1rem;
color: #919592;
text-decoration: none;
-webkit-text-decoration: none;
-moz-text-decoration: none;
-ms-text-decoration: none;
-o-text-decoration: none;
transition: color 0.15s ease-in-out,background-color 0.15s ease-in-out,border-color 0.15s ease-in-out;
}
.leaflet-popup-content-wrapper, .leaflet-popup-tip{
background-color: #919592 !important;
}
.nav:not(.nav-hidden):not(.nav-stacked):not(.flex-column) {
float: none !important;
font-size: larger;
z-index: 1;
justify-content: center;
}
h1.title, .title.h1 {
font-size: 3.875rem;
font-weight: bolder;
}

#cycle-route-uptake-scenario-estimation {
text-align: center !important;
font-style: italic;
margin-top: -1em;
}
@media screen and (max-width: 1000px) {
h1.title, .title.h1 {
margin-top: 1.25rem;
font-size: 3.875rem;
font-weight: bolder;
}
img{
height: 3em;
max-width: 6em;
padding: 1em;
}
}
}

```{r pkg, include=FALSE}
# TODO this will contain more variables we need, primarily % cycling
# Load counties geometry
counties_raw = readRDS("counties.Rds")
counties_raw = counties_raw %>%
  mutate(county_name = stringr::str_to_title(COUNTY))
# Load pcycle_data at the county level
county_trips = read.csv("county-trips.csv")
# counties_index = county_trips %>%
#   select(county_name, pcycle_baseline)
counties_index = counties_raw %>%
  dplyr::left_join(county_trips)
counties_index = counties_index %>%
  dplyr::rename(Name = COUNTY) %>%
  dplyr::mutate(Name =  stringr::str_to_sentence(Name)) %>%
  dplyr::mutate(url = paste0(
    "<a href='",
    tolower(Name) ,
    "/' target='_blank'>",
    Name,
    "</a>"
  ))
counties_index = sf::st_as_sf(counties_index)

{.tabset}

Map

tippy::tippy_this(elementId = "word", tooltip = "At low zoom, the map shows the % cycle uptake per county; at high zoom, it displays a cycle friendliness measure, with a score between 0 (very unfriendly) and 100 (very friendly). Both measures are shown for each given scenario. See the FAQs for more details")

palette = c(
  '#d73027',
  '#f46d43',
  '#fdae61',
  '#fee090',
  '#ffffbf',
  '#e0f3f8',
  '#abd9e9',
  '#74add1',
  '#4575b4'
)
breaks = c(0, 1, 2, 3, 5, 10, 20, 30, 40, Inf)
pal_baseline = leaflet::colorBin(palette, bins = breaks,
                                 domain = counties_index$pcycle_baseline)
pal_near = leaflet::colorBin(palette, bins = breaks,
                             domain = counties_index$pcycle_near)
pal_climate = leaflet::colorBin(palette, bins = breaks,
                                domain = counties_index$pcycle_climate)
pal_dutch = leaflet::colorBin(palette, bins = breaks,
                              domain = counties_index$pcycle_godutch)
pal_ebike = leaflet::colorBin(palette, bins = breaks,
                              domain = counties_index$pcycle_ebike)
schools_raw = readRDS("schools_all.Rds")
# main map
leaflet::leaflet(counties_index) %>%
  leaflet::addProviderTiles(
    providers$CartoDB.Positron,
    group = "Grey basemap",
    options = leaflet::providerTileOptions(minZoom = 5, maxZoom = 22)
  ) %>%
  leaflet::addPolygons(
    data = counties_index %>% sf::st_transform(crs = 4326),
    color = "black",
    fillColor = "transparent",
    group = "Borders",
    popup = paste0("View county results: ", counties_index$url),
    opacity = 0.7,
    weight = 1.2,
    label = ~ Name,
    labelOptions = leaflet::labelOptions(noHide = F, permanent = TRUE, direction = "auto",sticky = FALSE, textsize = "1.5em")) %>%
  leaflet::addCircles(
    data = schools_raw,
    group = "Schools",
    color = "black",
    opacity = 0.8,
    fillOpacity = 0.3
  ) %>%
  #polygons
  mapboxapi::addMapboxTiles(
    style_id = "cl77hy22i000m14pa2r440vgi",
    username = "nathanaelisamapper",
    group = "Baseline scenario",
    options = leaflet::providerTileOptions(minZoom = 1, maxZoom = 9),
    access_token = Sys.getenv("MAPBOX_PUBLIC_TOKEN")
  ) %>%
  mapboxapi::addMapboxTiles(
    style_id = "cl77h0i4v001u15o1cp39sk37",
    username = "nathanaelisamapper",
    group = "Near Market",
    options = leaflet::providerTileOptions(minZoom = 1, maxZoom = 9),
    access_token = Sys.getenv("MAPBOX_PUBLIC_TOKEN")
  ) %>%
  mapboxapi::addMapboxTiles(
    style_id = "cl77hqtom000214qrk6ceqeur",
    username = "nathanaelisamapper",
    group = "Climate Action Plan",
    options = leaflet::providerTileOptions(minZoom = 1, maxZoom = 9),
    access_token = Sys.getenv("MAPBOX_PUBLIC_TOKEN")
  ) %>%
  mapboxapi::addMapboxTiles(
    style_id = "cl77hvhpx000d14nz0uhmsp40",
    username = "nathanaelisamapper",
    group = "Ebike",
    options = leaflet::providerTileOptions(minZoom = 1, maxZoom = 9),
    access_token = Sys.getenv("MAPBOX_PUBLIC_TOKEN")
  ) %>%
  mapboxapi::addMapboxTiles(
    style_id = "cl77i0bqh003i16n2cijgn6r1",
    username = "nathanaelisamapper",
    group = "Go Dutch",
    options = leaflet::providerTileOptions(minZoom = 1, maxZoom = 9),
    access_token = Sys.getenv("MAPBOX_PUBLIC_TOKEN")
  ) %>%
  #rnet
  mapboxapi::addMapboxTiles(
    style_id = "cl66fjj97000a15ru2hhss06g",
    username = "nathanaelisamapper",
    group = "Baseline scenario",
    options = leaflet::providerTileOptions(minZoom = 9, maxZoom = 22),
    access_token = Sys.getenv("MAPBOX_PUBLIC_TOKEN")
  ) %>%
  mapboxapi::addMapboxTiles(
    style_id = "cl66f8ax6001i14ti630sk73z",
    username = "nathanaelisamapper",
    group = "Climate Action Plan",
    options = leaflet::providerTileOptions(minZoom = 9, maxZoom = 22),
    access_token = Sys.getenv("MAPBOX_PUBLIC_TOKEN")
  ) %>%   mapboxapi::addMapboxTiles(
    style_id = "cl66foarr001d14lmc88wyu42",
    username = "nathanaelisamapper",
    group = "Near Market",
    options = leaflet::providerTileOptions(minZoom = 9, maxZoom = 22),
    access_token = Sys.getenv("MAPBOX_PUBLIC_TOKEN")
  )  %>% mapboxapi::addMapboxTiles(
    style_id = "cl66flaic000114t385c8spxn",
    username = "nathanaelisamapper",
    group = "Ebike",
    options = leaflet::providerTileOptions(minZoom = 9, maxZoom = 22),
    access_token = Sys.getenv("MAPBOX_PUBLIC_TOKEN")
  ) %>% mapboxapi::addMapboxTiles(
    style_id = "cl66fmn9j001g14lkbone3hye",
    username = "nathanaelisamapper",
    group = "Go Dutch",
    options = leaflet::providerTileOptions(minZoom = 9, maxZoom = 22),
    access_token = Sys.getenv("MAPBOX_PUBLIC_TOKEN")
  ) %>%
  leaflet::setView(lng = -8.2,
                   lat = 53.5,
                   zoom = 7) %>%
  leaflet::addLegend(
    "bottomleft",
    colors = c("#882255",  "#CC6677", "#44AA99", "#117733"),
    labels = c("0 to 25", "25 to 50", "50 to 75", "75 to 100"),
    title = "Cycle friendliness",
    group = "Friend",
    opacity = 0.7
  ) %>%
  leaflet::addLegend(
    "bottomleft",
    colors = c(
      '#d73027',
      '#f46d43',
      '#fdae61',
      '#fee090',
      '#ffffbf',
      '#e0f3f8',
      '#abd9e9',
      '#74add1',
      '#4575b4'
    ),
    labels = c(
      "0 to 1",
      "1 to 2",
      "2 to 3",
      "3 to 5",
      "5 to 10",
      "10 to 20",
      "20 to 30",
      "30 to 40",
      "40 to more"
    ),
    title = "Percent cycling",
    group = "Base",
    opacity = 0.7
  ) %>%
  leaflet::addLegend(
    title = "Get Started:",
    group = "Help",
    position = "bottomright",
    colors = c("white",
               "white"),
    labels = c(
      "Zoom in to explore the network",
      "Click on a county for detailed results"
    )
  ) %>%
  addLayersControl(
    baseGroups  = c(
      "Baseline scenario",
      "Near Market",
      "Climate Action Plan",
      "Go Dutch",
      "Ebike"
    ),
    overlayGroups = c("Schools"),
    options = leaflet::layersControlOptions(collapsed = FALSE)
  ) %>%
  leaflet::groupOptions(group = "Help", zoomLevels = 7:8)  %>%
    leaflet::groupOptions(group = "Base", zoomLevels = 1:9) %>%
  leaflet::groupOptions(group = "Friend", zoomLevels = 10:20) %>%
  leaflet::hideGroup("Schools")  %>%
  htmlwidgets::onRender("
        function() {
            $('.leaflet-control-layers-base').prepend('<label style=\"text-align:center;font-size:larger;\"><b>Scenarios</b></label>');
        }
    ")

What does this map show?

Table

Click on a county to further explore results

# Aim: Build table for homepage
dn = "popupCycleways/v1"
built_counties = list.files(dn)
set.seed(42)
counties_index %>%
  sf::st_drop_geometry() %>%
  dplyr::select(url, Population, "% cycling (Baseline)" = pcycle_baseline, "% cycling (Near Market)" = pcycle_near,  "% cycling (Climate Action Plan)" = pcycle_climate,  "% cycling (Go Dutch)" = pcycle_godutch,  "% cycling (Ebike)" = pcycle_ebike) %>%
  dplyr::rename(Name = url) %>%
  dplyr::arrange(Name) %>%
  dplyr::mutate_if(is.numeric, round, 1) %>%
  DT::datatable(escape = -2, filter = 'none', options = list(pageLength = 5,
                                                             responsive = TRUE,
                                                             extensions = c('Responsive')))

About

Aim and scope of the CRUSE tool

Transport Infrastructure Ireland commissioned the Institute for Transport Studies (University of Leeds) and AECOM to develop the Cycle Route Uptake and Scenario Estimation (CRUSE) tool to support strategic cycle network planning and investment prioritisation across the Republic of Ireland.
The CRUSE tool has been used to develop a number of scenarios for cycle network investment in the Republic of Ireland.
The CRUSE tool estimates the potential uptake of a cycle route based on factors such as distance, terrain, and attractiveness.
This information can be used to inform decisions about where best to invest in new or improved cycle routes.

The CRUSE Team

• Transport Infrastructure Ireland (direction): Dr Suzanne Meade and Dan Brennan.

• Institute for Transport Studies (University of Leeds) (development): Dr Robin Lovelace, Dr Joey Talbot, Dr Eugeni Vidal-Tortosa, and Nathanael Sheehan.

• AECOM (management): Peter Wright, Ciaran Maguire, and Shane Dunny.

Acknowledgements

We would like to thank transport and road safety practitioners from the county councils of Limerick, Kildare (Donal Hodgins and Paul McDonald), Kerry (Lucy Curtis and Joyce O'Boyle), and Carlow (Seamus Loughlin and Kieran Cullinane) for their useful feedback on the tool.
Thanks also to CycleStreets (Martin Lucas-Smith and Simon Nuttall) for providing data on routes.

Feedback

You can give feedback on the tool in the online survey.

Contact

Send an email to TII with "CRUSE" in the email title.

Video

<iframe src="https://www.youtube.com/embed/UKtOEBN47eg" height="420px" width="840px" title="YouTube video player" frameborder="0" data-external="1" class="iframe" allow="accelerometer; autoplay; clipboard-write; encrypted-media; gyroscope; picture-in-picture" allowfullscreen></iframe>

FAQ

Short answers to key frequently answered questions (FAQ) are provided below.
See the full FAQ page for more details and answers to questions about how the tool works.

What is the CRUSE tool?

The Cycle Route Uptake and Scenarios Estimation (CRUSE) tool is a strategic cycle network planning support tool.
It was funded by Transport Infrastructure Ireland (TII) and builds on the approach used in the Propensity to Cycle Tool (PCT).

What is the purpose of the CRUSE tool?

The CRUSE tool supports strategic cycle network planning to support TII's remit under the the EU Road Infrastructure Safety Management (RISM) Directive, and to provide cycle flow estimates for TII's Project Appraisal Guidelines Unit 13.0 on Appraisal of Active Modes PE-PAG-02036.

What can the tool be used for?

The tool's primary purpose is to support design of joined-up, evidence-based and effective strategic cycle networks.
The tool can be used to visualise current cycling levels, highlight gaps in existing networks, compare 'fast' and 'quiet' networks and to understand how these could change in future, under scenarios of cycling uptake.

How can I access the tool?

CRUSE is a free and publicly available tool that is available at the website cruse.bike for everyone to use.

Which trip purposes are included in the tool?

Commute trips, travel to primary school, travel to secondary school, travel to tertiary education, social trips, personal trips and shopping trips.
Recreational trips will soon be added to the tool.

What data does the tool use?

Travel to work and school is based on Central Statistics Office POWSCAR origin-destination data from the 2016 Census. We use Electoral Divisions as the geographical zones between which journeys are defined.

News

2022-08-08

• New landing page

2022-09-22

• Feedback survey added

2022-09-23

• CRUSE stall and presentation at TII National Roads and Greenways Conference 2022, Sligo
• Slides from the event are available online
• Audio available online

| | | | |
|---|---|---|---|---|---|

setTimeout(function(){
  $('.loader-bg').fadeToggle();
}, 1000);

[temospena]

thanks!
this structure works.
I'll change some css and fonts, don't worry.

as far as I understand, now this summary (eg. https://cruse.bike/cavan/) should be the one in /municipio_index.Rmd , right?
And then this one (https://cruse.bike/cavan/county-stats.html) is in /municipio_stats.Rmd,
and this (https://cruse.bike/cavan/route-types.html) can be the several interactive maps, with a link to a full page map each one, where can also live the url to gpkg or geojson downloads.

If you could send me an example of the county_stats.Rmd, to get the structure, would be awsome!

[Robinlovelace]

as far as I understand, now this summary (eg. https://cruse.bike/cavan/) should be the one in /municipio_index.Rmd , right?

Currect and yes, all right!

[Robinlovelace]

---
title: "County statistics"
output:
  html_document:
    theme:
      bg: "#FFFFFF"
      fg: "#000000"
      highlight: "#44AA99"
      primary: "#117733"
      base_font:
        google: "Prompt"
      code_font:
        google: "JetBrains Mono"
---

```{r include=FALSE, message=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
fmt_num = function(x) format(round(sum(x)), big.mark=",")
library(tidyverse)
library(tmap)
library(sf)
library(plotly)
library(gridExtra)

# key settings/parameters/objects
modes = c("car", "other", "public_transport", "cyclists", "foot")
modes_new = c("car_trips", "other_trips", "public_transport_trips", "cycle_trips", "foot_trips")
names(modes) = c("Car", "Other", "Public Transport", "Cycling", "Walking")

# The aim of this chunk is to make the document more reproducible
# in cases when the user has not just run a 'build' process by running the
# code in build.R, which can take several minutes to complete, slowing dev work!
if(!exists("county_lc")) {
  county_lc = "Limerick"
  sys_date = "2022-08-08"
  output_folder = file.path("outputs", sys_date)
  county_name_lowercase = tolower(county_lc)
  output_folder_rds = file.path(output_folder, "rds")
  output_folder_pub = file.path(output_folder, "pub")
  rds_folder = file.path(output_folder_rds, county_name_lowercase)
  pub_folder = file.path(output_folder_pub, county_name_lowercase)
  county_projected = readRDS(file.path(rds_folder, "county_projected.Rds"))
  zones_region = readRDS(file.path(rds_folder, "zones_region.Rds"))
  zones_region_exact = readRDS(file.path(rds_folder, "zones_region_exact.Rds"))
  scenario_types = c("baseline", "climate")
  scenarios_ordered = c("Baseline", "Near Market", "Climate Action Plan", "Go Dutch", "Ebike")
  schools_all = readRDS("schools_all.Rds")
  schools_region = schools_all[zones_region,]
}

routes_combined_balanced = readRDS(file.path(rds_folder, "routes_combined_balanced.Rds"))
routes_powscar_balanced = routes_combined_balanced %>% 
  filter(purpose %in% c("work", "primary", "secondary", "tertiary"))
  # This is a more complicted by slightly more concise alternative:
  # filter(str_detect(string = purpose, pattern = "work|prim|sec|tert"))

prop_trips_table = read.csv("county-trips.csv")
prop_trips_county = prop_trips_table %>% 
  filter(county_name == county_lc)
prop_all_assessed = round(prop_trips_county$prop_all_assessed, 2) * 100

This analysis focuses on trips to work and study which are potentially cyclable (meaning trips of up to 20 km in a straight line or 30 km by road).

Trips by purpose

base_results = prop_trips_county %>% 
  select(work_assessed_trips:shopping_assessed_trips) %>% 
  pivot_longer(cols = matches("soc|shop|pers|work|pri|sec|ter|total"), names_to = "purpose") %>%
  mutate(purpose = factor(purpose, levels = c("work_assessed_trips", "primary_assessed_trips", "secondary_assessed_trips", "tertiary_assessed_trips", "social_assessed_trips", "shopping_assessed_trips", "personal_assessed_trips", "total"),labels = c("Work", "Primary", "Secondary", "Tertiary", "Social", "Shopping", "Personal and others", "Total"), ordered = TRUE))
  
base_results = base_results %>%
  mutate(source = ifelse(purpose == "Social" | purpose == "Shopping" | purpose =="Personal and others", "Non-POWSCAR\n(estimated)", "POWSCAR")) %>%
  mutate(source = factor(source, levels = c( "POWSCAR", "Non-POWSCAR\n(estimated)"))) 

options(scipen=999)

Comprehensive POWSCAR data are available for trips to work and study, so the statistics on this page focus on these trip purposes.
In r county_lc, r round(base_results$value[1], 1) daily trips (of <20km length) are made to work, r round(base_results[2,2], 0) to primary education, r round(base_results[3,2], 0) to secondary education, and r round(base_results[4,2], 0) to tertiary education.
The route network maps also include estimates of trips made for other purposes including utility and social trips.

g1 = ggplot(base_results) +
  geom_bar(aes(x= purpose, y=value, fill = factor(source)), stat = "identity") +
  labs(x = "Purpose", y = "Number of trips", fill = "Source") + 
  scale_fill_grey(start = .5, end = .7) +
  theme_minimal() 
g1 = g1 + theme(axis.text.x = element_text(angle = 45, hjust = 1)) 
withr::with_options(list(digits = 2), ggplotly(g1, tooltip = c("value")))

Trips by mode

# prepare the dataset
base_results = prop_trips_county %>% 
  tidyr::pivot_longer(cols = c("car_trips", "other_trips", "public_transport_trips", "cycle_trips", "foot_trips"), names_to = "Mode") %>%
  select(`Mode`, value) %>% 
  mutate(Mode = factor(Mode, levels = c("car_trips", "other_trips", "public_transport_trips", "cycle_trips", "foot_trips"),labels = c("Car", "Other", "Public Transport", "Cycling", "Walking"), ordered = TRUE)) %>% 
  mutate(perc = (value/sum(value))*100)

base_results$perc = round(base_results$perc, 2)
options(scipen=999)

The vast majority of trips to work and study (primary, secondary or tertiary education) are made by car (r round(base_results[1,3], 0)%). Cycling represents r round(base_results[4,3], 1)% of the trips to work and study.

# plot the graph
g2 = ggplot(base_results) +
    geom_bar(aes(x=Mode, y=perc), stat="identity", fill="#808080") +
  labs(x = "Mode", y = "Proportion of trips (%)") +
  theme_minimal()
g2 = g2 + theme(axis.text.x = element_text(angle = 45, hjust = 1))
withr::with_options(list(digits = 2), ggplotly(g2, tooltip = c("perc")))

col_modes = c("#fe5f55", "#bebebe", "#ffd166", "#90be6d", "#457b9d")
# prepare the dataset
base_results = prop_trips_county %>% 
  tidyr::pivot_longer(cols = c("cycle_work", "cycle_primary", "cycle_secondary", "cycle_tertiary", "car_work", "car_primary", "car_secondary", "car_tertiary", "foot_work", "foot_primary", "foot_secondary", "foot_tertiary", "pt_work", "pt_primary", "pt_secondary", "pt_tertiary", "other_work", "other_primary", "other_secondary", "other_tertiary"), names_to = "Mode-purpose") %>%
  select(`Mode-purpose`, value) %>% 
  separate(`Mode-purpose`, c("Mode", "Purpose")) %>% 
  mutate(Mode = factor(Mode, levels = c("car",  "other", "pt", "cycle", "foot"),labels = c("Car", "Other", "Public Transport", "Cycling", "Walking"), ordered = TRUE)) %>% 
  mutate(Purpose = factor(Purpose, levels = c("work",  "primary", "secondary", "tertiary"),labels = c("Work", "Primary", "Secondary", "Tertiary"), ordered = TRUE)) %>%
  group_by(Purpose, Mode) %>% 
  summarise(value= sum(value)) %>%
  mutate(perc = value / sum(value)*100)

base_results$perc = round(base_results$perc, 2)
options(scipen=999)

The mode share of cycling for these trips is as follows, based on the Electoral Division in which each trip originates.

tmap_mode("view")

basemaps = c(
  `Grey basemap` = "CartoDB.Positron",
  `Coloured basemap` = "Esri.WorldTopoMap",
  `Cycleways (OSM)` = "https://b.tile-cyclosm.openstreetmap.fr/cyclosm/{z}/{x}/{y}.png",
  `Satellite image` = "https://server.arcgisonline.com/ArcGIS/rest/services/World_Imagery/MapServer/tile/{z}/{y}/{x}'"
)
pal_map = c('#d73027','#f46d43','#fdae61','#fee090','#ffffbf','#e0f3f8','#abd9e9','#74add1','#4575b4')
brks = c(0, 1, 2, 3, 5, 10, 20, 30, 40, Inf) # based on max percent cycling in Ireland

# get the data
pcycle_ed = readRDS(file.path(rds_folder, "pcycle_ed.Rds"))
zones_pcycle_escenarios = zones_region_exact %>%
  select(CSOED_3409, CSOED_34_1, ED_ENGLISH) %>% 
  left_join(pcycle_ed, by = c("CSOED_3409" = "geo_code1")) 

m1 = 
  tm_shape(zones_pcycle_escenarios) +
  tm_borders(col = "black",
          lwd = 0.5) +
  tm_polygons(col = "pcycle_ed_baseline",
          palette = pal_map,
          alpha = 0.7,
          id = "CSOED_34_1",
          group = "Baseline",
          legend.show = FALSE,
          breaks = brks) +
  tm_shape(zones_pcycle_escenarios) +
  tm_borders(col = "black",
          lwd = 0.5) +
  tm_polygons(col = "pcycle_ed_near",
          palette = pal_map,
          alpha = 0.7,
          id = "CSOED_34_1",
          group = "Near Market",
          legend.show = FALSE,
          breaks = brks) +
  tm_shape(zones_pcycle_escenarios) +
  tm_borders(col = "black",
          lwd = 0.5) +
  tm_polygons(col = "pcycle_ed_climate",
          palette = pal_map,
          alpha = 0.7,
          id = "CSOED_34_1",
          group = "Climate Action Plan",
          legend.show = FALSE,
          breaks = brks) +
  tm_shape(zones_pcycle_escenarios) +
  tm_borders(col = "black",
          lwd = 0.5) +
  tm_polygons(col = "pcycle_ed_godutch",
          palette = pal_map,
          alpha = 0.7,
          id = "CSOED_34_1",
          group = "Go Dutch",
          legend.show = FALSE,
          breaks = brks) +
  tm_shape(zones_pcycle_escenarios) +
  tm_borders(col = "black",
          lwd = 0.5) +
  tm_polygons(col = "pcycle_ed_ebike",
          palette = pal_map,
          alpha = 0.7,
          id = "CSOED_34_1",
          group = "Ebike",
          legend.show = FALSE,
          breaks = brks) +
  tm_basemap(server = basemaps) +
  tm_add_legend('fill',
          col = pal_map,
          alpha = 0.7,
          group = c("Baseline", "Near Market", "Climate Action Plan", "Go Dutch", "Ebike"),
          labels = c("0 to 1", "1 to 2", "2 to 3","3 to 5", "5 to 10", "10 to 20", "20 to 30", "30 to 40", "40 to more"),
          title="Percent cycling")

m1 %>%  tmap_leaflet() %>% 
  leaflet::hideGroup(group = c("Near Market", "Climate Action Plan", "Go Dutch", "Ebike"))

Trips by purpose and mode

The car is used more on trips to work, representing r round(base_results[1,4], 0)% of total trips to work. Educational trips have a higher proportion of trips by active modes (walking and cycling).

# plot the graph
g3 = ggplot(base_results, aes(fill=Mode, y=perc, x=Purpose)) + 
    geom_bar(position=position_dodge(), stat="identity") +
  scale_fill_manual(values = col_modes) +
  ylab("Proportion of trips (%)") +
  xlab("Purpose") +
  theme_minimal()

g3 = g3 + theme(axis.text.x = element_text(angle = 45, hjust = 1)) 

withr::with_options(list(digits = 2), ggplotly(g3, tooltip = c("perc")))

Trips by distance and mode

# dist_brks = c(0, 1, 3, 6, 10, 15, 20, Inf)
# dist_labs = c("0-1", "1-3", "3-6", "6-10", "10- 15", "15-20", ">20")

dist_brks = c(0, 5, 10, 15, 20, Inf)
dist_labs = c("0-5", "5-10", "10-15", "15-20", ">20")

routes_powscar_long = routes_powscar_balanced %>% 
  sf::st_drop_geometry() %>%
  slice(1) %>% 
  ungroup() %>% 
  transmute(foot, cyclists, public_transport, other, car = drivers + passengers,
            dist_bands = cut(length_route / 1000, breaks = dist_brks,
                             include.lowest = TRUE, labels = dist_labs)
            ) %>%
  pivot_longer(cols = foot:car, names_to = "Mode") %>% 
  mutate(Mode = factor(Mode, levels = modes, labels = names(modes), ordered = TRUE)) %>% 
  mutate(perc = (value/sum(value))*100) %>% 
  group_by(Mode, dist_bands) %>% 
  summarise(across(where(is.numeric), sum)) 

routes_powscar_long$perc = round(routes_powscar_long$perc, 1)

routes_powscar_long_cyc = routes_powscar_long %>% 
  filter(Mode == "Cycling") %>% 
  group_by(dist_bands) %>% 
  summarise(n = sum(value)) %>% 
  mutate(perc = n/sum(n)*100)

In r county_lc, the vast majority of cycling trips to work and study are for distances up to 10 kilometers, specifically r round(routes_powscar_long_cyc$perc[1]+routes_powscar_long_cyc$perc[2], 0)% of the total cycling trips.

g3 =  ggplot(routes_powscar_long) +
  geom_col(aes(dist_bands, perc, fill = Mode)) +
  scale_fill_manual(values = col_modes) +
  ylab("Proportion of trips (%)") +
  xlab("Route length (km)") +
  theme_minimal()

withr::with_options(list(digits = 1), ggplotly(g3, tooltip = c("perc")))

The following graphs show how work and educational trips by distance bands and modes of transport vary according to the CRUSE scenarios of future cycle uptake.
Cycling trips increase in all of these scenarios, although some are more ambitious than others.
The most ambitious scenario is Ebike followed by Go Dutch, Climate Action Plan, and Near Market.

routes_powscar_long_near = routes_powscar_balanced %>% 
  sf::st_drop_geometry() %>%
  slice(1) %>% 
  ungroup() %>% 
  transmute(foot = foot_near, cyclists = cyclists_near, public_transport = public_transport_near,
            other = other_near, car = drivers_near + passengers_near,
            dist_bands = cut(length_route / 1000, breaks = dist_brks,
                             include.lowest = TRUE, labels = dist_labs)
            ) %>%
  pivot_longer(cols = foot:car, names_to = "Mode") %>% 
  mutate(Mode = factor(Mode, levels = modes, labels = names(modes), ordered = TRUE)) %>% 
  mutate(perc = (value/sum(value))*100) %>%
  group_by(Mode, dist_bands) %>% 
  summarise(across(where(is.numeric), sum))

routes_powscar_long_climate = routes_powscar_balanced %>% 
  sf::st_drop_geometry() %>%
  slice(1) %>% 
  ungroup() %>% 
  transmute(foot = foot_climate, cyclists = cyclists_climate, public_transport = public_transport_climate,
            other = other_climate, car = drivers_climate + passengers_climate,
            dist_bands = cut(length_route / 1000, breaks = dist_brks,
                             include.lowest = TRUE, labels = dist_labs)
            ) %>%
  pivot_longer(cols = foot:car, names_to = "Mode") %>% 
  mutate(Mode = factor(Mode, levels = modes, labels = names(modes), ordered = TRUE)) %>% 
  mutate(perc = (value/sum(value))*100) %>%
  group_by(Mode, dist_bands) %>% 
  summarise(across(where(is.numeric), sum))

routes_powscar_long_godutch = routes_powscar_balanced %>% 
  sf::st_drop_geometry() %>%
  slice(1) %>% 
  ungroup() %>% 
  transmute(foot = foot_godutch, cyclists = cyclists_godutch, public_transport = public_transport_godutch,
            other = other_godutch, car = drivers_godutch + passengers_godutch,
            dist_bands = cut(length_route / 1000, breaks = dist_brks,
                             include.lowest = TRUE, labels = dist_labs)
            ) %>%
  pivot_longer(cols = foot:car, names_to = "Mode") %>% 
  mutate(Mode = factor(Mode, levels = modes, labels = names(modes), ordered = TRUE)) %>%
  mutate(perc = (value/sum(value))*100) %>%
  group_by(Mode, dist_bands) %>% 
  summarise(across(where(is.numeric), sum))

routes_powscar_long_ebike = routes_powscar_balanced %>% 
  sf::st_drop_geometry() %>%
  slice(1) %>% 
  ungroup() %>% 
  transmute(foot = foot_ebike, cyclists = cyclists_ebike, public_transport = public_transport_ebike,
            other = other_ebike, car = drivers_ebike + passengers_ebike,
            dist_bands = cut(length_route / 1000, breaks = dist_brks,
                             include.lowest = TRUE, labels = dist_labs)
            ) %>%
  pivot_longer(cols = foot:car, names_to = "Mode") %>% 
  mutate(Mode = factor(Mode, levels = modes, labels = names(modes), ordered = TRUE)) %>%
  mutate(perc = (value/sum(value))*100) %>%
  group_by(Mode, dist_bands) %>% 
  summarise(across(where(is.numeric), sum))

routes_powscar_long_combined = bind_rows(
  # routes_powscar_long %>% mutate(Scenario = "Baseline"),
  routes_powscar_long_near %>% mutate(Scenario = "Near Market"),
  routes_powscar_long_climate %>% mutate(Scenario = "Climate Action Plan"),
  routes_powscar_long_godutch %>% mutate(Scenario = "Go Dutch"),
  routes_powscar_long_ebike %>% mutate(Scenario = "Ebike")
) %>% 
  mutate(
    Scenario = factor(Scenario, levels = scenarios_ordered)
  )

routes_powscar_long_combined$perc = round(routes_powscar_long_combined$perc, 1) # just one digit

g4 = routes_powscar_long_combined %>%
  ggplot() +
  geom_col(aes(dist_bands, perc, fill = Mode)) +
  scale_fill_manual(values = col_modes) +
  ylab("Proportion of trips (%)") +
  xlab("Route length (km)") +
  facet_wrap(facets = ~Scenario, ncol = 2) +
  theme_minimal()+ theme(axis.text.x = element_text(angle = 45, hjust = 1))

withr::with_options(list(digits = 1), ggplotly(g4, tooltip = c("perc")))

[temospena]

Can you provide me the code for this kind of map, with the different scenarios as layers?

[Robinlovelace]

Good description of general approach: https://walker-data.com/mapboxapi/articles/creating-tiles.html

@natesheehan implemented the solution and is probably better equipped to help than me...

[temospena]

seen that!
by I think that one applies to the other kind of map, with the "basemaps" as tiles.:

[temospena]

I think I may need some help to set this layer as vector tiles, maybe following this:
https://github.com/ITSLeeds/VectorTiles

[temospena]

running smoothly at https://u-shift.github.io/biclarwww/