code/old-to-future-remove/12-code-extension.R

In Robinlovelace/geocompr: Geocomputation with R

# Aim: build on code in Chapter 12 of Geocomputation with R to demosntrate geographic levels

## ----12-transport-1, message=FALSE, results='hide'-----------------------
library(sf)
library(dplyr)
library(spDataLarge)
library(stplanr)      # geographic transport data package
library(tmap)         # visualization package (see Chapter 8)

## ----12-transport-2, echo=FALSE, eval=FALSE------------------------------
## # code that generated the input data - see also ?bristol_ways
## # source("https://github.com/Robinlovelace/geocompr/raw/main/code/12-transport-data-gen.R")
## # view input data
## summary(bristol_ways)
## summary(bristol_ttwa)
## summary(bristol_region)
## 
region_all = rbind(bristol_region, bristol_ttwa)
library(tmap)
tmap_mode("view")
qtm(bristol_ways, lines.col = "highway", lines.lwd = 3, lines.palette = c("green", "black", "red")) +
  tm_scale_bar() +
  tm_shape(region_all) +
  tm_borders(lwd = c(5, 7), col = "darkblue")

## ----bristol, echo=FALSE, fig.cap="Bristol's transport network represented by colored lines for active (green), public (railways, black) and private motor (red) modes of travel. Blue border lines represent the inner city boundary and the larger Travel To Work Area (TTWA).", fig.scap="Bristol's transport network."----
knitr::include_graphics("https://user-images.githubusercontent.com/1825120/34452756-985267de-ed3e-11e7-9f59-fda1f3852253.png")

## ----12-transport-3, eval=FALSE, echo=FALSE------------------------------
## if (!require(readODS)) {
##   install.packages("readODS")
## }
## u = "https://www.gov.uk/government/uploads/system/uploads/attachment_data/file/536823/local-area-walking-and-cycling-in-england-2015.zip"
## download.file(u, "local-area-walking-and-cycling-in-england-2015.zip")
## unzip("local-area-walking-and-cycling-in-england-2015.zip")
## View(readODS::read_ods("Table index.ods"))
## cw0103 = readODS::read_ods("cw0103.ods")
## View(cw0103)

## Another issue with small zones is related to anonymity rules.

## ----12-transport-5------------------------------------------------------
names(bristol_zones)

## ----12-transport-6------------------------------------------------------
nrow(bristol_od)
nrow(bristol_zones)

## ----12-transport-7------------------------------------------------------
zones_attr = bristol_od %>% 
  group_by(o) %>% 
  summarize_if(is.numeric, sum) %>% 
  dplyr::rename(geo_code = o)

## ----12-transport-8------------------------------------------------------
summary(zones_attr$geo_code %in% bristol_zones$geo_code)

## ----12-transport-9------------------------------------------------------
zones_joined = left_join(bristol_zones, zones_attr, by = "geo_code")
sum(zones_joined$all)
names(zones_joined)

## ----12-transport-10-----------------------------------------------------
zones_od = bristol_od %>% 
  group_by(d) %>% 
  summarize_if(is.numeric, sum) %>% 
  select(geo_code = d, all_dest = all) %>% 
  inner_join(zones_joined, ., by = "geo_code")

## ----12-transport-11, eval=FALSE-----------------------------------------
## qtm(zones_od, c("all", "all_dest")) +
##   tm_layout(panel.labels = c("Origin", "Destination"))

## ----zones, echo=FALSE, fig.cap="Number of trips (commuters) living and working in the region. The left map shows zone of origin of commute trips; the right map shows zone of destination (generated by the script 12-zones.R).", message=FALSE, fig.scap="Number of trips (commuters) living and working in the region."----
source("https://github.com/Robinlovelace/geocompr/raw/main/code/12-zones.R", print.eval = TRUE)

## ----12-transport-12-----------------------------------------------------
od_top5 = bristol_od %>% 
  arrange(desc(all)) %>% 
  top_n(5, wt = all)

bristol_od$Active = (bristol_od$bicycle + bristol_od$foot) /
  bristol_od$all * 100

od_intra = filter(bristol_od, o == d)
od_inter = filter(bristol_od, o != d)

## ----12-transport-15, warning=FALSE--------------------------------------
desire_lines = od2line(od_inter, zones_od)

desire_lines$distance = as.numeric(st_length(desire_lines))
desire_carshort = dplyr::filter(desire_lines, car_driver > 300 & distance < 5000)

desire_lines$id = stplanr::od_id_character(desire_lines$o, desire_lines$d)
desire_lines_100 = desire_lines %>% 
  top_n(n = 100, wt = all)


qtm(desire_lines_100, lines.lwd = "all")



# cycle_routes = line2route(desire_lines[1:9, ], route_fun = cyclestreets::journey) # routing
cycle_routes_original = pct::get_pct_routes_fast(region = "avon")
cycle_routes = cycle_routes_original %>% select(id, geo_code1, geo_code2, dutch_slc)
summary(cycle_routes$geo_code1 %in% desire_lines_100$o)
summary(cycle_routes$geo_code2 %in% desire_lines_100$d)
summary(cycle_routes$id %in% desire_lines_100$id)

head(cycle_routes$id)
names(desire_lines)

cycle_routes_100 = cycle_routes %>% 
  filter(id %in% desire_lines$id)

desire_lines_df = sf::st_drop_geometry(desire_lines_100)
desire_lines_cycleways = inner_join(cycle_routes_100, desire_lines_df, by = "id")

plot(desire_lines_cycleways)

rnet = overline(desire_lines_cycleways, "dutch_slc")
plot(rnet)

# getting geographic data
library(geofabrik)
bristol_railways = get_geofabrik(name = "Bristol", key = "railway", value = "rail")
bristol_cycleways = get_geofabrik(name = "Bristol", key = "highway", value = "cycleway")
tm_shape(rnet) + tm_lines() +
  tm_shape(bristol_railways) + tm_lines(col = "red")

tmap_mode("view")
tm_shape(rnet) + tm_lines(lwd = "dutch_slc", scale = 9) +
  tm_shape(bristol_railways) + tm_lines(col = "red") +
  tm_shape(bristol_cycleways) + tm_lines(col = "surface", lwd = 2, colorNA = "green")