tatsu-map.R

library("tidyverse")
library("stringr")
library("leaflet")
library("leaflet.extras")
library("sf")

# 日本地図のデータ
# https://oku.edu.mie-u.ac.jp/~okumura/stat/shape.html
japanmap <- read_sf("https://okumuralab.org/~okumura/stat/data/japan.geojson")

# Geolonia 住所データ（日本の町丁目、大字、小字レベルの地名とその緯度経度データ）
# https://geolonia.github.io/japanese-addresses/
place_names <- read_csv("latest.csv")

# アマノ技研 地方公共団体の位置データ （Ver. 1.0.26 [2023-12-01]）
# https://amano-tec.com/data/localgovernments.html
municipalities_geo <- read_tsv("r0512puboffice_utf8.csv") %>%
  # 元データで市区町村コードが数値で入っているために 1100 のように
  # 4桁以下になっているところがあるので修正
  mutate(jiscode = str_pad(jiscode, width = 5, pad = "0"))

# 郵便住所.jp 市区町村の情報（2023年12月28日版）
# https://postaladdress.jp/municipality
municipalities <- read_csv("municipalities_code.csv",
                           col_names = c("市区町村コード", "市区町村名", "都道府県名"))


# 市区町村名に龍・竜・辰が入っているもの
龍市区町村 <- 
  municipalities %>% filter(str_detect(市区町村名, "[龍竜辰]")) %>%
  # 郡名にしか龍・竜・辰が入っていないものを除去
  filter(!str_detect(市区町村名, "[龍竜辰].*郡[^龍竜辰]*$")) %>%
  mutate(漢字 = case_when(
    str_detect(市区町村名, "龍") ~ "龍",
    str_detect(市区町村名, "竜") ~ "竜",
    str_detect(市区町村名, "辰") ~ "辰",
    TRUE ~ NA_character_
  )) %>%
  mutate(フル地名 = str_c(都道府県名,市区町村名)) %>%
  # 浜松市が2024年1月1日に区の再編をした影響で、
  # 浜松市天竜区のコードが 22137 → 22140 に変更。
  # アマノ技研のデータでは 22137、
  # 郵便住所.jp のデータでは 22140 なので、22137に統一
  mutate(市区町村コード = 
           if_else(市区町村コード == "22140", "22137", 市区町村コード)) %>%
  left_join(municipalities_geo, by = join_by(市区町村コード == jiscode)) %>%
  select(地名 = 市区町村名, フル地名, 緯度 = lat, 経度 = long, 漢字) %>%
  mutate(レベル = "市区町村")

# 大字名に龍・竜・辰が入っているもの
龍大字 <- 
  place_names %>% filter(str_detect(大字町丁目名, "[龍竜辰]")) %>% 
    filter(大字町丁目名 != lag(大字町丁目名) | is.na(lag(大字町丁目名))) %>%
    mutate(漢字 = case_when(
      str_detect(大字町丁目名, "龍") ~ "龍",
      str_detect(大字町丁目名, "竜") ~ "竜",
      str_detect(大字町丁目名, "辰") ~ "辰",
      TRUE ~ NA_character_
    )) %>%
    mutate(フル地名 = 
             str_c(都道府県名,市区町村名,大字町丁目名)) %>%
  select(地名 = 大字町丁目名, フル地名, 緯度, 経度, 漢字) %>%
  mutate(レベル = "大字")

# 小字名に龍・竜・辰が入っているもの
龍小字 <- 
  place_names %>% filter(str_detect(`小字・通称名`, "[龍竜辰]")) %>%
  mutate(漢字 = case_when(
    str_detect(`小字・通称名`, "龍") ~ "龍",
    str_detect(`小字・通称名`, "竜") ~ "竜",
    str_detect(`小字・通称名`, "辰") ~ "辰",
    TRUE ~ NA_character_
  )) %>%
  mutate(フル地名 = 
           str_c(都道府県名,市区町村名,大字町丁目名,`小字・通称名`)) %>%
  select(地名 = `小字・通称名`, フル地名, 緯度, 経度, 漢字) %>%
  mutate(レベル = "小字")

# 今まで作成した地名のリストを統合
龍地名 <- 
  bind_rows(龍市区町村, 龍大字, 龍小字)

# ggplot2 で静的な地図を作成する
龍地図_gg <- 龍地名 %>%
  mutate(凡例 = str_c(漢字, "（", レベル, "）")) %>%
  ggplot() +
  geom_sf(data=japanmap, fill = "white") +
  geom_point(aes(x = 経度, y = 緯度, color = 凡例, shape = 凡例),
             alpha = 0.8) + 
  scale_color_manual(breaks = c("竜（市区町村）","竜（大字）", "竜（小字）",
                                "龍（市区町村）","龍（大字）", "龍（小字）",
                                "辰（市区町村）","辰（大字）", "辰（小字）"),
                     values = c("竜（市区町村）" = "#005ae1",
                                "竜（大字）" = "#005ae1",
                                "竜（小字）" = "#005ae1",
                                "龍（市区町村）" = "#4dc4e1",
                                "龍（大字）" = "#4dc4e1",
                                "龍（小字）" = "#4dc4e1",
                                "辰（市区町村）" = "#f6aa00",
                                "辰（大字）" = "#f6aa00",
                                "辰（小字）" = "#f6aa00")) +
  scale_shape_manual(breaks = c("竜（市区町村）","竜（大字）", "竜（小字）",
                                "龍（市区町村）","龍（大字）", "龍（小字）",
                                "辰（市区町村）","辰（大字）", "辰（小字）"),
                     values = c("竜（市区町村）" = 15,
                                "竜（大字）" = 16,
                                "竜（小字）" = 18,
                                "龍（市区町村）" = 15,
                                "龍（大字）" = 16,
                                "龍（小字）" = 18,
                                "辰（市区町村）" = 15,
                                "辰（大字）" = 16,
                                "辰（小字）" = 18)) +
  guides(color = guide_legend(nrow = 3)) +
  theme_void() +
  theme(legend.position="bottom")

# 日本全体の地図を出力する
龍地図_gg
ggsave("tatsu_all_japan.png", width = 1500, height=1500, units = "px",
       bg = "white")


# 北日本の地図を出力する
龍地図_gg + xlim(c(137,145)) + ylim(c(37,45))
ggsave("tatsu_n_japan.png", width = 1500, height=1500, units = "px",
       bg = "white")


# 東日本の地図を出力する
龍地図_gg + xlim(c(136,141)) + ylim(c(34,37))
ggsave("tatsu_e_japan.png", width = 1500, height=1500, units = "px",
       bg = "white")

# 西日本の地図を出力する
龍地図_gg + xlim(c(129,136.5)) + ylim(c(28,36))
ggsave("tatsu_w_japan.png", width = 1500, height=1500, units = "px",
         bg = "white")


# leaflet でインタラクティブな地図を作る
# leaflet での色指定
pal <- colorFactor(palette =  c("竜" = "#005ae1",
                                "龍" = "#4dc4e1",
                                "辰" = "#f6aa00"),
                   levels = c("竜", "龍", "辰"))

# leaflet の作成
龍地図_leaflet <- leaflet(龍地名) %>%
  # 地理院地図の白地図をベースマップに
  addTiles(urlTemplate = "https://cyberjapandata.gsi.go.jp/xyz/blank/{z}/{x}/{y}.png",
           attribution = "<a href='https://maps.gsi.go.jp/development/ichiran.html' target='_blank'>地理院タイル</a>",
           options = tileOptions(minZoom = 5, maxZoom = 12)) %>%
  setView(lng = 136, lat = 35, zoom = 5) %>%
  # 地図上にマーカをプロット
  addCircleMarkers(~経度, ~緯度, 
             label = ~フル地名, popup = ~フル地名,
             color = ~pal(漢字),
             radius = 5, fillOpacity=0.9, stroke = FALSE) %>%
  # 凡例を追加
  addLegend("topleft", pal = pal, values = ~漢字,
            title = "", opacity = 1) %>%
  # フルスクリーン表示するためのボタンを追加
  addFullscreenControl()

# leaflet の地図の出力
htmlwidgets::saveWidget(widget = 龍地図_leaflet, file = "tatsu_map.html",  title = "竜・龍・辰が使われている地名")