東京23区1kmメッシュにおける人口総数と想定浸水深の可視化

population_and_flood_damage_biscale.R

library(sf)
library(ensurer)
library(assertr)
library(dplyr)
library(fgdr)
library(jpmesh)
library(readr)
library(ggplot2)
library(cowplot)
library(biscale)
library(conflicted)
conflicted::conflict_prefer("filter", winner = "dplyr")
conflicted::conflict_prefer("ggsave", winner = "ggplot2")

# Tokyo Special wards -------------------------------------------------------------------
source("https://gist.githubusercontent.com/uribo/4bdf76e07399ad75e9896763dd24aa60/raw/9dd1ae700afbdfc64ffe642012ab6372cc722c04/ksj_collect_n03.R")
sf_23wards <-
  read_ksj_n03("N03-180101_13_GML/N03-18_13_180101.shp") %>%
  filter(stringr::str_detect(cityName, "区$")) %>%
  group_by(cityName, administrativeAreaCode) %>%
  summarise() %>%
  ungroup() %>%
  verify(expr = dim(.) == c(23, 3)) %>%
  st_set_crs(6668) %>%
  st_transform(crs = 4326) %>%
  st_union() %>%
  st_sf()

sf_23wards_1kmmesh <-
  fine_separate(5339) %>%
  export_meshes() %>%
  st_join(sf_23wards, join = st_intersects, left = FALSE) %>%
  pull(meshcode) %>%
  purrr::map(
    fine_separate
  ) %>%
  purrr::reduce(c) %>%
  unique() %>%
  export_meshes() %>%
  st_join(sf_23wards, join = st_intersects, left = FALSE) %>%
  verify(expr = nrow(.) == 702L)

# Water Depth  -----------------------------------------------------------
source("https://gist.githubusercontent.com/uribo/5c67ef24dcaf17402175b0d474cd8cb2/raw/816f8da3ca4d03ac2034fb0e347a5178bea089f1/collect_a31.R")
sf_a31_pref13 <-
  collect_a31("A31-12_13_GML/A31-12_13.shp") %>%
  select(waterDepth, targetRiver)

# Population -------------------------------------------------------------------
df_poplation <- read_csv("tblT000846S5339.txt",
                         locale = locale(encoding = "cp932"),
                         col_types = paste0("cd",
                                            paste(rep("c", times = 43), collapse = ""))) %>%
  slice(-seq.int(1, 2)) %>%
  select(KEY_CODE, `T000846001`, `T000846025`) %>%
  mutate_at(vars(`T000846001`, `T000846025`),
            as.numeric) %>%
  verify(expr = dim(.) == c(4706, 3))

# River ----------------------------------------------------------------------
source("https://gist.githubusercontent.com/uribo/5c67ef24dcaf17402175b0d474cd8cb2/raw/276a583e4b316dff73617157a4f0a024de3165d7/collect_w05.R")
sf_w05_23wards <-
  collect_w05("W05-08_13_GML/W05-08_13-g_Stream.shp") %>%
  group_by(W05_002, W05_003, W05_004) %>%
  summarise() %>%
  ungroup() %>%
  st_join(sf_23wards_1kmmesh %>%
            st_union() %>%
            st_sf(), join = st_within, left = FALSE)

# biscale map-----------------------------------------------------------------
sf_hazard_mesh <-
  sf_23wards_1kmmesh %>%
  st_join(sf_a31_pref13, left = FALSE) %>%
  mutate(waterDepth = as.numeric(as.character(waterDepth))) %>%
  group_by(meshcode) %>%
  summarise(waterDepth = mean(waterDepth)) %>%
  left_join(df_poplation, by = c("meshcode" = "KEY_CODE"))

map_data <- bi_class(sf_hazard_mesh,
                 x = `T000846001`, y = waterDepth,
                 style = "quantile", dim = 3)
legend <- bi_legend(pal = "GrPink",
                    dim = 3,
                    xlab = "Population",
                    ylab = "Water Depth Rank",
                    size = 8)

map <-
  ggplot() +
  geom_sf(data = sf_23wards, alpha = 0.8) +
  geom_sf(data = data, aes(fill = bi_class),
          color = "white",
          size = 0.06,
          show.legend = FALSE,
          alpha = 0.8) +
  geom_sf(data = sf_w05_23wards, color = "#7B6ED6", size = 0.3) +
  bi_scale_fill(pal = "GrPink", dim = 3) +
  bi_theme(base_family = "IPAexGothic") +
  theme(plot.title = element_text(size = 12),
        plot.subtitle = element_text(size = 5, hjust = 0.5),
        plot.caption = element_text(size = 4, hjust = 0)) +
  labs(title = "東京23区1kmメッシュにおける人口総数と想定浸水深",
       subtitle = "凡例は明るい色でいずれかの値が低く、暗い色では両方の値が高いことを示す。
       赤色の配色が人口の多さ、青色の配色が想定浸水深のランクの高さの傾向。紫の線は河川。",
       caption = "Source: 国土数値情報 行政区域データ(2019年 N03), 国土数値情報 浸水想定区域データ(2012年 A31)\n国土数値情報 河川データ(2008年 W05), 総務省 国勢調査 地域メッシュ統計 人口総数(2015年)\n瓜生真也(@u_ribo)が加工・編集")

finalPlot <-
  ggdraw() +
  draw_plot(map, 0, 0, 1, 1) +
  draw_plot(legend, x = 0.67, y = 0.05, 0.28, 0.28)

ggsave(file = "tokyo_population_and_flood_damage_assumption.png",
       plot = finalPlot,
       width = 5,
       height = 5,
       units = "in",
       dpi = 300)