データ可視化系。
コレの2番煎じ。 Rで東京版に挑戦。 簡単に統計データがみつかった東京都の昼夜人工の過去実測データと将来予測データから、昼夜人口の3Dロリポップを経年で表示する可視化。
結果はコレ。
library(tidyverse)## ── Attaching packages ───── tidyverse 1.2.1 ──## ✔ ggplot2 2.2.1.9000 ✔ purrr 0.2.4
## ✔ tibble 1.4.2 ✔ dplyr 0.7.5
## ✔ tidyr 0.8.1 ✔ stringr 1.3.1
## ✔ readr 1.1.1 ✔ forcats 0.3.0## ── Conflicts ──────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()knitr::opts_chunk$set(echo = T, warning = F, message = F, results = "hold")tl;dr
人口データの下準備
library(readxl)
messy_data <-
dir("../../data/tokyo_population/", pattern = ".xls", full.names = T) %>%
map(read_xls)
messy_data %>%
map(head)## [[1]]
## # A tibble: 6 x 11
## `第１表 区市町村別昼間人口… X__1 X__2 X__3 X__4 X__5 X__6 X__7 X__8 X__9
## <chr> <chr> <chr> <chr> <lgl> <chr> <chr> <chr> <chr> <chr>
## 1 <NA> <NA> <NA> <NA> NA <NA> <NA> <NA> <NA> <NA>
## 2 区市町村 <NA> <NA> <NA> NA 平成22年… 平成27… 平成32… 平成37… 平成42…
## 3 <NA> <NA> <NA> <NA> NA （2010… （201… （202… （202… （203…
## 4 <NA> <NA> <NA> <NA> NA <NA> <NA> <NA> <NA> <NA>
## 5 東京都 <NA> <NA> <NA> NA 15576… 1573… 1573… 1560… 1537…
## 6 <NA> 区部 <NA> <NA> NA 11711… 1183… 1186… 1178… 1164…
## # ... with 1 more variable: X__10 <chr>
##
## [[2]]
## # A tibble: 6 x 11
## `第２表 区市町村別昼夜間人… X__1 X__2 X__3 X__4 X__5 X__6 X__7 X__8 X__9
## <chr> <chr> <chr> <chr> <lgl> <chr> <chr> <chr> <chr> <chr>
## 1 <NA> <NA> <NA> <NA> NA <NA> <NA> <NA> <NA> <NA>
## 2 区市町村 <NA> <NA> <NA> NA 平成22年… 平成27… 平成32… 平成37… 平成42…
## 3 <NA> <NA> <NA> <NA> NA （2010… （201… （202… （202… （203…
## 4 <NA> <NA> <NA> <NA> NA <NA> <NA> <NA> <NA> <NA>
## 5 東京都 <NA> <NA> <NA> NA 118.4… 117.… 117.2 116.… 116.…
## 6 <NA> 区部 <NA> <NA> NA 130.9… 129.… 128.… 128 127.8
## # ... with 1 more variable: X__10 <chr>
##
## [[3]]
## # A tibble: 6 x 15
## X__1 X__2 X__3 `付表 第１表 区市町村別昼間人口（昭和… X__4 X__5 X__6 X__7 X__8
## <chr> <chr> <lgl> <chr> <chr> <chr> <chr> <chr> <chr>
## 1 <NA> <NA> NA <NA> <NA> <NA> <NA> <NA> （単位 …
## 2 <NA> 地 域… NA 昭和30年 昭和35年… 昭和40… 昭和45… 昭和50… 昭和55…
## 3 <NA> <NA> NA (1955) (1960) (196… (197… (197… (198…
## 4 東京都 <NA> NA 8291012 10199… 1175… 1266… 1335… 1349…
## 5 区部 <NA> NA 7323010 89709… 1003… 1044… 1072… 1061…
## 6 <NA> 千代田区… NA 494673 645377 7718… 8549… 9344… 9365…
## # ... with 6 more variables: `付表 第１表
## # 区市町村別昼間人口（昭和30年～平成22年）（続）` <chr>, X__9 <chr>,
## # X__10 <chr>, X__11 <chr>, X__12 <chr>, X__13 <chr>
##
## [[4]]
## # A tibble: 6 x 17
## X__1 X__2 X__3 X__4 X__5 `付表 第２表 区市町村別常住（夜… X__6 X__7 X__8 X__9
## <chr> <chr> <chr> <chr> <lgl> <chr> <chr> <chr> <chr> <chr>
## 1 <NA> <NA> <NA> <NA> NA <NA> <NA> <NA> <NA> <NA>
## 2 <NA> <NA> <NA> <NA> NA <NA> <NA> <NA> <NA> <NA>
## 3 <NA> <NA> <NA> <NA> NA <NA> <NA> <NA> <NA> <NA>
## 4 <NA> <NA> 地域 <NA> NA 昭和30年 昭和35… 昭和40… 昭和45… 昭和50…
## 5 <NA> <NA> <NA> <NA> NA (1955) (196… (196… (197… (197…
## 6 <NA> <NA> <NA> <NA> NA <NA> <NA> <NA> <NA> <NA>
## # ... with 7 more variables: X__10 <chr>, `付表 第２表
## # 区市町村別常住（夜間）人口（昭和30年～平成22年）（続）` <chr>,
## # X__11 <chr>, X__12 <chr>, X__13 <chr>, X__14 <chr>, X__15 <chr>まだましな方ではあるが、いわゆる神エクセル。 2010以降は、夜間人口データはなくなり、代わりに‘夜間人口100人あたりの昼間人口数’という謎の指標が追加されている。 {janitor}など駆使すればtidyな整形はできるが、今回はぽちぽちフォーマットしてcsv化して保存 (csvデータ)。 図示しづらいので島嶼部は省略。
tidy_data <-
dir("../../data/tokyo_population/", pattern = ".csv", full.names = T) %>%
map(read_csv)
tidy_long <-
tidy_data %>%
map(gather, year, pop, -region) %>%
map(mutate, year = parse_number(year))
pop_2010_2035 <-
full_join(tidy_long[[1]], tidy_long[[2]],
by = c("region", "year"), suffix = c("_day", "_dayx100_night")) %>%
transmute(region, year, day =pop_day,
night = day / pop_dayx100_night *100)
pop_1955_2010 <-
full_join(tidy_long[[3]], tidy_long[[4]],
by = c("region", "year"), suffix = c("_day", "_night")) %>%
rename(day = pop_day, night = pop_night) %>%
filter(year != 2010) # 2010年は重複するので削除
population_data <-
bind_rows(pop_1955_2010, pop_2010_2035) %>%
gather(day_night, pop, -year, -region)
head(population_data)
population_data %>%
ggplot(aes(x = year, y = pop, group = region, color = region)) +
geom_point() +
geom_line() +
facet_grid(day_night ~ .) +
guides(color = F)
## # A tibble: 6 x 4
## region year day_night pop
## <chr> <dbl> <chr> <dbl>
## 1 千代田区 1955. day 494673.
## 2 中央区 1955. day 448510.
## 3 港区 1955. day 380542.
## 4 新宿区 1955. day 377346.
## 5 文京区 1955. day 266682.
## 6 台東区 1955. day 358604.次に地図とマージするために、緯度経度情報を足していく。 {ggmap}で地名から緯度経度を取得し、昼夜人口データとjoinする。
library(ggmap)
region_geo <-
population_data$region %>%
unique %>%
tibble(region = ., lat = NA, lng = NA)
# 連続取得するとしばしばNAを返すので、ループでゴリ押し
fill_na <-
function(.tbl){
if(is.na(.tbl$lat)){
geo <- geocode(.tbl$region)
mutate(.tbl, lat = geo$lat, lng = geo$lon)
} else {
.tbl
}
}
for(i in 1:500){
region_geo <-
region_geo %>%
split(.$region) %>%
map_df(fill_na)
if(sum(is.na(region_geo$lat)) == 0) break
}
head(region_geo)
# 人口データと座標データをマージして、図示用に昼夜で軽度を少しだけずらす
pop_geo_data <-
left_join(population_data, region_geo, by = "region") %>%
split(.$day_night) %>%
map2_df(.x = ., .y = c(-.01, +0.01), ~ mutate(.x, lng = lng + .y))## # A tibble: 6 x 3
## region lat lng
## <chr> <dbl> <dbl>
## 1 あきる野市 35.7 139.
## 2 三鷹市 35.7 140.
## 3 世田谷区 35.6 140.
## 4 中央区 35.7 140.
## 5 中野区 35.7 140.
## 6 八王子市 35.7 139.{plotly}で3次元散布図を作成。
library(plotly)
fig_scat <-
plot_ly(x = ~ lng, y = ~ lat, z = ~ pop, color = ~ day_night, frame = ~ year) %>%
add_markers(data = pop_geo_data, type = "scatter3d", marker = list(size = 3, opacity = .5),
text = ~paste("City: ", region, '<br>Population:', pop), hoverinfo = "text")ロリポップチャート (イメージ検索) 化するべく、各ポイントからz = 0までの足を作成。 このページを流用。
for_droplines <-
list(pop_geo_data, pop_geo_data) %>%
map2_df(.x = ., .y = c(1, 0), ~ mutate(.x, pop = pop * .y)) %>%
group2NA(groupNames = c("year", "region", "day_night", "lat", "lng"))
fig_lollipop <-
fig_scat %>%
add_paths(data = for_droplines, x = ~ lng, y = ~lat, z = ~ pop, showlegend = FALSE, hoverinfo = "none")地図データの下準備
3次元ロリポップをマッピングする地図データを作る。 昨今の流れとして、R x GISだと日本のデータ取得は{kokudosuuchi}または{jpndistrict}、解析は{sf}がよさそう。 今回はこのページを参考に、{jpndistrict}を使用した。 最新版の{ggplot2}はsfに対応したので、2Dだと簡単に描画できる。
library(jpndistrict)
library(sf)
sf_tokyo <-
jpn_pref(pref_code = 13, district = TRUE) %>%
st_simplify(dTolerance = 0.001)
sf_tokyo %>%
ggplot() +
geom_sf(fill = "white", z = 0, aes(type = "point")) +
geom_point(data = region_geo, aes(x = lng, y = lat)) +
xlim(138.85, 140) + ylim(35.4, 36)
ただ、geom_sf()だと、z軸方向へのプロットができなさそうなので、sfデータから座標を取り出して、z=0の面にプロットしていく。
## sf_tokyo$geometryに座標データが入っている
## sf_tokyo$geometryの1層目の要素の構成異なる
## (島などの閉じた区画ごとに分けられた子座標データが区の下にネスト) ので、
## map用に場合わけで対処する関数を作成
sf_mapping <-
function(.lst){
if(length(.lst) == 1){
as_tibble(.lst[[1]]) %>%
bind_rows(., head(., 1)) %>% # pathを閉じるために最初の座標を足す (なくてもあまり変わらなかった)
list
} else {
.lst %>%
flatten %>%
map( ~ as_tibble(.) %>%
bind_rows(., head(., 1)))
}
}
sf_data <-
map(sf_tokyo$geometry, sf_mapping) %>%
flatten
add_sf <-
function(p, i){
df <-
tidyr::crossing(sf_data[[i]], year = pop_geo_data$year)
if(names(df) != c("V1", "V2", "year")){
return(p)
} else {
add_paths(p, data = df, x = ~ V1, y = ~V2, z = 0, color = "", frame = ~ year,
line = list(color = "white"), showlegend = F, hoverinfo = "none")
}
}
fig_lollipop_on_map <- fig_lollipop
for(i in seq_along(sf_data)){
fig_lollipop_on_map <-
fig_lollipop_on_map %>% add_sf(i)
}一通り完成。
グラフの微調整
layout(scene = …)で見た目をいじって、冒頭のhtmlwidjetが完成。
- 軸の設定 (axis)
- 初期視点の調整 (camera)
- eyeは視点がある場所 (default (1.25, 1.25, 1.25))
- z = 0だと真横から、z = Infだと真上から
- normが小さいと寄り、大きいと引き
- centerは表示の中心 (default (0, 0, 0))
- z = -.2だと、全体が少し持ち上がるイメージ
axis_set <- list(zeroline = F, showline = F, showticklabels = F, title = "")
scene <-
list(
xaxis = c(axis_set, range = list(c(138.85, 140))),
yaxis = c(axis_set, range = list(c(35.3, 36))),
zaxis = c(axis_set, backgroundcolor="rgb(100, 100, 100)", showbackground = T, range = list(c(0, 1200000))),
camera = list(center=list(x = 0, y = 0, z = -.2),
eye=list(x = -.1, y = -1.25, z = .3))
)
fig_lollipop_on_map_final <-
fig_lollipop_on_map %>%
layout(scene = scene)
setwd("../plotly")
htmlwidgets::saveWidget(fig_lollipop_on_map_final, "lollipop_on_map.html", selfcontained = T)
setwd("../post")参考ページ
時間によって激変するマンハッタンの人口を表す、インタラクティブな3Dグラフ | GIZMODO
東京都昼間人口の予測 | 東京都の統計
Droplines from points in 3D scatterplot? | plotly community
yutannihilation/kokudosuuchi | github
uribo/jpndistrict | github
r-spatial/sf | github
中級者向けggplot2でこんな図が描きたい - 地図編 | cucumber flesh
Axes in R | plotly
Keeping a consistent perspective for 3D plots | plotly community
Session info
devtools::session_info()## setting value
## version R version 3.5.0 (2018-04-23)
## system x86_64, darwin15.6.0
## ui X11
## language (EN)
## collate en_US.UTF-8
## tz Australia/Brisbane
## date 2018-06-01
##
## package * version date source
## assertthat 0.2.0 2017-04-11 CRAN (R 3.5.0)
## backports 1.1.2 2017-12-13 CRAN (R 3.5.0)
## base * 3.5.0 2018-04-24 local
## bindr 0.1.1 2018-03-13 CRAN (R 3.5.0)
## bindrcpp * 0.2.2 2018-03-29 CRAN (R 3.5.0)
## blogdown 0.6 2018-04-18 CRAN (R 3.5.0)
## bookdown 0.7 2018-02-18 CRAN (R 3.5.0)
## broom 0.4.4 2018-05-24 Github (tidyverse/broom@570b25a)
## cellranger 1.1.0 2016-07-27 CRAN (R 3.5.0)
## class 7.3-14 2015-08-30 CRAN (R 3.5.0)
## classInt 0.2-3 2018-04-16 CRAN (R 3.5.0)
## cli 1.0.0 2017-11-05 CRAN (R 3.5.0)
## colorspace 1.3-2 2016-12-14 CRAN (R 3.5.0)
## compiler 3.5.0 2018-04-24 local
## crayon 1.3.4 2017-09-16 CRAN (R 3.5.0)
## crosstalk 1.0.0 2016-12-21 CRAN (R 3.5.0)
## data.table 1.10.4-3 2017-10-27 CRAN (R 3.5.0)
## datasets * 3.5.0 2018-04-24 local
## DBI 0.8 2018-03-02 CRAN (R 3.5.0)
## devtools 1.13.5 2018-02-18 CRAN (R 3.5.0)
## digest 0.6.15 2018-01-28 CRAN (R 3.5.0)
## dplyr * 0.7.5 2018-05-19 cran (@0.7.5)
## e1071 1.6-8 2017-02-02 CRAN (R 3.5.0)
## evaluate 0.10.1 2017-06-24 CRAN (R 3.5.0)
## forcats * 0.3.0 2018-02-19 CRAN (R 3.5.0)
## foreign 0.8-70 2017-11-28 CRAN (R 3.5.0)
## geosphere 1.5-7 2017-11-05 CRAN (R 3.5.0)
## ggmap * 2.6.1 2016-01-23 CRAN (R 3.5.0)
## ggplot2 * 2.2.1.9000 2018-05-22 Github (tidyverse/ggplot2@eecc450)
## glue 1.2.0 2017-10-29 CRAN (R 3.5.0)
## graphics * 3.5.0 2018-04-24 local
## grDevices * 3.5.0 2018-04-24 local
## grid 3.5.0 2018-04-24 local
## gtable 0.2.0 2016-02-26 CRAN (R 3.5.0)
## haven 1.1.1 2018-01-18 CRAN (R 3.5.0)
## hms 0.4.2 2018-03-10 CRAN (R 3.5.0)
## htmltools 0.3.6 2017-04-28 CRAN (R 3.5.0)
## htmlwidgets 1.2 2018-04-19 CRAN (R 3.5.0)
## httpuv 1.4.3 2018-05-10 cran (@1.4.3)
## httr 1.3.1 2017-08-20 CRAN (R 3.5.0)
## jpeg 0.1-8 2014-01-23 CRAN (R 3.5.0)
## jpmesh * 1.1.0 2018-02-25 CRAN (R 3.5.0)
## jpndistrict * 0.3.1 2018-05-02 CRAN (R 3.5.0)
## jsonlite 1.5 2017-06-01 CRAN (R 3.5.0)
## knitr 1.20 2018-02-20 CRAN (R 3.5.0)
## labeling 0.3 2014-08-23 CRAN (R 3.5.0)
## later 0.7.2 2018-05-01 cran (@0.7.2)
## lattice 0.20-35 2017-03-25 CRAN (R 3.5.0)
## lazyeval 0.2.1 2017-10-29 CRAN (R 3.5.0)
## leaflet 2.0.0 2018-04-20 CRAN (R 3.5.0)
## lubridate 1.7.4 2018-04-11 CRAN (R 3.5.0)
## magrittr 1.5 2014-11-22 CRAN (R 3.5.0)
## mapproj 1.2.6 2018-03-29 CRAN (R 3.5.0)
## maps 3.3.0 2018-04-03 CRAN (R 3.5.0)
## memoise 1.1.0 2017-04-21 CRAN (R 3.5.0)
## methods * 3.5.0 2018-04-24 local
## mime 0.5 2016-07-07 CRAN (R 3.5.0)
## miniUI 0.1.1 2016-01-15 CRAN (R 3.5.0)
## mnormt 1.5-5 2016-10-15 CRAN (R 3.5.0)
## modelr 0.1.1 2017-07-24 CRAN (R 3.5.0)
## munsell 0.4.3 2016-02-13 CRAN (R 3.5.0)
## nlme 3.1-137 2018-04-07 CRAN (R 3.5.0)
## parallel 3.5.0 2018-04-24 local
## pillar 1.2.1 2018-02-27 CRAN (R 3.5.0)
## pkgconfig 2.0.1 2017-03-21 CRAN (R 3.5.0)
## plotly * 4.7.1 2017-07-29 CRAN (R 3.5.0)
## plyr 1.8.4 2016-06-08 CRAN (R 3.5.0)
## png 0.1-7 2013-12-03 CRAN (R 3.5.0)
## promises 1.0.1 2018-04-13 CRAN (R 3.5.0)
## proto 1.0.0 2016-10-29 CRAN (R 3.5.0)
## psych 1.8.4 2018-05-06 cran (@1.8.4)
## purrr * 0.2.4 2017-10-18 CRAN (R 3.5.0)
## R6 2.2.2 2017-06-17 CRAN (R 3.5.0)
## RColorBrewer 1.1-2 2014-12-07 CRAN (R 3.5.0)
## Rcpp 0.12.17 2018-05-18 cran (@0.12.17)
## readr * 1.1.1 2017-05-16 CRAN (R 3.5.0)
## readxl * 1.1.0 2018-04-20 CRAN (R 3.5.0)
## reshape2 1.4.3 2017-12-11 CRAN (R 3.5.0)
## RgoogleMaps 1.4.1 2016-09-18 CRAN (R 3.5.0)
## rjson 0.2.18 2018-05-05 CRAN (R 3.5.0)
## rlang 0.2.0 2018-02-20 CRAN (R 3.5.0)
## rmarkdown 1.9 2018-03-01 CRAN (R 3.5.0)
## rprojroot 1.3-2 2018-01-03 CRAN (R 3.5.0)
## rstudioapi 0.7 2017-09-07 CRAN (R 3.5.0)
## rvest 0.3.2 2016-06-17 CRAN (R 3.5.0)
## scales 0.5.0 2017-08-24 CRAN (R 3.5.0)
## sf * 0.6-3 2018-05-17 CRAN (R 3.5.0)
## shiny 1.1.0 2018-05-17 cran (@1.1.0)
## sp 1.2-7 2018-01-19 CRAN (R 3.5.0)
## spData 0.2.8.3 2018-03-25 CRAN (R 3.5.0)
## stats * 3.5.0 2018-04-24 local
## stringi 1.2.2 2018-05-02 cran (@1.2.2)
## stringr * 1.3.1 2018-05-10 cran (@1.3.1)
## tibble * 1.4.2 2018-01-22 CRAN (R 3.5.0)
## tidyr * 0.8.1 2018-05-18 cran (@0.8.1)
## tidyselect 0.2.4 2018-02-26 CRAN (R 3.5.0)
## tidyverse * 1.2.1 2017-11-14 CRAN (R 3.5.0)
## tools 3.5.0 2018-04-24 local
## udunits2 0.13 2016-11-17 CRAN (R 3.5.0)
## units 0.5-1 2018-01-08 CRAN (R 3.5.0)
## utf8 1.1.3 2018-01-03 CRAN (R 3.5.0)
## utils * 3.5.0 2018-04-24 local
## viridisLite 0.3.0 2018-02-01 CRAN (R 3.5.0)
## withr 2.1.2 2018-03-15 CRAN (R 3.5.0)
## xfun 0.1 2018-01-22 CRAN (R 3.5.0)
## xml2 1.2.0 2018-01-24 CRAN (R 3.5.0)
## xtable 1.8-2 2016-02-05 CRAN (R 3.5.0)
## yaml 2.1.18 2018-03-08 CRAN (R 3.5.0)