世界を六角形で表したい
これはなんでしょう。
そう、日本ですね。正しくは日本列島を簡略化し、各都道府県を六角形 (hexagons) で表現した図です。日本列島がおさまってしまうネタ画像が出回るほどに面積の大きな北海道が他の都道府県と同じサイズで小さくなってしまっていたり、現実の都道府県の位置関係を反映していない箇所があったりしますが、パッと見て、日本だなとわかるものではないでしょうか(日本に馴染みのない国籍の人が見てもわからなそう)。
こういった六角形を使った地図はアメリカを例によく見られます。こんなのとか、こんなの。また、最近だとこうした地理空間関係を利用したグラフ表現もよく見られるようになりました。
北アメリカ大陸は形が整っていて、ずるい...。そう感じてしまいますが、まあ日本でもやってみようという気持ちでやりました。
六角形地図の作り方
まずは六角形にしたい要素、今回は都道府県、の位置関係をXとYの座標で定義します。
library(magrittr) library(tidyverse) library(ggthemes) df.jp.prefs <- tibble::frame_data( ~x, ~y, ~id, 15, 14, "HKD", 14, 12, "AOM", 15, 11, "IWT", 14, 11, "AKT", 14, 10, "MYG", 13, 10, "YGT", 14, 9, "FKS", 13, 9, "IBR", 12, 9, "NGT", 14, 8, "GNM", 13, 8, "SIT", 12, 8, "TCG", 11, 8, "TYM", 10, 8, "ISK", 14, 7, "CHB", 13, 7, "TKY", 12, 7, "YMN", 11, 7, "NGN", 10, 7, "FKI", 9, 7, "KYT", 8, 7, "HYO", 7, 7, "TTR", 6, 7, "SMN", 13, 6, "KNG", 12, 6, "SZO", 11, 6, "AIC", 10, 6, "GIF", 9, 6, "SIG", 8, 6, "OSK", 7, 6, "OKY", 6, 6, "HRS", 5, 6, "YMG", 10, 5, "MIE", 9, 5, "NAR", 9, 4, "WKY", 7, 4, "KGW", 6, 4, "EHM", 7, 3, "TKS", 6, 3, "KUC", 4, 5, "FKO", 3, 5, "SAG", 2, 5, "NGS", 3, 4, "OIT", 2, 4, "KUM", 3, 3, "MYZ", 2, 3, "KGS", 1, 1, "OKN" )
ggplot(df.jp.prefs, aes(x = x, y = y, group = id)) + geom_point() + coord_fixed(ratio = 1) + theme_map()
この段階では点ですが、なんとなく日本列島ができています。この点を六角形のポリゴンにしていきます。今回はこの作業にhexamapmakerパッケージを用いました。このパッケージはまだCRANに登録されていないので、利用する際はGitHubからインストールすることになります。
hexamapmakerの関数を使うと、簡単に六角形を作成することができます。早速やってみましょう。この結果が冒頭の図になります。
library(hexamapmaker) df.jp.prefs <- fix_shape(df.jp.prefs) df.jp.prefs.hex <- make_polygons(df.jp.prefs) (p <- ggplot(df.jp.prefs.hex, aes(x, y, group = id)) + geom_polygon(fill = "white", colour = "black", show.legend = FALSE) + coord_fixed(ratio = 1) + theme_map())
sfオブジェクトでもhex
せっかくなのでsfオブジェクトとして扱えるようにしておきましょう。
まずは六角形のポリゴンを作ります。ポリゴンはsfパッケージのst_polygon()
を使って簡単に作れます。テキストベースでもRオブジェクトから作っても良いです。
先日、id: yutannihilation
さんにpurrrlyrは(メンテされない可能性が大なので)あかん、と釘を刺されましたが、便利なのでpurrrlyrで都道府県ごとのポリゴンを作成します。sfパッケージのst_sfc()
により、geom情報を格納したsfcオブジェクトとして扱えるようにしましょう。
library(sf) make_hex <- function(d) { res <- d %>% mutate(geom = sf::st_polygon(list(rbind(c(min(d$x), min(d$y) + 0.577), c(min(d$x), min(d$y) + 0.577 + 1), c(mean(d$x), max(d$y)), c(max(d$x), min(d$y) + 0.577 + 1), c(max(d$x), min(d$y) + 0.577), c(mean(d$x), min(d$y)), c(min(d$x), min(d$y) + 0.577) )))) %>% magrittr::use_series(geom) return(res) } sfdf.jp.hex <- sf::st_sf(id = sort(df.jp.prefs$id), geometry = df.jp.prefs.hex %>% purrrlyr::slice_rows("id") %>% purrrlyr::by_slice(make_hex) %>% magrittr::use_series(.out) %>% sf::st_sfc()) sfdf.jp.hex %>% head() ## Simple feature collection with 6 features and 1 field ## geometry type: POLYGON ## dimension: XY ## bbox: xmin: 11 ymin: 5.154 xmax: 29 ymax: 19.924 ## epsg (SRID): NA ## proj4string: NA ## id geometry ## 1 AIC POLYGON ((21 8.885, 21 9.88... ## 2 AKT POLYGON ((26 16.77, 26 17.7... ## 3 AOM POLYGON ((27 18.347, 27 19.... ## 4 CHB POLYGON ((26 10.462, 26 11.... ## 5 EHM POLYGON ((11 5.731, 11 6.73... ## 6 FKI POLYGON ((18 10.462, 18 11.... # ラベル用のポリゴン重心データ sfdf.jp.hex.centroid <- sfdf.jp.hex %>% mutate(x = map_dbl(geometry, ~st_centroid(.x)[[1]]), y = map_dbl(geometry, ~st_centroid(.x)[[2]])) ggplot() + geom_sf(data = sfdf.jp.hex) + geom_text(data = sfdf.jp.hex.centroid, aes(label = id, x = x, y = y, alpha = 0.5), family = "IPAexGothic", size = 3, show.legend = FALSE)
Enjoy!