stplanr-od.R
In stplanr: Sustainable Transport Planning

## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  eval = FALSE
)
has_webshot <- "webshot" %in% installed.packages()

## ---- eval=FALSE--------------------------------------------------------------
#  install.packages("od")
#  vignette("od")

## ----setup, message=FALSE-----------------------------------------------------
#  library(stplanr)
#  library(dplyr)
#  od <- stplanr::od_data_sample %>%
#    select(-matches("rail|name|moto|car|tax|home|la_")) %>%
#    top_n(n = 14, wt = all)
#  class(od)
#  od

## -----------------------------------------------------------------------------
#  od[1:3]

## -----------------------------------------------------------------------------
#  od_matrix <- od_to_odmatrix(od[1:3])
#  class(od_matrix)
#  od_matrix

## -----------------------------------------------------------------------------
#  lapply(c("all", "bicycle"), function(x) od_to_odmatrix(od[c("geo_code1", "geo_code2", x)]))

## -----------------------------------------------------------------------------
#  odmatrix_to_od(od_matrix)

## -----------------------------------------------------------------------------
#  (od_inter <- od %>% filter(geo_code1 != geo_code2))
#  (od_intra <- od %>% filter(geo_code1 == geo_code2))

## -----------------------------------------------------------------------------
#  (od_min <- od_data_sample[c(1, 2, 9), 1:6])
#  (od_oneway <- od_oneway(od_min))

## -----------------------------------------------------------------------------
#  z <- zones_sf
#  class(z)
#  l <- od2line(flow = od_inter, zones = z)

## -----------------------------------------------------------------------------
#  class(l)
#  nrow(od) - nrow(l)
#  ncol(l) - ncol(od)

## -----------------------------------------------------------------------------
#  plot(l$geometry)

## -----------------------------------------------------------------------------
#  plot(l)

## -----------------------------------------------------------------------------
#  library(leaflet)
#  leaflet() %>%
#    addTiles() %>%
#    addPolygons(data = l)

## ---- error=TRUE--------------------------------------------------------------
#  od$geo_code2[3] <- "nomatch"
#  od2line(od, z)

## ---- eval=FALSE--------------------------------------------------------------
#  library(dplyr)
#  
#  # get nationwide OD data
#  od_all <- pct::get_od()
#  nrow(od_all)
#  # > 2402201
#  od_all$Active <- (od_all$bicycle + od_all$foot) /
#    od_all$all * 100
#  centroids_all <- pct::get_centroids_ew() %>% sf::st_transform(4326)
#  nrow(centroids_all)
#  # > 7201
#  london <- pct::pct_regions %>% filter(region_name == "london")
#  centroids_london <- centroids_all[london, ]
#  od_london <- od_all %>%
#    filter(geo_code1 %in% centroids_london$msoa11cd) %>%
#    filter(geo_code2 %in% centroids_london$msoa11cd)
#  od_london <- od_all[
#    od_all$geo_code1 %in% centroids_london$msoa11cd &
#      od_all$geo_code2 %in% centroids_london$msoa11cd,
#  ]

## ---- eval=FALSE, echo=FALSE--------------------------------------------------
#  # aim: create a reproducible OD dataset
#  od_lnd <- od_london %>%
#    select(-matches("rail|name|moto|car|tax|home")) %>%
#    filter(geo_code2 == "E02000001") %>%
#    top_n(4, wt = all)
#  z_lnd <- centroids_london %>%
#    filter(msoa11cd %in% c(od$geo_code1, od$geo_code2))

## ---- eval=FALSE--------------------------------------------------------------
#  desire_lines_london <- od2line(od_london, centroids_london)
#  nrow(desire_lines_london)
#  # > 352654

## ---- eval=FALSE--------------------------------------------------------------
#  min_trips_threshold <- 20
#  desire_lines_inter <- desire_lines_london %>% filter(geo_code1 != geo_code2)
#  desire_lines_intra <- desire_lines_london %>% filter(geo_code1 == geo_code2)
#  desire_lines_top <- desire_lines_inter %>% filter(all >= min_trips_threshold)
#  nrow(desire_lines_top)
#  # > 28879

## ---- eval=FALSE--------------------------------------------------------------
#  nrow(desire_lines_top) / nrow(desire_lines_london)
#  # > 0.08189046
#  sum(desire_lines_top$all) / sum(desire_lines_london$all)
#  # > 0.557343

## ---- eval=FALSE--------------------------------------------------------------
#  plot(desire_lines_top["all"])

## ---- echo=FALSE--------------------------------------------------------------
#  knitr::include_graphics("https://user-images.githubusercontent.com/1825120/61058906-030a5c80-a3f0-11e9-90b5-d216964e9681.png")

## ---- eval=FALSE--------------------------------------------------------------
#  lwd <- desire_lines_top$all / mean(desire_lines_top$all) / 10
#  desire_lines_top$percent_dont_drive <- 100 - desire_lines_top$car_driver / desire_lines_top$all * 100
#  plot(desire_lines_top["percent_dont_drive"], lwd = lwd, breaks = c(0, 50, 70, 80, 90, 95, 100))

## ---- echo=FALSE--------------------------------------------------------------
#  knitr::include_graphics("https://user-images.githubusercontent.com/1825120/62073083-e5ceee00-b237-11e9-9cc7-8bf62d0e9b3f.png")

## ---- eval=FALSE--------------------------------------------------------------
#  library(tmap)
#  desire_lines_top <- desire_lines_top %>%
#    arrange(Active)
#  tm_shape(london) + tm_borders() +
#    tm_shape(desire_lines_top) +
#    tm_lines(
#      palette = "plasma", breaks = c(0, 5, 10, 20, 40, 100),
#      lwd = "all",
#      scale = 9,
#      title.lwd = "Number of trips",
#      alpha = 0.5,
#      col = "Active",
#      title = "Active travel (%)",
#      legend.lwd.show = FALSE
#    ) +
#    tm_scale_bar() +
#    tm_layout(
#      legend.bg.alpha = 0.5,
#      legend.bg.color = "white"
#    )

## ---- echo=FALSE--------------------------------------------------------------
#  # tmap_save(.Last.value, "tmap-london.png")
#  knitr::include_graphics("https://user-images.githubusercontent.com/1825120/61066243-12dc6d80-a3fd-11e9-8805-826a47c553f6.png")

## ---- eval=FALSE, echo=FALSE--------------------------------------------------
#  saveRDS(od_all, "od_all.Rds")
#  piggyback::pb_upload("od_all.Rds")

## ---- eval=FALSE--------------------------------------------------------------
#  zones_london <- pct::get_pct_zones("london") %>%
#    select("geo_code")
#  origin_attributes <- desire_lines_top %>%
#    sf::st_drop_geometry() %>%
#    group_by(geo_code1) %>%
#    summarize_if(is.numeric, sum) %>%
#    dplyr::rename(geo_code = geo_code1)
#  # origin_attributes <-
#  zones_origins <- left_join(zones_london, origin_attributes, by = "geo_code")
#  plot(zones_origins, border = NA)

## ---- echo=FALSE--------------------------------------------------------------
#  knitr::include_graphics("https://user-images.githubusercontent.com/1825120/61067619-e7a74d80-a3ff-11e9-8c15-7467717b36ec.png")

## ---- eval=FALSE--------------------------------------------------------------
#  destination_attributes <- desire_lines_top %>%
#    sf::st_drop_geometry() %>%
#    group_by(geo_code2) %>%
#    summarize_if(is.numeric, sum) %>%
#    dplyr::rename(geo_code = geo_code2) %>%
#    mutate_at(vars(-matches("geo_|all")), funs(. / all)) %>%
#    left_join(zones_london, ., by = "geo_code")
#  
#  plot(destination_attributes, border = NA)

## ---- echo=FALSE--------------------------------------------------------------
#  knitr::include_graphics("https://user-images.githubusercontent.com/1825120/61069409-27703400-a404-11e9-9c83-1cd5f2397260.png")

## ---- out.width="100%", warning=FALSE, eval=FALSE, echo=FALSE-----------------
#  u <- "https://github.com/ropensci/stplanr/releases/download/0.2.9/lines_cars.Rds"
#  f <- file.path(tempdir(), "lines_cars.Rds")
#  download.file(u, f)
#  lines_cars <- readRDS(f)
#  plot(lines_cars["car_km"], lwd = lines_cars$car_km / 1000)

## ---- eval=FALSE, echo=FALSE--------------------------------------------------
#  sum(lines_cars$car_km * 2.5 * 200) / 1e9

## ---- echo=FALSE, eval=FALSE--------------------------------------------------
#  # out-takes and test code
#  # demonstrate bug/feature in sf
#  library(sf)
#  m <- matrix(c(
#    0, 0,
#    1, 0,
#    0, 1,
#    0, 0
#  ), ncol = 2)
#  p <- st_polygon(list(m))
#  
#  m <- matrix(c(
#    0, 0,
#    1, 0,
#    0, NA,
#    0, 0
#  ), ncol = 2)
#  p <- st_polygon(list(m))
#  plot(p)
#  
#  l <- st_linestring(m)
#  plot(l)
#  plot(p)
#  m <- matrix(c(0, 0, 0, NA), ncol = 2)
#  l <- st_linestring(m)
#  plot(l)

## ---- echo=FALSE, eval=FALSE--------------------------------------------------
#  usethis::use_data(od_data_sample)
#  # aim: get top flows by car use multiplied by distance
#  # subset flows with more than n people driving:
#  od_cars <- od_data_all[od_data_all$car_driver >= 50, ]
#  cents_ew <- pct::get_centroids_ew()
#  od_cars <- od_cars[
#    od_cars$geo_code1 %in% cents_ew$msoa11cd &
#      od_cars$geo_code2 %in% cents_ew$msoa11cd,
#  ]
#  desire_lines_cars <- od2line(od_cars, cents_ew)
#  plot(desire_lines_cars[1:999, ])
#  desire_lines_cars$euclidean_distance_m <- as.numeric(sf::st_length(desire_lines_cars)) / 1000
#  desire_lines_cars$car_km <- desire_lines_cars$car_driver * desire_lines_cars$euclidean_distance_m
#  lines_cars <- dplyr::top_n(desire_lines_cars, 20000, car_km)
#  summary(lines_cars$car_driver)
#  plot(lines_cars["car_km"])
#  saveRDS(lines_cars, "lines_cars.Rds")
#  piggyback::pb_upload("lines_cars.Rds")