Skip to content

Instantly share code, notes, and snippets.

@chichacha
Created October 6, 2019 20:46
Show Gist options
  • Save chichacha/26e64788e95d10fee22b7898b2bb3cdc to your computer and use it in GitHub Desktop.
Save chichacha/26e64788e95d10fee22b7898b2bb3cdc to your computer and use it in GitHub Desktop.
Abstract Map using Open Street Map
library(tidyverse)
library(sf)
library(tidygraph)
library(igraph)
library(units)
library(tmap)
library(osmdata)
library(rgrass7)
library(link2GI)
library(nabor)
library(ggthemes)
library(ggraph)
##
my_bbox <- c(140.841169,37.033766,140.908632,37.061785)
q <- opq(bbox=my_bbox) %>% ## bild an overpass query
add_osm_feature(key="highway") %>% ## highway, amenity etc.
osmdata_sf() %>% ## return the data osmdata in sf format!
osm_poly2line() ## circular highways are stored in polygon, so this function will combine those with line
## what does it look like?
q ## osm_lines --> shows how many linestrings!
##
q_map <- q$osm_lines %>%
select(name, highway) %>%
mutate(highway = fct_infreq(highway))
## What are named road in this data
q_map %>% as_tibble() %>% count(name, sort=T)
q_map %>% as_tibble() %>% count(highway, sort=T)
## Quick Plotting
ggplot(data=q_map) +
geom_sf(aes(color=highway)) +
theme_map() +
scale_color_tableau("Hue Circle") +
coord_sf(xlim=c(my_bbox[1], my_bbox[3]), ylim=c(my_bbox[2], my_bbox[4]))
### Prepping Edges
edges <- q_map %>%
mutate(edgeID = c(1:n()))
## creating Nodes from Edges
nodes <- edges %>%
st_coordinates() %>% ## covert all of line segments to points
as_tibble() %>%
rename(edgeID = L1) %>%
group_by(edgeID) %>%
slice(c(1, n())) %>% ## get first and last points
ungroup() %>%
mutate(start_end = rep(c('start', 'end'), times = n()/2))
nodes
## using ?group_indices to assign unique id to each of groups
nodes <- nodes %>%
mutate(xy = paste(.$X, .$Y)) %>%
mutate(nodeID = group_indices(., factor(xy, levels = unique(xy)))) %>%
select(-xy)
nodes
edges <- nodes %>%
select(start_end, nodeID, edgeID) %>%
pivot_wider(id_cols=edgeID,names_from=start_end, values_from=nodeID) %>%
rename(from=start, to=end) %>%
inner_join(edges)
edges <-edges %>% st_as_sf()
edges
## reducing duplicate nodes
nodes <- nodes %>%
distinct(nodeID, .keep_all = TRUE) %>%
select(-c(edgeID, start_end)) %>%
st_as_sf(coords = c('X', 'Y'))
nodes <- nodes %>% st_set_crs(st_crs(edges))
nodes
## graph objects
g <- tbl_graph(nodes=nodes, edges=as_tibble(edges), directed=F)
g <- g %>%
activate(edges) %>%
mutate(length = st_length(geometry))
g %>% activate(edges) %>% as_tibble()
g %>% activate(nodes) %>% as_tibble()
g <- g %>%
activate(nodes) %>%
mutate(degree = centrality_degree()) %>%
mutate(betweenness = centrality_betweenness(weights = length)) %>%
activate(edges) %>%
mutate(betweenness = centrality_edge_betweenness(weights = length))
ggplot() +
geom_sf(data = g %>% activate(edges) %>% as_tibble() %>% st_as_sf(),
aes(alpha = betweenness, size=betweenness), color="white",
lineend="round") +
theme_map() +
scale_size_continuous(range=c(0.1,1.2), guide="none", trans="sqrt") +
scale_alpha_continuous(guide="none", range=c(0.3,1)) +
scale_color_manual(values=gray.colors(n=18), guide="none") +
theme(plot.background=element_rect(fill="#000000de"))+
coord_sf(xlim=c(my_bbox[1], my_bbox[3]), ylim=c(my_bbox[2], my_bbox[4]))
abs(my_bbox[1]-my_bbox[3])/abs(my_bbox[4]-my_bbox[2]) -> asp
ggsave(filename=str_c("Map_",paste(round(my_bbox,2),collapse="_"),".pdf"), height=9, width=asp*9*0.7)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment