Setup

This script uses outputs from the previous 3 Rmd files to create a flow map based on the mapdeck package, and bins start and end points by hexes. This workflow is not currently automated for other datasets, but this is a minimal working example to show that it can be expanded to other metro areas.

flow_lines <- readRDS("G:/My Drive/GES486/final_proj/results/flow_lines.RDS") %>%
  st_transform(crs = 3857)
baltimore_bound = counties(state = "MD", cb = TRUE) %>%
  filter(str_detect(GEOID, "24510|24005")) %>%
  st_transform(crs = 3857)
balt_hex <- st_make_grid(baltimore_bound, #create 2000m hex grid
                         cellsize = c(1600,1600),
                         what = "polygons",
                         square = FALSE,
                         crs = 3857
                         ) %>%
  st_as_sf() %>%
  mutate(hex_id = paste("hex_", row_number(), sep = ""))
balt_hex.intersects <- st_intersects(st_union(baltimore_bound), balt_hex)
balt_hex.subset <- balt_hex[balt_hex.intersects[[1]],]
balt_centroid <- st_centroid(balt_hex.subset) %>% st_transform(4326) #dataframe of centroids of each hex
## Warning in st_centroid.sf(balt_hex.subset): st_centroid assumes attributes are
## constant over geometries of x
baltimore_bound <- baltimore_bound %>% st_transform(4326)
tm_shape(baltimore_bound)+
  tm_polygons(col = "#bdbdbd", border.col = "black", lwd = 2)+
  tm_shape(balt_hex)+
  tm_borders()

This next block of code is a mess, but I couldn’t get dplyr and sf to cooperate with some of these dataframes, which contained multiple geometry columns. This can be cleaned up (and probably will be), but for now, this works for the data that I have.

balt_hex <- balt_hex %>% st_transform(4326)
balt_hex.subset <- balt_hex.subset %>% st_transform(4326)
flow_lines_sf <- st_as_sf(flow_lines)
flow_lines_sf <- st_transform(flow_lines_sf, crs = 4326)
flow_lines_sf <- st_set_geometry(flow_lines_sf, flow_lines_sf$start_geom) %>% st_transform(4326)
start_points_join <- st_join(flow_lines_sf, balt_hex.subset) #spatial join of start points (set start points as active geometry in previous step)
flow_lines_sf <- st_set_geometry(flow_lines_sf, flow_lines_sf$end_geom) %>% st_transform(4326)
end_points_join <- st_join(flow_lines_sf, balt_hex.subset) #in similar fashion, spatial join of end points
flow_lines_sf$start_hex_id <- start_points_join$hex_id
flow_lines_sf$end_hex_id <- end_points_join$hex_id
flow_lines_sf <- left_join(st_drop_geometry(flow_lines_sf), balt_centroid, by = c("start_hex_id" = "hex_id")) #join centroid of endpoint hex to row
flow_lines_sf <- rename(flow_lines_sf, start_centroid = x)
flow_lines_sf <- left_join(flow_lines_sf, balt_centroid, by = c("end_hex_id" = "hex_id")) #likewise for end
flow_lines_sf <- rename(flow_lines_sf, end_centroid = x)
flow_lines_sf <- st_sf(flow_lines_sf) %>% st_transform(4326)
flow_lines_arc <- rename(count(flow_lines_sf, start_hex_id, end_hex_id), wgt = n)
flow_lines_arc <- flow_lines_arc %>% mutate(scale_weight = (3*wgt))
flow_lines_arc <- left_join(st_drop_geometry(flow_lines_arc), balt_centroid, by = c("end_hex_id" = "hex_id"))
flow_lines_arc <- left_join(flow_lines_arc, balt_centroid, by = c("start_hex_id" = "hex_id"))
flow_lines_arc <- flow_lines_arc %>% rename(end_centroid = x.x, start_centroid = x.y) %>% st_sf()
flow_lines_arc <- flow_lines_arc %>% st_transform(4326)

The following methodology, to count start and end points within hexes, is adapted from Matt Herman’s blog post detailing the counting of trees within NYC census geographies.

start_hex_count <- count(as_tibble(start_points_join), hex_id) %>% rename(start_in_hex = n)
end_hex_count <- count(as_tibble(end_points_join), hex_id) %>% rename(end_in_hex = n)
balt_hex.subset <- left_join(balt_hex.subset, start_hex_count, by = c("hex_id" = "hex_id"))
balt_hex.subset <- left_join(balt_hex.subset, end_hex_count, by = c("hex_id" = "hex_id"))
balt_hex.subset <- balt_hex.subset %>% replace(is.na(.), 0)
balt_hex.subset <- balt_hex.subset %>% mutate(total_endpoint = start_in_hex + end_in_hex) 
balt_hex.subset <- balt_hex.subset %>% st_transform(4326)

Three flow maps can be generated from this data: one symbolized with start points per hex, one with end points per hex, and one with total endpoints per hex.

flow_lines_arc %>%
  mapdeck(token = "pk.eyJ1IjoiaGRlZm9yZDEiLCJhIjoiY2t6cHg5b3gwMjJvcTJucW9leGZxMW1uaiJ9.TqfZZCMswamPygY4IE5yOg") %>%
  add_arc(origin = "start_centroid",
          destination = "end_centroid",
          stroke_from = "#000000",
          stroke_to = "#000000",
          stroke_width = "scale_weight",
          update_view = TRUE) %>%
  add_sf(data = balt_hex.subset,
         fill_colour = "start_in_hex",
         fill_opacity = 180,
         legend = TRUE
         )
## Registered S3 method overwritten by 'jsonify':
##   method     from    
##   print.json jsonlite
flow_lines_arc %>%
  mapdeck(token = "pk.eyJ1IjoiaGRlZm9yZDEiLCJhIjoiY2t6cHg5b3gwMjJvcTJucW9leGZxMW1uaiJ9.TqfZZCMswamPygY4IE5yOg") %>%
  add_arc(origin = "start_centroid",
          destination = "end_centroid",
          stroke_from = "#000000",
          stroke_to = "#000000",
          stroke_width = "scale_weight",
          update_view = TRUE) %>%
  add_sf(data = balt_hex.subset,
         fill_colour = "end_in_hex",
         fill_opacity = 180,
         legend = TRUE
         )
flow_lines_arc %>%
  mapdeck(token = "pk.eyJ1IjoiaGRlZm9yZDEiLCJhIjoiY2t6cHg5b3gwMjJvcTJucW9leGZxMW1uaiJ9.TqfZZCMswamPygY4IE5yOg") %>%
  add_arc(origin = "start_centroid",
          destination = "end_centroid",
          stroke_from = "#000000",
          stroke_to = "#000000",
          stroke_width = "scale_weight",
          update_view = TRUE) %>%
  add_sf(data = balt_hex.subset,
         fill_colour = "total_endpoint",
         fill_opacity = 180,
         legend = TRUE
         )
saveRDS(flow_lines_arc, file = "G:/My Drive/GES486/final_proj/results/flow_lines_arc.RDS")
saveRDS(balt_hex, file = "G:/My Drive/GES486/final_proj/results/balt_hex.RDS")