Upgrade to Pro — share decks privately, control downloads, hide ads and more …

地図を描画する / ggplot_map

Uryu Shinya
September 05, 2021

地図を描画する / ggplot_map

2021年9月5日にオンラインで開催された統計関連学会連合大会のチュートリアル「Rによるデータ解析のためのデータ可視化」(三村喬生、江口哲史、瓜生真也)の発表資料です。
コード: https://github.com/uribo/jfssa2021_datavis

Uryu Shinya

September 05, 2021
Tweet

More Decks by Uryu Shinya

Other Decks in Education

Transcript

  1. νϡʔτϦΞϧͰશൠతʹར༻͢Δύοέʔδ library(dplyr) # σʔλૢ࡞Λ༰қʹߦ͏ύοέʔδ library(ggplot2) # ՄࢹԽͷͨΊͷύοέʔδ library(sf) # ஍ཧۭؒσʔλΛѻ͏ύοέʔδ

    library(rnaturalearth) # ύϒϦοΫυϝΠϯͰར༻Մೳͳߦ੓஍ਤσʔλΛఏڙ͢Δύοέʔδ HHQMPUςʔϚͷઃఆ theme_set(theme_bw(base_family = "IPAexGothic")) ೔ຊޠϑΥϯτ ޷ΈͷϑΥϯτΛࢦఆͯ͠0,Ͱ͢ ೔ຊޠϓϩοτͷจࣈԽ͚ετϨεΛ௿ݮ͢Δ34UVEJPWͱSBHHύοέʔδΛ࢖͏ IUUQTVSJCPIBUFOBCMPHDPNFOUSZ
  2. データ: Natural Earth # Natural Earth͔Β೔ຊͷ౎ಓ෎ݝϙϦΰϯΛऔಘ ne_jpn <- ne_states(country =

    "Japan", returnclass = "sf") %>% # ࢖Θͳ͍ྻΛআ֎͠ɺඞཁͳྻ͚ͩΛબͿΑ͏ʹ͠·͢ select(iso_3166_2, gn_name) %>% tibble::new_tibble(nrow = nrow(.), class = “sf" ) class(ne_jpn) #> [1] "sf" "tbl_df" "tbl" "data.frame " glimpse(ne_jpn) #> Rows: 47 #> Columns: 3 #> $ iso_3166_2 <chr> "JP-46", "JP-44", "JP-40", "JP-41", "JP-42", "JP-43", "JP-4… #> $ gn_name <chr> "Kagoshima-ken", "Oita-ken", "Fukuoka-ken", "Saga-ken", "Na… #> $ geometry <MULTIPOLYGON [°]> MULTIPOLYGON (((129.7832 31..., MULTIPOLYGON (… ฦΓ஋ͷΫϥεΛTGʹࢦఆ ౎ಓ෎ݝϙϦΰϯΛ༻ҙ
  3. TGύοέʔδ GIS規格のsimple features(sf)をRに実装 ne_jpn #> Simple feature collection with 47

    features and 2 fields #> Geometry type: MULTIPOLYGON #> Dimension: XY #> Bounding box: xmin: 122.9382 ymin: 24.2121 xmax: 153.9856 ymax: 45.52041 #> CRS : + proj=longlat + datum=WGS84 + no_defs + ellps=WGS84 + towgs84=0,0,0 #> # A tibble: 47 × 3 #> iso_3166_2 gn_name geometry #> <chr> <chr> <MULTIPOLYGON [°]> #> 1 JP-46 Kagoshima - ken (((129.7832 31.79963, 129.7909 31.78441, 129.7986 3… #> 2 JP-44 Oita - ken (((131.2009 33.61271, 131.2199 33.60754, 131.2565 3… #> 3 JP-40 Fukuoka - ken (((130.0363 33.45759, 130.0402 33.46125, 130.0446 3… #> (লུ) #> # … with 44 more rows 地物(feature)の情報を格納する3つのクラス(sfg,sfc,sf) TG TGD DPMVNO TGH HFPNFUSZ  
  4. ಉ͡ग़ྗ݁Ռ HHQMPUHFPN@TG ggplot(ne_jpn) + geom_sf() ggplot() + geom_sf(data = ne_jpn)

    sfオブジェクトをマッピングするgeom_*() ڭՊॻͰ͸஍ਤσʔλͷඳըʹHFPN@QPMZHPO Λ࢖͍·͕ͨ͠ɺ ݱࡏ͸ͪ͜ΒʢTGܗࣜʣΛར༻͢Δͷ͕ඪ४తͰ͢ɻ
  5. ಉ͡ग़ྗ݁Ռ HHQMPUHFPN@TG ggplot() + geom_sf(data = ne_jpn, aes(fill = gn_name))

    sfオブジェクトには他の変数が紐付けられるので… ggplot(ne_jpn) + geom_sf(aes(fill = gn_name)) ggplot2の審美的要素のマッピングが容易 ౎ಓ෎ݝ͝ͱʹృΓͭͿ͠
  6. ߦ੓۠Ҭͷ஍ਤͷྫબڍ݁ՌͷϚοϐϯά データ: 第48回衆議院議員総選挙 都道府県別届出政党等別得票数(⼩選挙区) IUUQTXXXTPVNVHPKQTFOLZPTFOLZP@TEBUBTIVHJJOJOEFYIUNM glimpse(ne_jpn_shugiin48) #> Rows: 47 #>

    Columns: 8 #> $ iso_3166_2 <chr> "JP-46", "JP-44", … #> $ prefecture <chr> "ࣛࣇౡݝ", “େ෼ݝ", … #> $ gn_name <chr> "Kagoshima - ken", “Oita - ken", … #> $ party <chr> "ࣗ༝ຽओౘ", “ࣗ༝ຽओౘ", … #> $ votes <dbl> 403187.0, 279778.0, … #> $ is_ruling <lgl> TRUE, TRUE, … #> $ prop <dbl> 53.15506, 51.12192,… #> $ geometry <MULTIPOLYGON [°]> MULTIPOLYGON (((129.7832 31 . .. 各都道府県でもっとも得票率  の⾼かった党派 party prop
  7. ߦ੓۠Ҭͷ஍ਤͷྫબڍ݁ՌͷϚοϐϯά 党派を塗り分けるカラーコードを定義 party_colors <- c(`ࣗ༝ຽओౘ` = "#41A12E", `ެ໌ౘ` = "#F35A82",

    `ཱݑຽओౘ` = "#1B4787", `ر๬ͷౘ` = "#136437", `೔ຊڞ࢈ౘ` = "#D90A26", `೔ຊҡ৽ͷձ` = "#3EC021", `ࣾձຽओౘ` = "#1CA9E9", `ॾ೿` = "#D3D3D3", `ແॴଐ` = "#691D82") p <- ggplot(data = ne_jpn_shugiin48, aes(fill = party)) σʔλΛఆٛ͠ ৹ඒతཁૉΛϚοϐϯά ʢౘ೿ͰృΓ෼͚Δʣ 1 2 Step1 Step2
  8. ߦ੓۠Ҭͷ஍ਤͷྫબڍ݁ՌͷϚοϐϯά p1 <- p + geom_sf() + scale_fill_manual( values =

    party_colors, guide = guide_legend(title = "ౘ೿")) p1 ౎ಓ෎ݝ͝ͱͷୈҰౘ
  9. ߦ੓۠Ҭͷ஍ਤͷྫબڍ݁ՌͷϚοϐϯά ౎ಓ෎ݝ͝ͱͷୈҰౘ p2 <- p + # ݝڥΛ໌֬ʹ͢ΔͨΊʹଠ͞Λௐઅ͢Δ geom_sf(size =

    0.2) + # ࢖ΘΕͳ͍ຌྫΛ࡟আ͢Δ scale_fill_manual( values = party_colors[c(1, 9)], guide = guide_legend(title = "ౘ೿")) p2
  10. ஍ਤ౤Ө๏ͷม׵ # Natural Earth͔ΒશٿϙϦΰϯΛऔಘ ne_world <- ne_countries(scale = 10, returnclass

    = "sf") データ: Natural Earth x <- st_crs(ne_world) x$input #> [1] " + proj=longlat + datum=WGS84 + no_defs + ellps=WGS84 + towgs84=0,0,0" sfパッケージの関数st_crs()で座標参照系を確認 ஍ཧ࠲ඪܥΛࣔ͢
  11. ஍ਤ౤Ө๏ͷม׵ p <- ggplot(data = ne_world) + geom_sf() p 地理座標系のsfオブジェクトをマッピング

    coord_sf()でマッピング時に 変換 対象オブジェクトのCRSを事前に 1 2
  12. ஍ਤ౤Ө๏ͷม׵ coord_sf()の適⽤ 1 # ϞϧϫΠσਤ๏ʹΑΔੈք஍ਤͷඳը p + coord_sf(crs = "

    + proj=moll") sfオブジェクトの座標参照系を変更 2 # st_transform()ʹΑΔ࠲ඪࢀরܥͷมߋ ne_world_moll <- st_transform(ne_world, crs = " + proj=moll") ggplot(data = ne_world_moll) + geom_sf()
  13. ஍ਤσʔλͱख࣋ͪͷσʔλΛ݁߹͍ͨ͠ͱ͖ sfとデータ操作のためのdplyrパッケージを使って実現  QSFGFDUVSF HFPNFUSZ ๺ւಓ 10-:(0/ ʜ ੨৿ݝ 10-:(0/

    ʜ ʜ ʜ ԭೄݝ 10-:(0/ ʜ QSFGFDUVSF QPQVMBUJPO ๺ւಓ  ੨৿ݝ  ʜ ʜ ԭೄݝ  ஍ཧۭؒσʔλʢTGʣ ଐੑσʔλ EBUBGSBNF
  14. ஍ཧۭؒσʔλͱଐੑσʔλΛඥ͚ͮΔ df_shugiin48_party_votes <- readr :: read_rds(here :: here("data/shugiin48_prefecture_party_votes.rds")) glimpse(df_shugiin48_party_votes) #>

    Rows: 48 #> Columns: 31 #> $ ۠෼ <chr> "๺ւಓ", "੨৿ݝ", "ؠखݝ", "ٶ৓ݝ", "ळాݝ", "ࢁܗ… #> $ ࣗ༝ຽओౘ_உ <dbl> 1107667, 365462, 226455, 552240, 261709, 214176, 425155, 477… #> $ ࣗ༝ຽओౘ_ঁ <dbl> 82096.0, NA, 57381.0, NA, NA, 103973.1, NA, 165437.0, NA, 20… #> $ ࣗ༝ຽओౘ_ܭ <dbl> 1189763.0, 365462.0, 283836.0, 552240.0, 261709.0, 318149.1,… #> (লུ) #> $ ߹ܭ_உ <dbl> 2250452.0, 577864.0, 543060.0, 813560.0, 508327.0, 490173… #> $ ߹ܭ_ঁ <dbl> 442164.0, 19004.0, 78930.0, 188947.0, 13642.0, 103973.1, … #> $ ߹ܭ_ܭ <dbl> 2692616, 596868, 621990, 1002507, 521969, 594147, 902732,… データ: 第48回衆議院議員総選挙 都道府県別届出政党等別得票数(⼩選挙区) IUUQTXXXTPVNVHPKQTFOLZPTFOLZP@TEBUBTIVHJJOJOEFYIUNM
  15. ஍ཧۭؒσʔλͱଐੑσʔλΛඥ͚ͮΔ df_shugiin48_party_votes_mod <- df_shugiin48_party_votes %>% filter(۠෼ != "ܭ") %>% select(prefecture

    = ۠෼, ends_with("ܭ")) %>% select(!starts_with("߹ܭ")) 2つのデータを結合するための加⼯が必要 QSFGFDUVSF ࣗ༝ຽओౘ@ܭ ཱݑຽओౘ@ܭ ر๬ͷౘ@ܭ ެ໌ౘ@ܭ ೔ຊڞ࢈ౘ@ܭ ೔ຊҡ৽ͷձ@ܭ ࣾձຽओౘ@ܭ ॾ೿@ܭ ແॴଐ@ܭ ๺ւಓ       /"   ੨৿ݝ  /"  /"  /" /"  /" ؠखݝ  /"  /"  /" /" /"  ٶ৓ݝ    /"   /"   ळాݝ  /"  /"  /" /" /" /" ࢁܗݝ  /"  /"  /" /"  /" Step1 ౎ಓ෎ݝͷूܭ݁ՌͷΈʹ બ୒ͱಉ࣌ʹྻ໊Λมߋ உঁͷ߹ܭ஋Λબ୒ ౘ೿͝ͱͷूܭ݁Ռ͚ͩʹ 1 2 3
  16. ஍ཧۭؒσʔλͱଐੑσʔλΛඥ͚ͮΔ df_shugiin48_party_votes_long <- df_shugiin48_party_votes_mod %>% tidyr :: pivot_longer(cols = ends_with("ܭ"),

    names_to = "party", values_to = "votes") %>% mutate(party = stringr :: str_remove(party, "_ܭ"), is_ruling = if_else(party %in% c("ࣗ༝ຽओౘ", "ެ໌ౘ"), TRUE, FALSE)) Step2 QSFGFDUVSF QBSUZ WPUFT JT@SVMJOH ๺ւಓ ࣗ༝ຽओౘ  536& ๺ւಓ ཱݑຽओౘ  '"-4& ๺ւಓ ر๬ͷౘ  '"-4& ๺ւಓ ެ໌ౘ  536& ๺ւಓ ೔ຊڞ࢈ౘ  '"-4& ๺ւಓ ೔ຊҡ৽ͷձ  '"-4& ྻ໊ͱ஋ͷ૊Έ߹Θͤ Λͭͷྻʹ͢Δ
  17. ஍ཧۭؒσʔλͱଐੑσʔλΛඥ͚ͮΔ df_shugiin48_party_votes_tops <- df_shugiin48_party_votes_long %>% group_by(prefecture) %>% mutate(prop = votes

    / sum(votes, na.rm = TRUE) * 100) %>% top_n(n = 1, wt = prop) %>% ungroup() Step3 QSFGFDUVSF QBSUZ WPUFT JT@SVMJOH QSPQ ๺ւಓ ࣗ༝ຽओౘ  536&  ੨৿ݝ ࣗ༝ຽओౘ  536&  ؠखݝ ࣗ༝ຽओౘ  536&  ٶ৓ݝ ࣗ༝ຽओౘ  536&  ʜ ʜ ʜ ʜ ʜ ԭೄݝ ࣗ༝ຽओౘ  536&  ά ϧʔϓʢ౎ಓ෎ݝʣ͝ͱʹ ॲཧΛͯ͠৽ͨͳྻΛ௥Ճ͢Δ 各都道府県でもっとも得票率が⾼い党派の得票数
  18. ϩʔϚࣈͱ׽ࣈͷ݁߹͸ࣦഊ͢Δ ne_jpn$gn_name #> [1] "Kagoshima - ken" "Oita - ken"

    … df_shugiin48_party_votes_tops$prefecture #> [1] "๺ւಓ" "੨৿ݝ" … データフレーム間の結合処理では、共通の値が記録された列が必要 QSFGFDUVSF HFPNFUSZ )PLLBJEP 10-:(0/ ʜ "PNPSJLFO 10-:(0/ ʜ ʜ ʜ 0LJOBXBLFO 10-:(0/ ʜ QSFGFDUVSF QPQVMBUJPO ๺ւಓ  ੨৿ݝ  ʜ ʜ ԭೄݝ 
  19. ׽ࣈͱ׽ࣈͷ݁߹Λߦ͑ΔΑ͏ʹ͢Δ # zipanguύοέʔδ͔ΒσʔληοτΛར༻͢Δ jpnprefs <- zipangu :: jpnprefs %>% select(prefecture_kanji,

    gn_name = prefecture) ne_jpn_kanji <- ne_jpn %>% mutate(gn_name = recode(gn_name, # ϩʔϚࣈදهͷنଇΛଞݝͱ߹ΘͤΔ `Miyagi Ken` = "Miyagi - ken")) %>% inner_join(jpnprefs, by = "gn_name") %>% select(iso_3166_2, prefecture = prefecture_kanji, gn_name) Step4
  20. ஍ཧۭؒσʔλͱଐੑσʔλΛඥ͚ͮΔ ne_jpn_shugiin48 < - ne_jpn_kanji %>% left_join(df_shugiin48_party_votes_tops, by = "prefecture")

    %>% relocate(geometry, .after = last_col()) Step5 sfオブジェクトに対してdata.frameの列を追加する બڍ݁ՌͷϚοϐϯάͰ ར༻ͨ͠σʔλ
  21. ूܭ୯ҐΛมߋ͍ͨ͠ 地図データの⽅も合わせて集約したい ஍ํ ݝ ˠ  QSFGFDUVSF QPQVMBUJPO ๺ւಓ 

    ੨৿ݝ  ʜ ʜ ԭೄݝ  QSFGFDUVSF QPQVMBUJPO ๺ւಓ  ౦๺  ʜ ʜ ԭೄɾ۝भ  ݝ୯Ґͷूܭ ஍ํ୯ҐͰͷूܭ
  22. TGͷHFPNFUSZʹର͢ΔEQMZSͷؔ਺ͷద༻ group_by()とsummarise()でポリゴンの集約が⾏われる ne_jpn_region <- ne_jpn_kanji %>% left_join(zipangu :: jpnprefs %>%

    select(prefecture = prefecture_kanji, region), by = "prefecture") %>% group_by(region) %>% summarise(.groups = "drop") ౎ಓ෎ݝ͔Β஍ํ΁ͷू໿ ʢಘථ਺ͱϙϦΰϯσʔλʣ
  23. UBCVMBSNBQύοέʔδ library(tabularmaps) jpn77 %>% select(jis_code, prefecture = prefecture_kanji, x, y)

    %>% left_join(df_shugiin48_party_votes_tops, by = "prefecture") %>% tabularmap(x = x, y = y, group = jis_code, label = prefecture, fill = prop, size = 2, family = "IPAexGothic") + scale_fill_viridis_b() + theme_tabularmap(base_family = "IPAexGothic")