vector_tile.md

References

Original article: https://qiita.com/frogcat/items/3d795c5cbe026c372bf4 (Japanese)
Original idea: https://dailyportalz.jp/kiji/douro-hougaku-machi-no-dekikata (Japanese)
How to calculate tile location from lat-long: https://wiki.openstreetmap.org/wiki/Slippy_map_tilenames#Pseudo-code
A function to read vector tiles: https://jeroen.cran.dev/protolite/reference/mapbox.html

Code

library(ggplot2)
#> Warning: replacing previous import 'vctrs::data_frame' by 'tibble::data_frame'
#> when loading 'dplyr'
library(patchwork)
library(sf)
#> Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1
library(dplyr, warn.conflicts = FALSE)

sec <- function(x) {
  1 / cos(x)
}

lonlat2xy <- function(lat_deg, lon_deg, zoom) {
  n <- 2^zoom
  
  x <- (n * (lon_deg + 180)) %/% 360
  lat_rad <- lat_deg * pi / 180
  y <- (n * (1 - log(tan(lat_rad) + sec(lat_rad)) / pi)) %/% 2
  
  list(x = x, y = y)
}

zoom_level <- 14
# 国技館らへん
xy_base <- lonlat2xy(35.697, 139.793, zoom_level)

# 上下左右も
xy <- expand.grid(x = xy_base$x + -1:1, y = xy_base$y + -1:1)

v <- purrr::pmap(xy, function(x, y) {
  url <- glue::glue("https://cyberjapandata.gsi.go.jp/xyz/experimental_bvmap/{zoom_level}/{x}/{y}.pbf")
  protolite::read_mvt_sf(url)
})

road <- purrr::map_dfr(v, "road")

ggplot(road) +
  geom_sf() +
  theme_minimal() +
  labs(caption = "地理院地図ベクトルタイルを加工して作成")

# 少し MULTILINESTRING が混じっているが少数なので無視
table(as.character(st_geometry_type(road)))
#> 
#>      LINESTRING MULTILINESTRING 
#>           33774               6

# こんな感じで角度を計算できるはず（あってる？）
m <- as.matrix(road$geometry[[1]])
atan2(m[2, 1] - m[1, 1], m[2, 2] - m[1, 2])
#> [1] 1.380848

# 実験
sfc <- st_sfc(purrr::map(2 * pi * 1:100 / 100, ~ st_linestring(rbind(c(0, 0), c(sin(.x), cos(.x))))))
d <- st_sf(geometry = sfc)
d %>% 
  mutate(
    angle = purrr::map_dbl(geometry, ~ {
      m <- as.matrix(.x)
      atan2(m[2, 1] - m[1, 1], m[2, 2] - m[1, 2]) / pi * 180
    }),
    direction = abs(angle %% 90 - 45)
  ) %>% 
  ggplot()+
  geom_sf(aes(colour = direction)) +
  theme_minimal() +
  scale_colour_viridis_c(option = "B")

# あってそうなので元の地図にも同じ計算を適用してみる
road <- road %>% 
  mutate(
    angle = purrr::map_dbl(geometry, ~ {
      m <- as.matrix(.x)
      atan2(m[2, 1] - m[1, 1], m[2, 2] - m[1, 2]) / pi * 180
    }),
    direction = abs(angle %% 90 - 45)
  )

ggplot(road) +
  geom_sf(aes(colour = direction)) +
  theme_minimal() +
  scale_colour_viridis_c(option = "B") +
  labs(caption = "地理院地図ベクトルタイルを加工して作成")

^{Created on 2020-08-15 by the reprex package (v0.3.0)}

yutannihilation/vector_tile.md

References

Code