【TeachingDemos】誕生日なので大豆について考えてみた(2)
n+1歳したよポエムは後に回すとして、
世は節分なので大豆について考える。パート2。
準備
シェープファイルはNipponパッケージのフォルダに含まれているやつを借りる。
CRSクラス作成では投影法を地球座標系、準拠楕円体をWGS84に指定した。
>map <- system.file("shapes/jpn.shp", package = "Nippon")[1] %>% maptools::readShapePoly(., proj4string = CRS("+proj=longlat +datum=WGS84")) > map@data SP_ID jiscode name population region 0 1 01 Hokkaido 5506419 Hokkaido 1 2 02 Aomori 1373339 Tohoku 2 3 03 Iwate 1330147 Tohoku 3 4 04 Miyagi 2348165 Tohoku 4 5 05 Akita 1085997 Tohoku 5 6 06 Yamagata 1168924 Tohoku 6 7 07 Fukushima 2029064 Tohoku 7 8 08 Ibaraki 2969770 Kanto 8 9 09 Tochigi 2007683 Kanto 9 10 10 Gunma 2008068 Kanto 10 11 11 Saitama 7194556 Kanto 11 12 12 Chiba 6216289 Kanto 12 13 13 Tokyo 13159388 Kanto 13 14 14 Kanagawa 9048331 Kanto 14 15 15 Niigata 2374450 Chubu 15 16 16 Toyama 1093247 Chubu 16 17 17 Ishikawa 1169788 Chubu 17 18 18 Fukui 806314 Chubu 18 19 19 Yamanashi 863075 Chubu 19 20 20 Nagano 2152449 Chubu 20 21 21 Gifu 2080773 Chubu 21 22 22 Shizuoka 3765007 Chubu 22 23 23 Aichi 7410719 Chubu 23 24 24 Mie 1854724 Chubu 24 25 25 Shiga 1410777 Kinki 25 26 26 Kyoto 2636092 Kinki 26 27 27 Osaka 8865245 Kinki 27 28 28 Hyogo 5588133 Kinki 28 29 29 Nara 1400728 Kinki 29 30 30 Wakayama 1002198 Kinki 30 31 31 Tottori 588667 Chugoku 31 32 32 Shimane 717397 Chugoku 32 33 33 Okayama 1945276 Chugoku 33 34 34 Hiroshima 2860750 Chugoku 34 35 35 Yamaguchi 1451338 Chugoku 35 36 36 Tokushima 785491 Shikoku 36 37 37 Kagawa 995842 Shikoku 37 38 38 Ehime 1431493 Shikoku 38 39 39 Kochi 764456 Shikoku 39 40 40 Fukuoka 5071968 Kyushu / Okinawa 40 41 41 Saga 849788 Kyushu / Okinawa 41 42 42 Nagasaki 1426779 Kyushu / Okinawa 42 43 43 Kumamoto 1817426 Kyushu / Okinawa 43 44 44 Oita 1196529 Kyushu / Okinawa 44 45 45 Miyazaki 1135233 Kyushu / Okinawa 45 46 46 Kagoshima 1706242 Kyushu / Okinawa 46 47 47 Okinawa 1392818 Kyushu / Okinawa
data部抜くとこんな感じ。
ちなみに人口も地域も入っているので相当便利。
で、
このデータ部の行番号の順を動かさずに、大豆のデータをくっつけたいので、
nameをキーにしてJOINすればいいかなーという方針を立てる。
各種大豆データを
PDF→CSVして、都道府県名をローマ字にするなどすると
>mame_sub<-read.csv("0203mame.csv",header = TRUE) >knitr::kable(mame_sub) |name | natto| tofu| mame_t| |:---------|-----:|----:|------:| |Hokkaido | 3847| 4362| 73600| |Aomori | 4807| 5140| 5370| |Iwate | 4654| 6945| 5470| |Miyagi | 5485| 6264| 19300| |Akita | 4477| 5123| 9640| |Yamagata | 5569| 5906| 7720| |Fukushima | 5298| 5254| 2220| |Ibaraki | 5916| 4839| 5410| |Tochigi | 3962| 5111| 4250| |Gunma | 4808| 5226| 444| |Saitama | 4406| 6328| 786| |Chiba | 4064| 6151| 1080| |Tokyo | 3618| 5969| 4| |Kanagawa | 3418| 5820| 64| |Niigata | 4586| 5070| 8840| |Toyama | 4329| 4927| 7630| |Ishikawa | 3505| 5176| 2310| |Fukui | 3238| 4815| 2430| |Yamanashi | 4501| 5274| 289| |Nagano | 4157| 4510| 3380| |Gifu | 3160| 5078| 3430| |Shizuoka | 3735| 6057| 317| |Aichi | 3348| 5350| 7180| |Mie | 2429| 5307| 3750| |Shiga | 2912| 5059| 9450| |Kyoto | 2680| 5982| 455| |Osaka | 1945| 5470| 20| |Hyogo | 2289| 5709| 3320| |Nara | 2421| 5408| 256| |Wakayama | 1994| 4864| 43| |Tottori | 2658| 6728| 1120| |Shimane | 2605| 6213| 1320| |Okayama | 2428| 4534| 2370| |Hiroshima | 2592| 5258| 667| |Yamaguchi | 2744| 4971| 1020| |Tokushima | 2306| 6763| 45| |Kagawa | 2528| 5425| 97| |Ehime | 2628| 6170| 457| |Kochi | 2017| 6009| 61| |Fukuoka | 3125| 4563| 14300| |Saga | 3317| 6053| 15300| |Nagasaki | 2672| 4824| 496| |Kumamoto | 3861| 5417| 3710| |Oita | 3604| 6288| 1690| |Miyazaki | 2937| 5239| 317| |Kagoshima | 3513| 5471| 301| |Okinawa | 2389| 7478| 1| #natto<-納豆購入額 #tofu<-豆腐購入額 #mame_t<-大豆収穫量(t)
あとはJOINして準備するだけ。
#JOINしたものをデータ部に置き換え map@data<- dplyr::left_join(map@data,mame_sub,"name") #各都道府県の代表点抽出 >map.c<-coordinates(map) %>% as.data.frame(.) >knitr::kable(map.c) | | V1| V2| |:--|--------:|--------:| |0 | 142.5637| 43.37322| |1 | 140.8369| 40.78999| |2 | 141.3672| 39.59491| |3 | 140.9347| 38.45849| |4 | 140.4040| 39.75225| |5 | 140.1059| 38.44662| |6 | 140.2207| 37.38554| |7 | 140.3268| 36.33433| |8 | 139.8238| 36.68965| |9 | 138.9818| 36.51044| |10 | 139.3504| 35.99388| |11 | 140.2134| 35.53588| |12 | 139.4481| 35.69395| |13 | 139.3502| 35.40736| |14 | 138.9373| 37.46545| |15 | 137.2517| 36.63167| |16 | 136.7571| 36.73964| |17 | 136.2342| 35.83485| |18 | 138.6130| 35.61755| |19 | 138.0369| 36.12952| |20 | 137.0573| 35.78676| |21 | 138.3440| 35.00518| |22 | 137.2163| 35.04840| |23 | 136.3712| 34.54634| |24 | 136.1268| 35.22382| |25 | 135.4460| 35.24641| |26 | 135.5121| 34.62303| |27 | 134.8311| 35.08439| |28 | 135.8637| 34.31070| |29 | 135.5186| 33.90602| |30 | 133.8624| 35.36655| |31 | 132.4981| 35.00385| |32 | 133.8122| 34.89499| |33 | 132.7951| 34.63696| |34 | 131.5512| 34.20905| |35 | 134.2566| 33.91387| |36 | 133.9805| 34.20724| |37 | 132.8611| 33.60891| |38 | 133.3812| 33.41964| |39 | 130.6720| 33.53417| |40 | 130.1211| 33.28651| |41 | 129.9260| 32.95754| |42 | 130.8424| 32.64685| |43 | 131.4390| 33.18740| |44 | 131.2934| 32.18176| |45 | 130.6119| 31.62818| |46 | 127.9566| 26.48630| cols<-c("#E06A3B","#FBE481") #色スタンバイ
抽出した代表点に、各サブプロットを置いていくイメージです。
棒グラフで豆腐と納豆を比較する
分かりそうなことは、
豆腐と納豆の購入額を純粋に比較して、地域差がどう出るか、みたいなとこでしょうか。
ただの差の比較にしかならないけど。
#元となるplot plot(map,col=gray(0.8)) #サブプロット用データと、Y軸の最大値決めるためのMax値 >map.d<-cbind(map@data$natto,map@data$tofu) >map.m<-max(map.d) #各ポリゴンの代表点の位置にsubplotをする for(i in 1:nrow(map.c)){ subplot(barplot(map.d[i,],ylim=c(0,map.m),col=cols, names=c("",""),yaxt="n"),x=map.c[i,1], y=map.c[i,2],size=c(0.1,0.5),vadj=0) } locator(2) legend(139,29,c("納豆","豆腐"),fill=cols,cex=0.8)
(forで回しちゃったけどいいやり方あるかしら...)
Y軸を共通にしているので一応単純比較出来るはず。
これが結構おもしろい。
圧倒的西日本の豆腐消費がまず目につく。
が、
圧倒的納豆消費の少なさも目に付く。
東日本は豆腐消費はほどほど、
納豆もほどほど、といった感じ。
これはそれぞれコロプレス図みたいにしてもパキっと分かれて綺麗そう。
特に納豆。納豆。
近畿・中国・四国は特に少ないけどたまたまかなあ、
経年でデータ持ってきてみれば良かった。失敗。
円グラフもしてみる
円グラフもかいてみた
plot(map,col=gray(0.8)) for(i in 1:nrow(map.c)){ subplot(pie(cbind(map@data$natto[i],map@data$tofu[i]),col=cols,labels=c("","")), x=map.c[i,1],y=map.c[i,2],size=c(0.3,0.3),vadj=0) } legend(139,29,c("納豆","豆腐"),fill=cols,cex=0.8)
なんか凡例がうまく表示されない。はて。
円でも黄色比重が高まっているエリアを見つけられる。
このデータの作りだとあまり円にする意味は無かったかな...
円の大きさを大豆の収穫量で変化するようにしてみた
第3の要素として、ここに各都道府県の大豆の収穫量をちゃっかり入れて、
円グラフの半径として使う。
大豆収穫量の多いところと消費の関連とか掴めたらおもしろいなーと思ったんだけど...
#サイズ変える r<-sqrt(map@data$mame_t/pi) #円の大きさは大豆収穫量/パイの二乗根 r<-r/max(r)*0.4 plot(map,col=gray(0.8)) for(i in 1:nrow(map.c)){ subplot(pie(cbind(map@data$natto[i],map@data$tofu[i]),col=cols,labels=c("","")), x=map.c[i,1],y=map.c[i,2],size=c(r[i],r[i]),vadj=0) } legend(139,29,c("納豆","豆腐"),fill=cols,bty="n",cex=0.8)
...世の中そううまくはいかなかった。
作りなよ。みんなもっと大豆作りなよ。ってくらいの収穫量してた。
何も見えやしない。
豆の話(2)はおしまい
後味は悪いが今回はここまで。
まだ大豆データがあるから何か閃いたら(3)としてやろうかな
誕生日
あんまりめでたくないけどせっかく年が一つ増えて最初なので
なんか振り返りながらつらつらと書いてみる。
振り返る
・卒業:卒論を提出後完全にスイッチが切れて日本各地をぷらぷら
大阪→京都 →秋田→(どこに居たか覚えてない10日)→
気付いたら埼玉の某所で寿司食べてた
・仕事:こんなポンコツ根暗でも上司に恵まれてなんとか仕事が出来ている。
頭が上がらない。
・趣味:卒業したらRを触る「理由」みたいなものが無くなってしまったので、
趣味と開き直ってブログを始めたり、
各所のRコミュニティーに勇気を振り絞って出たりした。
塩を撒かれて追い返されるんだと思ってたのに、
気が付いたらR繋がりで知り合いの方が増えてきて。
Rについてはもっとわかるようになりたい。
何をもってわかるとするのか、みたいのはあるけど。
わかりたい、とは思う。し、
そろそろ逃げない分析をやらなきゃなあ、とも思う。IRとかIRとか。
100万円貯まったら次の街へ行く
北の大地を出ることにした。
と、結構な決断をしたつもりだったのに、
どうやら自分から出ていかなくてもそうなりそうな予感。
多分近くも遠くもないうちに。
元々縁もゆかりも無かったけど、今じゃ永住出来ると思えるくらい一番好きな街なので、
札幌は心からおすすめ。
住んでるうちに変わるものも変わらないものもあって、
5年間少し穏やかに過ごし過ぎたので、次の街ではちょっと苦しみたいなというのが希望です。
まだもうしばらくは居る。予定。
ちなみにこれに感化されたわけではないけど良い映画。
とにもかくにも主題歌が名曲です。
- 出版社/メーカー: ポニーキャニオン
- 発売日: 2009/01/30
- メディア: DVD
- 購入: 10人 クリック: 162回
- この商品を含むブログ (397件) を見る
おわり。
【locator,Nippon,TeachingDemo】世界を二つに分けたがる
ヘロヘロプーな感じで生きていると、世の中を
「●●な人」
「●●でない人」
の二つに分けたがるマンに、見事に仕分けられてしまうことがよくある。(ない)
複雑な世の中を二つに分けて論じようなんて傲慢である。
ずるい。私も世界を二つに分けたい。
テーマ
◎日本を二つに分ける。
◎...のは傲慢なので、小さい日本を二つに分ける。
◎分けただけだとつまらないので、その技を何かに応用してみる
とりあえず分けてみる
使ったのは以下のパッケージ。
Nipponパッケージのフォルダ内に含まれているシェープファイルをお借りする。
library(maptools) library(TeachingDemos) library(Nippon)
シェープファイルの準備
#Nipponパッケージに使用されているシェープファイルのフルパスを取得 #readShapePolyで読み込み m <- system.file("shapes/jpn.shp", package = "Nippon")[1] %>% maptools::readShapePoly(., proj4string = CRS("+proj=longlat +datum=WGS84"))
ちなみにJapanPrefecturesMap()で描いてみるとこんな感じの日本である。
Nippon::JapanPrefecturesMap()
取得したシェープファイルを描画する。
JapanPrefectureMapでの描画に比べて、沖縄が定位置にある。
plot(m,col=gray(0.8))
これをこんな感じで二つに分けたい。
(こんな感じ)
そのままぱっかーんてすると罰当たりな感じがするので
もうちょっとささやかな感じで分けたい。
ということで、
ぱっかーんと分けた日本を、サブプロットとして埋め込むことを検討する。
分けたいところの座標を取得
「この辺!!特に何もないけどこの辺で分けたいんだよ!!」
という時は、locator()が便利。
#元のplotをまず描画 plot(m,col=gray(0.8)) #locatorを実行 > locator(2) #2点クリックして座標ゲット $x [1] 127.6297 139.5370 $y [1] 46.78319 29.40000 #plot内のお好きなところの左上、右下をそれぞれクリック。 #座標の取得が出来る。
同様に、埋め込みたいところの座標も取得しておく。
準備が整ったので、
TeachingDemo::subplotで元plotの上に重ねていく。
#元plot plot(m,col=gray(0.8)) #西日本 subplot({ plot(m,xlim=c(127,138),ylim=c(30,45),col=gray(0.8)) box() },x=c(141.5,145),y=c(30,36.5)) #東日本 subplot({ plot(m,xlim=c(138,146),ylim=c(30,45),col=gray(0.8)) box() },x=c(145.5,149),y=c(30,36.5))
subplotの中はboxで囲んでね!としている。
これで描画するとこんな感じ。
ぱっかーん
できた。
いい。いいよ、ささやかだよ。
でもなんかすごい悪いことをした気持ちになる。
やはり世の中の事象を単純にTRUE、FALSEで分けてしまうのはだいそれたことだな、といった感じ。
お茶を濁す
さて、
これをやって終わるわけにはいかないので
これが何に使えるのかについて考える。
分かりやすいのが沖縄なので、沖縄をお好きなところに移動させる。
> plot(m,col=gray(0.8)) > subplot({ + plot(m,xlim=c(127,130),ylim=c(25,30),col=gray(0.8)) + box() + },x=c(131,133),y=c(39,42))
さっきと同じやり方をすると、沖縄が二つに分身してしまう。
これは元plotで沖縄も描画に含んでしまっているからなので、
元plotの方のxlim,ylimで描画範囲を限定してうまいことやる。
plot(m,xlim=c(128,146),ylim=c(30,46),col=gray(0.8)) #沖縄を除く subplot({ plot(m,xlim=c(127,130),ylim=c(25,30),col=gray(0.8)) box() },x=c(131,133),y=c(39,42))
できた。
他のplotでもこんな感じでlocatorで座標取得してよきに指定すれば
便利なことが多々あるかもしれない。
という話。(だったことにする)
【reshape2,tidyr】 豆について考える(番外編)~溶けるの概念を見失った時のためのメモ~
前回の記事を書いていて、
2年前に
「reshape2::meltってなんだ。そもそもmeltってなんだ、溶けるってなんだ」
という、鳥はなぜ空を飛ぶの的な疑問に直面してたのを思い出したので、自分用メモ。
溶かすとは
当時釈然としてなかったのは、reshape2::meltを「えくせる的な行列入れ替え」と解釈していたことに端を発する。
◎えくせる的な行列入れ替え
◎reshape2::meltでの変換
・・・ちがうじゃんと。
思ってたのと違うじゃんと。
こんな変換誰が使うんだよと。 (cv.2年前わたし)
ということで、
そんな愚かな過去の自分に
使いどころと使い方と、tidyr::gatherとの微妙な表記の違いを捧げて、
反省してもらおうとおもいます。
題材
前回使った豆。
(引用:農林水産省/大豆関連データ集)
> mameused_xts<- mameused > mameused_xts$年<- mameused$年+1988 #西暦変換 > knitr::kable(mameused_xts) | 年|計 | みそ| しょうゆ| 豆腐.油揚| 納豆| 凍豆腐| 豆乳| 煮豆.惣菜| きな粉| その他| |----:|:-----|----:|--------:|---------:|----:|------:|----:|---------:|------:|------:| | 1997|1,019 | 165| 26| 494| 122| 30| 3| 33| 14| 132| | 1998|1,046 | 162| 26| 495| 128| 30| 4| 33| 16| 152| | 1999|1,017 | 166| 30| 492| 127| 29| 6| 33| 17| 117| | 2000|1,010 | 166| 30| 492| 122| 29| 7| 33| 17| 114| | 2001|1,015 | 149| 32| 492| 129| 29| 9| 33| 17| 125| | 2002|1,035 | 149| 35| 494| 141| 29| 11| 33| 17| 126| | 2003|1,034 | 138| 38| 494| 137| 30| 19| 33| 17| 128| | 2004|1,053 | 139| 37| 496| 139| 33| 29| 33| 18| 129| | 2005|1,052 | 141| 40| 494| 131| 33| 32| 33| 18| 130| | 2006|1,046 | 140| 40| 492| 130| 33| 30| 33| 18| 130| | 2007|1,045 | 139| 40| 497| 130| 30| 25| 33| 19| 132| | 2008|1,037 | 137| 39| 496| 129| 29| 25| 33| 19| 130| | 2009|993 | 131| 39| 490| 125| 27| 29| 33| 19| 100| | 2010|976 | 127| 39| 480| 123| 26| 32| 33| 19| 97| | 2011|950 | 126| 35| 465| 122| 24| 34| 31| 18| 95| | 2012|932 | 124| 33| 450| 123| 22| 40| 30| 17| 93| | 2013|936 | 123| 33| 454| 125| 20| 40| 30| 18| 93| | 2014|942 | 133| 33| 447| 125| 19| 43| 30| 18| 94|
使いどころ
こちらも前回の話だけど、
上記データの状態から積み上げ棒グラフを書きたいと思ったとき。
考えるのは、
・列名をFactor型にしたらできそう
・じゃあ縦型データじゃないとダメじゃない?
・でも年の列はそのままがよくない?
みたいなこと。
その処理をやるのに
reshape2::meltとかtidyr::gatherとかを使ってます。
もっとオサレな用途もあるにちがいない....例え出てこないけど...
いざ変換
前回やったのはこんな感じ。
id引数に年を指定して、それ以外を縦持ちに変換した。
> mameused_xts<-reshape2::melt(mameused_xts,id="年") #idを指定 > knitr::kable(head(subset(mameused_xts,mameused_xts$variable!="計") ,20)) | | 年|variable |value | |:--|----:|:--------|:-----| |19 | 1997|みそ |165 | |20 | 1998|みそ |162 | |21 | 1999|みそ |166 | |22 | 2000|みそ |166 | |23 | 2001|みそ |149 | |24 | 2002|みそ |149 | |25 | 2003|みそ |138 | |26 | 2004|みそ |139 | |27 | 2005|みそ |141 | |28 | 2006|みそ |140 | |29 | 2007|みそ |139 | |30 | 2008|みそ |137 | |31 | 2009|みそ |131 | |32 | 2010|みそ |127 | |33 | 2011|みそ |126 | |34 | 2012|みそ |124 | |35 | 2013|みそ |123 | |36 | 2014|みそ |133 | |37 | 1997|しょうゆ |26 | |38 | 1998|しょうゆ |26 |
ここから何パターンかやる。
idを明示的に指定しない
> #idを明示的に指定しない(計が使われる) > mameused_2<-reshape2::melt(mameused_xts) Using 計 as id variables > knitr::kable(head(mameused_2,20)) |計 |variable | value| |:-----|:--------|-----:| |1,019 |年 | 1997| |1,046 |年 | 1998| |1,017 |年 | 1999| |1,010 |年 | 2000| |1,015 |年 | 2001| |1,035 |年 | 2002| |1,034 |年 | 2003| |1,053 |年 | 2004| |1,052 |年 | 2005| |1,046 |年 | 2006| |1,045 |年 | 2007| |1,037 |年 | 2008| |993 |年 | 2009| |976 |年 | 2010| |950 |年 | 2011| |932 |年 | 2012| |936 |年 | 2013| |942 |年 | 2014| |1,019 |みそ | 165| |1,046 |みそ | 162|
年まで容赦なく溶かされる。これは何を基準にidを選んでるんだろう。
複数のidを指定
> mameused_2<-reshape2::melt(mameused_xts,id=c("年","計")) #idを複数指定 > knitr::kable(head(mameused_2,20)) | 年|計 |variable | value| |----:|:-----|:--------|-----:| | 1997|1,019 |みそ | 165| | 1998|1,046 |みそ | 162| | 1999|1,017 |みそ | 166| | 2000|1,010 |みそ | 166| | 2001|1,015 |みそ | 149| | 2002|1,035 |みそ | 149| | 2003|1,034 |みそ | 138| | 2004|1,053 |みそ | 139| | 2005|1,052 |みそ | 141| | 2006|1,046 |みそ | 140| | 2007|1,045 |みそ | 139| | 2008|1,037 |みそ | 137| | 2009|993 |みそ | 131| | 2010|976 |みそ | 127| | 2011|950 |みそ | 126| | 2012|932 |みそ | 124| | 2013|936 |みそ | 123| | 2014|942 |みそ | 133| | 1997|1,019 |しょうゆ | 26| | 1998|1,046 |しょうゆ | 26|
年と計の列をそのままに変換できる。
時代はtidyr::gatherらしい
meltを長々と語ってるけど、
reshape2パッケージの進化版の時代に突入してしまっているので、
そちらについてもやる。
id一つ指定の時と同じ変換
> mameused_2<-tidyr::gather(mameused_xts,key=variable,value=value,-年) > knitr::kable(head(mameused_2,20)) | 年|variable |value | |----:|:--------|:-----| | 1997|計 |1,019 | | 1998|計 |1,046 | | 1999|計 |1,017 | | 2000|計 |1,010 | | 2001|計 |1,015 | | 2002|計 |1,035 | | 2003|計 |1,034 | | 2004|計 |1,053 | | 2005|計 |1,052 | | 2006|計 |1,046 | | 2007|計 |1,045 | | 2008|計 |1,037 | | 2009|計 |993 | | 2010|計 |976 | | 2011|計 |950 | | 2012|計 |932 | | 2013|計 |936 | | 2014|計 |942 | | 1997|みそ |165 | | 1998|みそ |162 |
引数がびみょうに違う。
meltがidに「残したい列(名)を指定」だったのに
gatherは「溶かしたい列名を指定」なので、残したい列は「-」マイナスを付けて除外指定をする。
keyとvalueには変換後の列名を指定する。
idの複数指定
> mameused_2<-tidyr::gather(mameused,key,value,-年,-計) #溶かさないものはマイナス指定 > knitr::kable(head(mameused_2,20)) | 年|計 |key | value| |--:|:-----|:--------|-----:| | 9|1,019 |みそ | 165| | 10|1,046 |みそ | 162| | 11|1,017 |みそ | 166| | 12|1,010 |みそ | 166| | 13|1,015 |みそ | 149| | 14|1,035 |みそ | 149| | 15|1,034 |みそ | 138| | 16|1,053 |みそ | 139| | 17|1,052 |みそ | 141| | 18|1,046 |みそ | 140| | 19|1,045 |みそ | 139| | 20|1,037 |みそ | 137| | 21|993 |みそ | 131| | 22|976 |みそ | 127| | 23|950 |みそ | 126| | 24|932 |みそ | 124| | 25|936 |みそ | 123| | 26|942 |みそ | 133| | 9|1,019 |しょうゆ | 26| | 10|1,046 |しょうゆ | 26|
溶かしたくない列を複数指定する時はカンマで区切っちゃってOK。
meltでid=c("年","計")ってした時と同じ結果になる。
おまけ
上記でやってないけど、
data引数はパイプで渡しちゃうのが正なのでしょう。
> mameused_xts %>% + tidyr::gather(key,value,-年)->mameused_2 > knitr::kable(head(mameused_2,20)) | 年|key |value | |----:|:----|:-----| | 1997|計 |1,019 | | 1998|計 |1,046 | | 1999|計 |1,017 | | 2000|計 |1,010 | | 2001|計 |1,015 | | 2002|計 |1,035 | | 2003|計 |1,034 | | 2004|計 |1,053 | | 2005|計 |1,052 | | 2006|計 |1,046 | | 2007|計 |1,045 | | 2008|計 |1,037 | | 2009|計 |993 | | 2010|計 |976 | | 2011|計 |950 | | 2012|計 |932 | | 2013|計 |936 | | 2014|計 |942 | | 1997|みそ |165 | | 1998|みそ |162 |
おわり
完全に備忘録。
もうすぐの誕生日、忘れっぱなしでいったら年取らないで済むかなあ
【ggplot2,formattable,DiagrammeR】新年なので大豆と向き合ってみた(1)
明けまして、おめでとうございます。
気付いたら年が明けていました。恐ろしい話です。
さて、正月なので実家では煮豆が食卓に並ぶなどしているのですが、
そこでそういえば大豆について真剣に考えたこと無いな、と箸が止まりました。
大豆からの加工食品ってやたらたくさんあるよね?
大豆たくさん作ってるとこと加工品たくさん作ってるとこって一致する?の?
もう煮豆をつまんでいる場合ではありません。
気になったことはすぐ調べろってえらい人も言ってた。
今回のテーマ
・取り急ぎ大豆加工品についてのデータ集めつつ、今まであまりやってなかった系の可視化の操作をしてみる。
次回以降は地図と組み合わせて色々見てみたい。今回はその前段階として。
大豆加工品いろいろ
大豆から派生する加工品について、フロー図で見てみる。
Windowsでは日本語の文字化けがツラかったのでUbuntuで動かしてみた。
>library(DiagrammeR) >DiagrammeR(" graph LR 大豆-->醤油 大豆-->味噌 大豆-->納豆 大豆-->豆腐 豆腐-->油揚げ 豆腐-->豆乳 ")
graph LRで横方向(左から右)に流れる図が生成される。
大豆さん、液体にもなるわ固形にもなるわ有能である。
大豆の加工品消費量についてデータ外観をテーブルで把握してみる
ここからは↓の「食品用大豆の用途別使用量の推移」を取得して使う。
農林水産省/大豆関連データ集
何はともあれまずデータの概要を把握したい。
>mameused<-read.csv("1231mameused.csv",header = T) > str(mameused) 'data.frame': 18 obs. of 11 variables: $ 年 : int 9 10 11 12 13 14 15 16 17 18 ... $ 計 : chr 1,019 1,046 1,017 1,010 1,015 ... $ みそ : int 165 162 166 166 149 149 138 139 141 140 ... $ しょうゆ : int 26 26 30 30 32 35 38 37 40 40 ... $ 豆腐.油揚: int 494 495 492 492 492 494 494 496 494 492 ... $ 納豆 : int 122 128 127 122 129 141 137 139 131 130 ... $ 凍豆腐 : int 30 30 29 29 29 29 30 33 33 33 ... $ 豆乳 : int 3 4 6 7 9 11 19 29 32 30 ... $ 煮豆.惣菜: int 33 33 33 33 33 33 33 33 33 33 ... $ きな粉 : int 14 16 17 17 17 17 17 18 18 18 ... $ その他 : int 132 152 117 114 125 126 128 129 130 130 ... #カンマ区切りが気になったので数値へ >mameused$計<-as.numeric(as.character(gsub(",","",mameused$計))) #見やすいテーブルの形に整形する #文字化けするのでここではcolnameから日本語を外して対応 >mameused.t<-mameused >colnames(mameused.t)<-c("year","total","miso","syoyu","tofu","natto","kori","tonyu","nimame","kinako","other") #formattableはきれいなtableをviewerに表示してくれる。color_barやcolor_tileのような視覚効果も追加可能 >library(formattable) >formattable::formattable(mameused.t,list(tofu=color_bar("tomato"),miso=color_bar("steelblue"),syoyu=color_bar("olivedrab"),natto=color_bar("orange")))
Viewerでは上記のように表示される。
カラーバーの感じはExcelとかと同じよう使い方ができそうだけど、なんとなくバーの動きが極端だな~調整できたりするかしら
そもそもYearが和暦(平成)ですね。
バーの動きは極端だけど、全体的に消費量は微減傾向のようです。ほう。
こうなると年別とか比率でも見てみたくなってくる。
大豆加工品使用料で積み上げグラフ
掲題の通り。積み上げグラフを作る。
個人的に和暦がピンと来ないので、西暦にこっそり変換もする。
>mameused_xts<- mameused >mameused_xts$年<- mameused$年+1988 #西暦変換 #積み上げたいのでmelt関数でデータの形を変換。 >mameused_xts<-reshape2::melt(mameused_xts,id="年",value.name = "t") >mameused_xts<-subset(mameused_xts,mameused_xts$variable!="計") #こんな感じに。 > knitr::kable(head(mameused_xts,20)) | | 年|variable | t| |:--|----:|:--------|---:| |19 | 1997|みそ | 165| |20 | 1998|みそ | 162| |21 | 1999|みそ | 166| |22 | 2000|みそ | 166| |23 | 2001|みそ | 149| |24 | 2002|みそ | 149| |25 | 2003|みそ | 138| |26 | 2004|みそ | 139| |27 | 2005|みそ | 141| |28 | 2006|みそ | 140| |29 | 2007|みそ | 139| |30 | 2008|みそ | 137| |31 | 2009|みそ | 131| |32 | 2010|みそ | 127| |33 | 2011|みそ | 126| |34 | 2012|みそ | 124| |35 | 2013|みそ | 123| |36 | 2014|みそ | 133| |37 | 1997|しょうゆ | 26| |38 | 1998|しょうゆ | 26| #経年積み上げグラフ >ggplot(mameused_xts,aes(x=factor(年),y=t,fill=factor(variable)))+ geom_bar(stat="identity")+ scale_fill_hue(h=c(20, 260))+labs(x="年",y="消費量(t)")
年分をきっちりfactorするとX軸が綺麗に表示されるって今更気が付いた。
こうして見るとテーブル状態では分からなかった状態が見えて、
醤油の割合が多いと思ってたのに豆腐か!豆腐なのか!!みたいな気持ちになれたりする。
全体消費量の微減も、豆腐消費が微減したことによって起きていそう。
ここで今回目標のデータ俯瞰は出来たのでいったん満足した。が、
せっかく18年分あるし、積み上げもあるし、
円グラフ的なやつを年別でfacet_wrap()とかgrid.arrange()とかで並べたり出来ないかな?となった。
おまけ(グラフを年別で並べてみたい)
イメージ
>ggplot(tmp,aes(x=factor(variable),y=t,fill=factor(variable)))+ geom_bar(stat="identity")+ coord_polar(theta="x")
こうすると「パイのでかさ」がそれぞれの加工品カテゴリの消費量を現したちょっと見辛いグラフが出来る。
これを年別で18個並べたい。
方針は2つ。
①グラフオブジェクトをp1~p18まで作って、並べる
②ggplot2はオブジェクトに格納するとListになるので、一つ一つのグラフをリストの要素として呼び出して並べる
両方やってみた。
①
for(i in 1:18){ tmp<-subset(mameused_xts,mameused_xts[,1]==i+1996) p<-ggplot(tmp,aes(x=factor(variable),y=t,fill=factor(variable)))+ geom_bar(stat="identity")+ coord_polar(theta="x")+labs(x=i+1996,y="")+guides(fill=FALSE) assign(paste("p", i, sep=""), p) } grid.arrange(p1,p2,p3,p4,p5,p6,p7,p8,p9,p10,p11,p12,p13,p14,p15,p16,p17,p18,ncol=3,nrow=6)
(わかっちゃいたけど見えない)
オブジェクトに連番を振る、というか動的にオブジェクトを増やすやり方、
他にもスマートなやり方があるのかもしれませんが...とりあえず
(pに変数iをくっつけたオブジェクト)<-(グラフ)
みたいな感じでやったらいけました。これアリなのか...な...?
②
Do.call関数を使えばいけるんじゃない!!たぶん!!って調子乗って始まったらしばらくエラー沼にハマった。
#listにグラフを格納してdo.callで要素を呼び出し >graph.mame <- lapply(1:18, function(i) { tmp<-subset(mameused_xts,mameused_xts[,1]==i+1996) ggplot(tmp,aes(x=factor(variable),y=t,fill=factor(variable)))+ geom_bar(stat="identity")+ coord_polar(theta="x")+labs(x=i+1996,y="")+guides(fill=FALSE) }) >px <- c(graph.mame, list(ncol=3, nrow=6)) >do.call(grid.arrange, px)
繰り返し処理の中身は①と同じで、それをまとめてlistにぶっこんでいます。
で、do.coll()にそのリストを渡せばリスト各要素を取ってきてfunctionを適用してくれるぜ...のつもりだったんだけど
list(graph.mame,~)で渡したら盛大に怒られた。
ぐるぐる悩んで下記にて解決...grid.Grob()側の最初の引数が可変長....むずかしい...
とりあえず①、②でもいけた。②の方がメジャーなやり方なのかしら...
おわり
次回は大豆収穫量のデータも都道府県データでなんかする。よてい。
正月っぽい話
去年の1月、2月あたりは卒論にのめりこんでみたり、出し終わった直後に知恵熱で倒れてみたり
その後一か月一人旅と称して失踪したりしていた。。気がする。。
今年は取り急ぎ行き倒れないのが目標。
※R関連でお会いした皆さま本当にありがとうございました。FOSS4Gも今年は行けたらいいな
※このまま日々を過ごしていたら平気で数年経ちそうで恐い。人間的成長みたいなものは。どこへ。
なにはともあれ「Rが趣味」というのを勇気を出して言えたのが大きかった1年でありました。
今年はなんとか地面を見つけたいところ。
2016年は何かしらの決断をする、はず
【leaflet】ラブホマップ(改)~orverpass turboを添えて~
R Advent Calendar 2015 - Qiita 16日目の記事です。
初めてなので勝手が分からない。。
今回のテーマ
これの続きをやります。
ただやるだけだと日々進歩の無い人間だということが露呈してしまうので
小さいテーマとして
- シェープファイルの属性テーブルに別なデータをマージしてみる
- overpass turbo なるものからデータを抜いてみる
みたいなことを掲げてみる。小さな一歩。
そもそもなんでラブホだったんだっけ
「千葉県の高速道路、幹線道路脇にラブホ多くないですか?なんで?」
という中学生レベルの疑問から始まっただけのラブホテルプロットです。
しかしその後
「地価との関連はどうなんだい」とか
「子供の多いところには作れないんじゃないかい」とか
どんどん疑問は湧いてくるものなので
全部まとめて今回やってみます。
相変わらず千葉県を引き合いに出します。
シェープファイルの属性テーブルに市町村ごとの地価を追加してみる編
地球地図日本のデータ|国土地理院 このシェープファイルに
地価調査・地価公示/千葉県 この地価データを足します。
別にRでやる必要もないといえば無いんですけど、、Rあどべんとだし、、
library(leaflet) library(rgdal) library(magrittr) library(maptools) library(dplyr) #シェープファイルの読み込み > city <- readShapePoly("polbnda_jpn.shp") #なんとなく概要 > str(city,list.len = 3) Formal class 'SpatialPolygonsDataFrame' [package "sp"] with 5 slots ..@ data :'data.frame': 2924 obs. of 9 variables: .. ..$ f_code : Factor w/ 1 level "FA001": 1 1 1 1 1 1 1 1 1 1 ... .. ..$ coc : Factor w/ 1 level "JPN": 1 1 1 1 1 1 1 1 1 1 ... .. ..$ nam : Factor w/ 50 levels "AICHI","Aichi Ken",..: 14 14 14 14 14 14 14 14 14 14 ... .. .. [list output truncated] .. ..- attr(*, "data_types")= chr [1:9] "C" "C" "C" "C" ... ..@ polygons :List of 2924 .. ..$ :Formal class 'Polygons' [package "sp"] with 5 slots .. .. .. ..@ Polygons :List of 1 .. .. .. .. ..$ :Formal class 'Polygon' [package "sp"] with 5 slots .. .. .. .. .. .. ..@ labpt : num [1:2] 148.6 45.4 .. .. .. .. .. .. ..@ area : num 0.0863 .. .. .. .. .. .. ..@ hole : logi FALSE .. .. .. .. .. .. .. [list output truncated] .. .. .. ..@ plotOrder: int 1 .. .. .. ..@ labpt : num [1:2] 148.6 45.4 .. .. .. .. [list output truncated] .. ..$ :Formal class 'Polygons' [package "sp"] with 5 slots .. .. .. ..@ Polygons :List of 1 .. .. .. .. ..$ :Formal class 'Polygon' [package "sp"] with 5 slots .. .. .. .. .. .. ..@ labpt : num [1:2] 141.8 45.3 .. .. .. .. .. .. ..@ area : num 0.0875 .. .. .. .. .. .. ..@ hole : logi FALSE .. .. .. .. .. .. .. [list output truncated] .. .. .. ..@ plotOrder: int 1 .. .. .. ..@ labpt : num [1:2] 141.8 45.3 .. .. .. .. [list output truncated] .. ..$ :Formal class 'Polygons' [package "sp"] with 5 slots .. .. .. ..@ Polygons :List of 1 .. .. .. .. ..$ :Formal class 'Polygon' [package "sp"] with 5 slots .. .. .. .. .. .. ..@ labpt : num [1:2] 141 45.4 .. .. .. .. .. .. ..@ area : num 0.00935 .. .. .. .. .. .. ..@ hole : logi FALSE .. .. .. .. .. .. .. [list output truncated] .. .. .. ..@ plotOrder: int 1 .. .. .. ..@ labpt : num [1:2] 141 45.4 .. .. .. .. [list output truncated] .. .. [list output truncated] ..@ plotOrder : int [1:2924] 673 10 41 97 1187 46 87 544 981 347 ... .. [list output truncated] #属性テーブル部分はこんな感じ > city@data[1:10,] f_code coc nam laa pop ypc adm_code salb soc 0 FA001 JPN Hokkai Do Shibetoro Mura -99999999 0 01700 UNK JPN 1 FA001 JPN Hokkai Do Wakkanai Shi 41592 2005 01214 UNK JPN 2 FA001 JPN Hokkai Do Rebun Cho 3410 2005 01517 UNK JPN 3 FA001 JPN Hokkai Do Shana Mura -99999999 0 01699 UNK JPN 4 FA001 JPN Hokkai Do Sarufutsu Mura 2940 2005 01511 UNK JPN 5 FA001 JPN Hokkai Do Toyotomi Cho 4850 2005 01516 UNK JPN 6 FA001 JPN Hokkai Do Rishirifuji Cho 3239 2005 01519 UNK JPN 7 FA001 JPN Hokkai Do Rishiri Cho 2951 2005 01518 UNK JPN 8 FA001 JPN Hokkai Do Hamatonbetsu Cho 4582 2005 01512 UNK JPN 9 FA001 JPN Hokkai Do Rubetsu Mura -99999999 0 01698 UNK JPN #千葉 > head(filter(tmp,nam=="Chiba Ken"),6) f_code coc nam laa pop ypc adm_code salb soc 1 FA001 JPN Chiba Ken Noda Shi 151240 2005 12208 UNK JPN 2 FA001 JPN Chiba Ken Katori Shi 87332 2005 12236 UNK JPN 3 FA001 JPN Chiba Ken Kashiwa Shi 380963 2005 12217 UNK JPN 4 FA001 JPN Chiba Ken Nagareyama Shi 152641 2005 12220 UNK JPN 5 FA001 JPN Chiba Ken Kozaki Machi 6705 2005 12342 UNK JPN 6 FA001 JPN Chiba Ken Narita Shi 121139 2005 12211 UNK JPN
namに都道府県名、laaに市町村名、そしてadm_codeが市町村と一対のようです。
でもってこの行順序は入れ替えると悲惨なことになるので、
今回はadm_codeをKeyにデータを紐付けることに。
で、肝心の地価データ(PDF)→データ化は、ごたごたごたごたしたあげく泣く泣く手作業とか入れたので割愛しますが
もう地価データにadm_codeを振ってしまって、
それを本体のadm_codeとJOINして、NAを0に置換してテーブルに追加しました。
>city$Chiba_chika <- temp >subset(city@data,nam=="Chiba Ken") f_code coc nam laa pop ypc adm_code salb soc Chiba_Chika 760 FA001 JPN Chiba Ken Noda Shi 151240 2005 12208 UNK JPN 61900 818 FA001 JPN Chiba Ken Katori Shi 87332 2005 12236 UNK JPN 36600 827 FA001 JPN Chiba Ken Kashiwa Shi 380963 2005 12217 UNK JPN 155200 831 FA001 JPN Chiba Ken Nagareyama Shi 152641 2005 12220 UNK JPN 125100 833 FA001 JPN Chiba Ken Kozaki Machi 6705 2005 12342 UNK JPN 0 836 FA001 JPN Chiba Ken Narita Shi 121139 2005 12211 UNK JPN 49700 837 FA001 JPN Chiba Ken Abiko Shi 131205 2005 12222 UNK JPN 100000 847 FA001 JPN Chiba Ken Sakae Machi 24377 2005 12329 UNK JPN 35600 855 FA001 JPN Chiba Ken Tonosho Machi 16166 2005 12349 UNK JPN 16400 858 FA001 JPN Chiba Ken Matsudo Shi 472579 2005 12207 UNK JPN 176300 859 FA001 JPN Chiba Ken Inzai Shi 81102 2005 12231 UNK JPN 52200 862 FA001 JPN Chiba Ken Shiroi Shi 53005 2005 12232 UNK JPN 66700 868 FA001 JPN Chiba Ken Sakae Machi -89999999 2005 12329 UNK JPN 35600 870 FA001 JPN Chiba Ken Choshi Shi 75020 2005 12202 UNK JPN 43700 875 FA001 JPN Chiba Ken Tako Machi 16950 2005 12347 UNK JPN 17100 878 FA001 JPN Chiba Ken Asahi Shi -89999999 2005 12215 UNK JPN 38500 879 FA001 JPN Chiba Ken Kamagaya Shi 102812 2005 12224 UNK JPN 95700 882 FA001 JPN Chiba Ken Funabashi Shi 569835 2005 12204 UNK JPN 178900 887 FA001 JPN Chiba Ken Asahi Shi 70643 2005 12215 UNK JPN 38500 889 FA001 JPN Chiba Ken Yachiyo Shi 180729 2005 12221 UNK JPN 115000 899 FA001 JPN Chiba Ken Tomisato Shi 51370 2005 12233 UNK JPN 38200 900 FA001 JPN Chiba Ken Ichikawa Shi 466608 2005 12203 UNK JPN 250000 901 FA001 JPN Chiba Ken Shibayama Machi 8389 2005 12409 UNK JPN 15100 907 FA001 JPN Chiba Ken Sakura Shi 171246 2005 12212 UNK JPN 67100 910 FA001 JPN Chiba Ken Sosa Shi 42086 2005 12235 UNK JPN 34100 911 FA001 JPN Chiba Ken Shisui Machi 21385 2005 12322 UNK JPN 42200 912 FA001 JPN Chiba Ken Funabashi Shi -89999999 2005 12204 UNK JPN 178900 916 FA001 JPN Chiba Ken Funabashi Shi -89999999 2005 12204 UNK JPN 178900 933 FA001 JPN Chiba Ken Yokoshibahikari Machi 25981 2005 12410 UNK JPN 14000 938 FA001 JPN Chiba Ken Yachimata Shi 75735 2005 12230 UNK JPN 33600 939 FA001 JPN Chiba Ken Chiba Shi 924319 2005 12100 UNK JPN 147600 942 FA001 JPN Chiba Ken Narashino Shi 158785 2005 12216 UNK JPN 170900 944 FA001 JPN Chiba Ken Yotsukaido Shi 84770 2005 12228 UNK JPN 68600 959 FA001 JPN Chiba Ken Sanmu Shi 59024 2005 12237 UNK JPN 13300 963 FA001 JPN Chiba Ken Ichikawa Shi -89999999 2005 12203 UNK JPN 250000 964 FA001 JPN Chiba Ken Funabashi Shi -89999999 2005 12204 UNK JPN 178900 966 FA001 JPN Chiba Ken Urayasu Shi 155290 2005 12227 UNK JPN 300700 991 FA001 JPN Chiba Ken Togane Shi 61701 2005 12213 UNK JPN 39200 1001 FA001 JPN Chiba Ken Sanmu Shi -89999999 2005 12237 UNK JPN 13300 1026 FA001 JPN Chiba Ken Kujukuri Machi 19009 2005 12403 UNK JPN 10600 1028 FA001 JPN Chiba Ken Oamishirasato Machi 49548 2005 12402 UNK JPN 36300 1033 FA001 JPN Chiba Ken Ichihara Shi 280255 2005 12219 UNK JPN 48900 1042 FA001 JPN Chiba Ken Togane Shi -89999999 2005 12213 UNK JPN 39200 1061 FA001 JPN Chiba Ken Mobara Shi 93260 2005 12210 UNK JPN 44600 1066 FA001 JPN Chiba Ken Nagara Machi 8564 2005 12426 UNK JPN 0 1072 FA001 JPN Chiba Ken Sodegaura Shi 59108 2005 12229 UNK JPN 36500 1074 FA001 JPN Chiba Ken Shirako Machi 12850 2005 12424 UNK JPN 12900 1101 FA001 JPN Chiba Ken Kisarazu Shi 122234 2005 12206 UNK JPN 33400 1104 FA001 JPN Chiba Ken Chosei Mura 14543 2005 12423 UNK JPN 14400 1108 FA001 JPN Chiba Ken Chonan Machi 9824 2005 12427 UNK JPN 12100 1115 FA001 JPN Chiba Ken Mutsuzawa Machi -89999999 2005 12422 UNK JPN 0 1127 FA001 JPN Chiba Ken Mutsuzawa Machi 7838 2005 12422 UNK JPN 0 1129 FA001 JPN Chiba Ken Ichinomiya Machi 11656 2005 12421 UNK JPN 18900 1140 FA001 JPN Chiba Ken Kimitsu Shi 90977 2005 12225 UNK JPN 35000 1151 FA001 JPN Chiba Ken Futtsu Shi 50162 2005 12226 UNK JPN 18400 1160 FA001 JPN Chiba Ken Isumi Shi 42305 2005 12238 UNK JPN 19700 1173 FA001 JPN Chiba Ken Otaki Machi 11514 2005 12441 UNK JPN 8992 1177 FA001 JPN Chiba Ken Futtsu Shi -89999999 2005 12226 UNK JPN 18400 1181 FA001 JPN Chiba Ken Futtsu Shi -89999999 2005 12226 UNK JPN 18400 1211 FA001 JPN Chiba Ken Katsuura Shi 22198 2005 12218 UNK JPN 30800 1216 FA001 JPN Chiba Ken Onjuku Machi 7942 2005 12443 UNK JPN 19700 1231 FA001 JPN Chiba Ken Kamogawa Shi 36475 2005 12223 UNK JPN 26700 1245 FA001 JPN Chiba Ken Kyonan Machi 9778 2005 12463 UNK JPN 0 1254 FA001 JPN Chiba Ken Minamiboso Shi 44763 2005 12234 UNK JPN 0 1281 FA001 JPN Chiba Ken Tateyama Shi 50527 2005 12205 UNK JPN 33800
地価データ編描画
leafletパッケージのcolorNumeric()に色を決めてもらって、市町村単位でのコロプレス図にします。(千葉だけ)
欠損値0だけ分かりやすくしたいので、今回は別指定。
#色決め > x<-city@data$Chiba_chika > colset<-colorNumeric("Oranges", domain = range(x)) > city$color<- colset(x) > city$color<- gsub("#FFF5EB","#C6C6C6",city$color) #描くよ leaflet() %>% addTiles() %>% addPolygons(data = city, color = ~color, fillOpacity = 0.8, stroke = FALSE) %>% addCircles(data=location_love,~lon, ~lat,color = "#DA6272",fillColor="#DA6272",fillOpacity = 1,weight=8)
とりあえず描けました。
うーん
南東側は地価の変化がほとんど無いのでコロプレス感が出ませんでした。
肝心のラブホも地価の高い千葉、松戸あたりに集中しているかといえばそうでもない、、
かといって郊外にあるかといえばそうでもない、、といった感じです。
気を取り直して、
学校のそばにラブホは置けないんじゃないか説を考えてみます。
噂によると200M離さないといけないらしい...ほう...?
orverpass turboから学校のデータを抽出編
先日縁あってFOSS4Gの会に混ぜて頂いたのですが、
そこで「ジオコーディングが手間ならoverpass turboのタグで抜けばいいじゃない」みたいな話が出たのでやってみます。
overpass turbo 、みんな大好きopenstreetmapのデータを抜いてくることが出来ます。
Rでは無いので深くは語りませんがこんな感じ、、
学校のデータを抜きたいので「amenity="school"」のタグを指定、
千葉付近だけでいいので範囲指定をします。
これで実行するとデータが抜いてこれるのですが、そのとき右ウィンドウにleafletで表示してくれたりもします。。
(もうこれでいいじゃん。。たのしい。。って3回思った。)
最初に全量抜いたらメモリクラッシュしたのでクエリをいじってnodeだけ取得してます。
タイムアウトエラーが出てしまう時は[timeout:25]で秒数をいじるが吉。
抜いたデータをgeoJSON形式でエクスポートしていざRへ。
>library(jsonlite) >json<- fromJSON("school_chiba.geoJSON",simplifyVector = FALSE) > str(json,list.len = 10) List of 5 $ type : chr "FeatureCollection" $ generator: chr "overpass-turbo" $ copyright: chr "The data included in this document is from www.openstreetmap.org. The data is made available under ODbL." $ timestamp: chr "2015-12-07T14:19:02Z" $ features :List of 1804 ..$ :List of 4 .. ..$ type : chr "Feature" .. ..$ id : chr "node/287177884" .. ..$ properties:List of 3 .. .. ..$ @id : chr "node/287177884" .. .. ..$ amenity: chr "school" .. .. ..$ name : chr "予備校ARROWS" .. ..$ geometry :List of 2 .. .. ..$ type : chr "Point" .. .. ..$ coordinates:List of 2 .. .. .. ..$ : num 140 .. .. .. ..$ : num 35.6 ..$ :List of 4 .. ..$ type : chr "Feature" .. ..$ id : chr "node/287177898" .. ..$ properties:List of 3 .. .. ..$ @id : chr "node/287177898" .. .. ..$ amenity: chr "school" .. .. ..$ name : chr "予備校IE" .. ..$ geometry :List of 2 .. .. ..$ type : chr "Point" .. .. ..$ coordinates:List of 2 .. .. .. ..$ : num 140 .. .. .. ..$ : num 35.6 ..$ :List of 4 .. ..$ type : chr "Feature" .. ..$ id : chr "node/288080952" .. ..$ properties:List of 3 .. .. ..$ @id : chr "node/288080952" .. .. ..$ amenity: chr "school" .. .. ..$ name : chr "千葉県生実学校" .. ..$ geometry :List of 2 .. .. ..$ type : chr "Point" .. .. ..$ coordinates:List of 2 .. .. .. ..$ : num 140 .. .. .. ..$ : num 35.6 ..$ :List of 4 .. ..$ type : chr "Feature" .. ..$ id : chr "node/288135655" .. ..$ properties:List of 3 .. .. ..$ @id : chr "node/288135655" .. .. ..$ amenity: chr "school" .. .. ..$ name : chr "しおのめ研修塾" .. ..$ geometry :List of 2 .. .. ..$ type : chr "Point" .. .. ..$ coordinates:List of 2 .. .. .. ..$ : num 140 .. .. .. ..$ : num 35.5 ..$ :List of 4 .. ..$ type : chr "Feature" .. ..$ id : chr "node/288378947" .. ..$ properties:List of 3 .. .. ..$ @id : chr "node/288378947" .. .. ..$ amenity: chr "school" .. .. ..$ name : chr "チャイルド自由学園" .. ..$ geometry :List of 2 .. .. ..$ type : chr "Point" .. .. ..$ coordinates:List of 2 .. .. .. ..$ : num 140 .. .. .. ..$ : num 35.6 ..$ :List of 4 .. ..$ type : chr "Feature" .. ..$ id : chr "node/288715924" .. ..$ properties:List of 3 .. .. ..$ @id : chr "node/288715924" .. .. ..$ amenity: chr "school" .. .. ..$ name : chr "椎名小学校" .. ..$ geometry :List of 2 .. .. ..$ type : chr "Point" .. .. ..$ coordinates:List of 2 .. .. .. ..$ : num 140 .. .. .. ..$ : num 35.5 ..$ :List of 4 .. ..$ type : chr "Feature" .. ..$ id : chr "node/289041896" .. ..$ properties:List of 4 .. .. ..$ @id : chr "node/289041896" .. .. ..$ amenity : chr "school" .. .. ..$ created_by: chr "Potlatch 0.10b" .. .. ..$ name : chr "千葉県立浦安南高等学校" .. ..$ geometry :List of 2 .. .. ..$ type : chr "Point" .. .. ..$ coordinates:List of 2 .. .. .. ..$ : num 140 .. .. .. ..$ : num 35.6 ..$ :List of 4 .. ..$ type : chr "Feature" .. ..$ id : chr "node/289052151" .. ..$ properties:List of 4 .. .. ..$ @id : chr "node/289052151" .. .. ..$ amenity : chr "school" .. .. ..$ created_by: chr "Potlatch 0.10b" .. .. ..$ name : chr "浦安市立高洲北小学校" .. ..$ geometry :List of 2 .. .. ..$ type : chr "Point" .. .. ..$ coordinates:List of 2 .. .. .. ..$ : num 140 .. .. .. ..$ : num 35.6 ..$ :List of 4 .. ..$ type : chr "Feature" .. ..$ id : chr "node/390657444" .. ..$ properties:List of 3 .. .. ..$ @id : chr "node/390657444" .. .. ..$ amenity: chr "school" .. .. ..$ name : chr "旭町小学校(Asahimachi Elementary School)" .. ..$ geometry :List of 2 .. .. ..$ type : chr "Point" .. .. ..$ coordinates:List of 2 .. .. .. ..$ : num 140 .. .. .. ..$ : num 35.8 ..$ :List of 4 .. ..$ type : chr "Feature" .. ..$ id : chr "node/391376670" .. ..$ properties:List of 3 .. .. ..$ @id : chr "node/391376670" .. .. ..$ amenity: chr "school" .. .. ..$ name : chr "若松高校" .. ..$ geometry :List of 2 .. .. ..$ type : chr "Point" .. .. ..$ coordinates:List of 2 .. .. .. ..$ : num 140 .. .. .. ..$ : num 35.6 .. [list output truncated]
結構な量のデータがザクザク手に入ってすごい。
leafletに直接JSON渡してしまおう!と思ったのですが
$nameの文字化け祭りに悩まされました。。あと結構遅い。。
なので諦めてこんな感じに。
>x<-1:1804 >test<-matrix(nrow=1804,ncol=2) >for(i in 1:1804){ test[i,1]<-json$features[[i]][[4]]$coordinates[[2]] test[i,2]<-json$features[[i]][[4]]$coordinates[[1]] } >test2<-as.data.frame(test) >colnames(test2)<-c("lat","lon") > head(test2) lat lon 1 35.55021 140.1671 2 35.55049 140.1660 3 35.56881 140.1409 4 35.54088 140.1929 5 35.55761 140.1764 6 35.54163 140.1665 >leaflet() %>% addTiles() %>% addCircles(data=test2,~lon,~lat)
popup出したかったなあ。。。
まとめると
地価、ラブホ、学校データを全部乗せしてみます。
>leaflet() %>% addTiles() %>% addPolygons(data = city, color = ~color, fillOpacity = 0.8, stroke = FALSE) %>% addMarkers(data=location_love,~lon, ~lat) %>% addCircles(data=test2,~lon,~lat,color="#40BFB0")
近づく
確かに200Mくらいは離れている気がしなくもない。
が。
ここからは「半径200Mの円」みたいなものが欲しくなる...
うう...
amenity="school"だと予備校や塾が稀に混ざってくるので、
その辺をうまいことクエリで弾いてあげられたらもっと分かりやすいのかもしれない。
修行します。
まとめ
今回はここまでで力尽きました。いいのかこんなことで...
ラブホの立地の奥深さが分かって頂けたでしょうか。
私的にはさらに謎が深まってきてます。
なんとなく直感的に
「ラブホっぽい立地」とか「この建物ラブホだろたぶん」みたいな
そういう感覚はあるもので、
その「っぽさ」が何なのか、個人的には大変気になります。
まじめ。
おわり
アドベントカレンダーなのにお恥ずかしい限り。
SappoRoR#5に行ってきました<資料
先日SappoRoRに行ってきました。
年2回目開催!!!
めでたい!!!!!
楽しかったです。みなさん大変お世話になってます。。。
広島関西の先生方ありがとうございました。
@R_beginnerさんのカルテどんどん進化しててわくわくするなあ。。すごいなあ。。
札幌のみなさんごはんに行きましょう...ともだち..トモダチホシイ
今回はうっかりLTをしてしまったので遅ればせながら資料を載せて逃げます。
おわり
許して。ころさないで。
【plotly,ggplot2】チョコレート狂と肥満のイケナイ関係をグリグリ動くplotにしてサイトに埋め込みたい
11月です。
キャンプをしに海を越えてやって来た友人が、
「いや、まだ死にたくない」
との言葉を残してホテルを取ったくらいには、冬です。
試される大地が結構本気を出してきているので、
近々北海道に出張のご予定がある方は防寒に気を付けてください。
「インタラクティブな可視化」とは
グリグリ動く図、いわゆる「インタラクティブな図」というものを
見たり耳にしたりはしていたんですが、
見せる相手も居なければ
埋め込むの難しそうだし。。。
なんとなくあまり触らずにいました。
{leaflet}でラブホデータ動かしておおお、って思ったくらい。
しかしながら。
最近
TokyoRで@teramonagiさんが{dygraph}で時系列グラフをグリグリ動かしたり、
@dichikaさんが{leaflet}で巡回経路をグリグリ動かしたり、
id:yutannihilationさんが{leaflet}でチョコ狂地図をグリグリ動かしたり、
しているのを見て
かっこいい!!!
やっぱ動くのかっこいいよ!!!!!
という
ガンダムを見た子供のような気持ちになったので、
勇気を出して動かしてみようと思います。
今回のテーマ
・{plotly}を使ってみよう
・{plotly}と{ggplot2}の表記の違いとか表示の違いとかを見てみる
Plotlyなるデータをオンライン経由でplot出来るサービスがあります。
特徴は作成した図を別なWEBとかに埋め込めること。と
ggplot2を使えること!!!!
そのPlotlyをRから使えるぜ、というのが{plotly}です。
以上です。
初めて使うから
今回はもう...動かしてみられれば...いいかな...
志は低めに...
まずアカウント登録と導入
①https://plot.ly/にアクセス
②アカウントを作成
③API SettingsからAPI Keyを取得。
あとはgithubから{plotly}を手に入れて
アカウントとAPIKeyを入力します。
>library(devtools) >devtools::install_github("ropensci/plotly") #なんかplotly()は廃止されたからplot_ly使えって怒られた >plotly::plot_ly(username = "ID", key = "API Key")
plotly()はplot_ly()になったみたい。
warningが出ます。
データ
データを集める元気がなかったので前回のを引きずり出して使います。wafdata.hatenablog.com
各都道府県のチョコレート消費額と各都道府県の肥満率をくっつけたやつです。
あれこれありますが
今回使う変数はこのへん。
Expenditure:::各都道府県のチョコレート類全般の消費額
class_a :::チョコレート全般の消費額を離散化して1~3のグループにしたもの
himan :::各都道府県の肥満率
class_himan:::肥満率を離散化して1~3のグループにしたもの
> himan_map ID areaname chiho area Expenditure1 Expenditure2 Expenditure class_1 class_2 class_a himan class_himan 1 1 北海道 hokkaido 札幌市 5478 1976 7454 2 3 3 0.385 3 2 2 青森県 tohoku 青森市 3471 1125 4596 1 1 1 0.380 3 3 3 岩手県 tohoku 盛岡市 4317 1359 5676 1 2 1 0.387 3 4 4 宮城県 tohoku 仙台市 5064 1499 6563 2 2 2 0.395 3 5 5 秋田県 tohoku 秋田市 4639 1214 5853 2 1 1 0.312 2 6 6 山形県 tohoku 山形市 5697 1721 7418 3 3 3 0.293 1 7 7 福島県 tohoku 福島市 4922 1373 6295 2 2 2 0.403 3 8 8 茨城県 kantou 水戸市 4807 1222 6029 2 1 2 0.312 2 9 9 栃木県 kantou 宇都宮市 5797 1713 7510 3 3 3 0.405 3 10 10 群馬県 kantou 前橋市 4839 1152 5991 2 1 2 0.296 1 11 11 埼玉県 kantou さいたま市 5239 1185 6424 2 1 2 0.310 2 12 12 千葉県 kantou 千葉市 4634 1196 5830 2 1 1 0.317 2 13 13 東京都 kantou 東京都区部 5248 1123 6371 2 1 2 0.305 2 14 14 神奈川県 kantou 横浜市 4729 1165 5894 2 1 2 0.303 2 15 15 新潟県 tyubu 新潟市 4801 1162 5963 2 1 2 0.277 1 16 16 富山県 tyubu 富山市 5634 1683 7317 3 3 3 0.296 1 17 17 石川県 tyubu 金沢市 6543 1906 8449 3 3 3 0.284 1 18 18 福井県 tyubu 福井市 5235 1612 6847 2 2 2 0.225 1 19 19 山梨県 tyubu 甲府市 5057 1343 6400 2 2 2 0.272 1 20 20 長野県 tyubu 長野市 5251 1474 6725 2 2 2 0.257 1 21 21 岐阜県 tyubu 岐阜市 4805 1229 6034 2 1 2 0.292 1 22 22 静岡県 tyubu 静岡市 4733 1156 5889 2 1 2 0.252 1 23 23 愛知県 tyubu 名古屋市 5091 1148 6239 2 1 2 0.294 1 24 24 三重県 kansai 津市 4987 1355 6342 2 2 2 0.292 1 25 25 滋賀県 kansai 大津市 4652 1395 6047 2 2 2 0.230 1 26 26 京都府 kansai 京都市 5455 1188 6643 2 1 2 0.256 1 27 27 大阪府 kansai 大阪市 4096 943 5039 1 1 1 0.314 2 28 28 兵庫県 kansai 神戸市 4880 1182 6062 2 1 2 0.277 1 29 29 奈良県 kansai 奈良市 5620 1555 7175 3 2 3 0.326 2 30 30 和歌山県 kansai 和歌山市 4501 1100 5601 2 1 1 0.315 2 31 31 鳥取県 tyugoku 鳥取市 5381 1757 7138 2 3 2 0.251 1 32 32 島根県 tyugoku 松江市 4539 1580 6119 2 2 2 0.278 1 33 33 岡山県 tyugoku 岡山市 4619 1466 6085 2 2 2 0.275 1 34 34 広島県 tyugoku 広島市 5313 1308 6621 2 2 2 0.294 1 35 35 山口県 tyugoku 山口市 5853 1950 7803 3 3 3 0.221 1 36 36 徳島県 shikoku 徳島市 4477 1558 6035 1 2 2 0.401 3 37 37 香川県 shikoku 高松市 5479 1344 6823 2 2 2 0.254 1 38 38 愛媛県 shikoku 松山市 5039 1668 6707 2 3 2 0.330 2 39 39 高知県 shikoku 高知市 5428 1933 7361 2 3 3 0.376 3 40 40 福岡県 kyusyu 福岡市 4232 1035 5267 1 1 1 0.298 2 41 41 佐賀県 kyusyu 佐賀市 4703 1537 6240 2 2 2 0.313 2 42 42 長崎県 kyusyu 長崎市 4076 974 5050 1 1 1 0.365 2 43 43 熊本県 kyusyu 熊本市 4576 1081 5657 2 1 1 0.337 2 44 44 大分県 kyusyu 大分市 5377 1557 6934 2 2 2 0.373 2 45 45 宮崎県 kyusyu 宮崎市 4536 1248 5784 2 1 1 0.447 3 46 46 鹿児島県 kyusyu 鹿児島市 5237 1630 6867 2 2 2 0.335 2 47 47 沖縄県 okinawa 那覇市 4174 1035 5209 1 1 1 0.452 3
バブルチャート
まずは{plotly}をとりあえず描いてみるべく
チョコレート消費額と肥満率の関係をバブルチャートにしてみた。
>plot_ly(himan_map, x = Expenditure, y = himan, text = paste("area: ", areaname), mode = "markers", color = class_himan, size = himan, filename="r-docs/himan-bubble-text")
実行して
success!!
ってなったらブラウザが立ち上がって図を表示してくれます。
でもって
表示された図の右下「<>」を押すとサイト埋め込み用のコードが表示されるので
埋め込んでみたりなんかして。
埋め込めた。。。
ggplot2からplotlyへの連携
とりあえず描いてはみたけど、
plot_ly()の文法に慣れないのでggplot2の描き方で描いてみたい。
もはやggplot2を動かしたい。
ggplot2のオブジェクト"p"とかを ggplotly(p) するといけるらしい。
p <- ggplot(himan_map, aes(x = Expenditure, y = himan)) + geom_point(aes(text = paste("area:", areaname)),colour= himan_map$class_himan, size = 4) + geom_smooth(method="lm",se=TRUE) (pp <- ggplotly(p))ggplot2が動いてる!!!!!
見た目と表記の比較
同じデータで同じ箱ひげ図をplot_ly()とggplotly()で描いてみました。
絶妙に違う....。
#ggplot2で箱ひげ図 g <- ggplot(himan_map, aes(x = class_a, y = himan)) + geom_boxplot(aes(fill = class_a)) (gg <- ggplotly(g))
#plot_lyで箱ひげ図 plot_ly(himan_map, y = himan, color = class_a, type = "box")
こんな感じです。
サンプルレベルで恐縮ですがご査収ください。
コロプレス図も描けるっぽいから描きたかったけど修行が足りなかった...
あとでゆっくりやります。
日本って"jpn"指定でいけるのかなあ
おわりに
作った図を見てると、
チョコ消費額と肥満率に相関が把握できなそうなのはまあいいとして、
大事なのは
少なからず正の相関では...なさげ...!
外れ値レベルでチョコを食べてる石川県でさえ肥満クラスはS。
希望を持って生きよう。
チョコレートの季節だ。