【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。
希望を持って生きよう。
チョコレートの季節だ。
【Nippon,infotheo,tidyr】チョコレート狂が生きていきやすい場所を探す
ここ2週間ほど
バグの地雷原とログの森で迷子になっている間に、
札幌では初雪が降りました。
まだ夏が終わったのを受け入れていないのになんてことだ。
ということで
冬の楽しみを一生懸命考えてみました。
クリスマス → いい子にしていたからきっと12/25にはPS4が枕元にあるに違いない
スキー → 行く。
バレンタイン→ ???
???
そ う だ バ レ ン タ イ ン が あ る
バレンタインは恋人たちだけのものじゃない。
私は世界で一番チョコレートが好きだ。
チョコレートの海で溺れて死にたい。
ということでチョコレートを死ぬほど食べても恥ずかしくないエリアを探します。
テーマ
チョコレートの消費額の多いエリアを可視化
あんま目新しいことはしないです。
さくっとやる
> choco_1 #チョコレートの消費額 area Expenditure1 1 金沢市 6543 2 山口市 5853 3 宇都宮市 5797 4 山形市 5697 5 富山市 5634 6 奈良市 5620 7 高松市 5479 8 札幌市 5478 9 京都市 5455 10 高知市 5428 11 川崎市 5388 12 鳥取市 5381 13 大分市 5377 14 広島市 5313 15 長野市 5251 16 東京都区部 5248 17 さいたま市 5239 18 鹿児島市 5237 19 福井市 5235 20 名古屋市 5091 21 仙台市 5064 22 甲府市 5057 23 松山市 5039 24 津市 4987 25 福島市 4922 26 神戸市 4880 27 浜松市 4849 28 前橋市 4839 29 水戸市 4807 30 岐阜市 4805 31 新潟市 4801 32 静岡市 4733 33 横浜市 4729 34 佐賀市 4703 35 大津市 4652 36 秋田市 4639 37 千葉市 4634 38 岡山市 4619 39 熊本市 4576 40 松江市 4539 41 宮崎市 4536 42 和歌山市 4501 43 徳島市 4477 44 盛岡市 4317 45 福岡市 4232 46 那覇市 4174 47 堺市 4133 48 大阪市 4096 49 長崎市 4076 50 北九州市 3952 51 青森市 3471 > choco_2 #チョコレート菓子類の消費額 area Expenditure2 1 札幌市 1976 2 山口市 1950 3 高知市 1933 4 金沢市 1906 5 鳥取市 1757 6 山形市 1721 7 宇都宮市 1713 8 富山市 1683 9 松山市 1668 10 浜松市 1646 11 鹿児島市 1630 12 福井市 1612 13 松江市 1580 14 徳島市 1558 15 大分市 1557 16 奈良市 1555 17 佐賀市 1537 18 仙台市 1499 19 長野市 1474 20 岡山市 1466 21 川崎市 1445 22 大津市 1395 23 福島市 1373 24 盛岡市 1359 25 津市 1355 26 高松市 1344 27 甲府市 1343 28 広島市 1308 29 宮崎市 1248 30 岐阜市 1229 31 水戸市 1222 32 秋田市 1214 33 千葉市 1196 34 京都市 1188 35 さいたま市 1185 36 神戸市 1182 37 横浜市 1165 38 新潟市 1162 39 静岡市 1156 40 前橋市 1152 41 名古屋市 1148 42 青森市 1125 43 東京都区部 1123 44 和歌山市 1100 45 熊本市 1081 46 堺市 1045 47 福岡市 1035 48 那覇市 1035 49 長崎市 974 50 大阪市 943 51 北九州市 923
県庁所在地の他、政令指定都市が混ざってます。
なんかの時に作った県庁所在地→都道府県→地方変換マスタがあったので今回はそれとマージして都道府県名に変換。
#都道府県マスタ----------------------------------------------- master<-read.csv("ID.csv",header=FALSE) colnames(master)<-c("ID","areaname","chiho","area") #マージと合計行の追加------------------------------------------ choco_map<-master %>% dplyr::left_join(.,choco_1,by="area") %>% dplyr::left_join(.,choco_2,by="area") %>% dplyr::mutate(.,Expenditure=Expenditure1+Expenditure2) #-------------------------------------------------------------- > choco_map ID areaname chiho area Expenditure1 Expenditure2 Expenditure 1 1 北海道 hokkaido 札幌市 5478 1976 7454 2 2 青森県 tohoku 青森市 3471 1125 4596 3 3 岩手県 tohoku 盛岡市 4317 1359 5676 4 4 宮城県 tohoku 仙台市 5064 1499 6563 5 5 秋田県 tohoku 秋田市 4639 1214 5853 6 6 山形県 tohoku 山形市 5697 1721 7418 7 7 福島県 tohoku 福島市 4922 1373 6295 8 8 茨城県 kantou 水戸市 4807 1222 6029 9 9 栃木県 kantou 宇都宮市 5797 1713 7510 10 10 群馬県 kantou 前橋市 4839 1152 5991 11 11 埼玉県 kantou さいたま市 5239 1185 6424 12 12 千葉県 kantou 千葉市 4634 1196 5830 13 13 東京都 kantou 東京都区部 5248 1123 6371 14 14 神奈川県 kantou 横浜市 4729 1165 5894 15 15 新潟県 tyubu 新潟市 4801 1162 5963 16 16 富山県 tyubu 富山市 5634 1683 7317 17 17 石川県 tyubu 金沢市 6543 1906 8449 18 18 福井県 tyubu 福井市 5235 1612 6847 19 19 山梨県 tyubu 甲府市 5057 1343 6400 20 20 長野県 tyubu 長野市 5251 1474 6725 21 21 岐阜県 tyubu 岐阜市 4805 1229 6034 22 22 静岡県 tyubu 静岡市 4733 1156 5889 23 23 愛知県 tyubu 名古屋市 5091 1148 6239 24 24 三重県 kansai 津市 4987 1355 6342 25 25 滋賀県 kansai 大津市 4652 1395 6047 26 26 京都府 kansai 京都市 5455 1188 6643 27 27 大阪府 kansai 大阪市 4096 943 5039 28 28 兵庫県 kansai 神戸市 4880 1182 6062 29 29 奈良県 kansai 奈良市 5620 1555 7175 30 30 和歌山県 kansai 和歌山市 4501 1100 5601 31 31 鳥取県 tyugoku 鳥取市 5381 1757 7138 32 32 島根県 tyugoku 松江市 4539 1580 6119 33 33 岡山県 tyugoku 岡山市 4619 1466 6085 34 34 広島県 tyugoku 広島市 5313 1308 6621 35 35 山口県 tyugoku 山口市 5853 1950 7803 36 36 徳島県 shikoku 徳島市 4477 1558 6035 37 37 香川県 shikoku 高松市 5479 1344 6823 38 38 愛媛県 shikoku 松山市 5039 1668 6707 39 39 高知県 shikoku 高知市 5428 1933 7361 40 40 福岡県 kyusyu 福岡市 4232 1035 5267 41 41 佐賀県 kyusyu 佐賀市 4703 1537 6240 42 42 長崎県 kyusyu 長崎市 4076 974 5050 43 43 熊本県 kyusyu 熊本市 4576 1081 5657 44 44 大分県 kyusyu 大分市 5377 1557 6934 45 45 宮崎県 kyusyu 宮崎市 4536 1248 5784 46 46 鹿児島県 kyusyu 鹿児島市 5237 1630 6867 47 47 沖縄県 okinawa 那覇市 4174 1035 5209
チョコレート、チョコレート菓子、チョコ類合計額があるけど、
このままだと可視化した時に見づらいので離散化して均等な額ごとのグループにまとめます。
#消費額のクラス分け-------------------------------------------- class_1<-infotheo::discretize(subset(choco_map,select=Expenditure1),disc="equalwidth") class_2<-infotheo::discretize(subset(choco_map,select=Expenditure2),disc="equalwidth") class_a<-infotheo::discretize(subset(choco_map,select=Expenditure),disc="equalwidth") colnames(class_1)<-"class_1" colnames(class_2)<-"class_2" colnames(class_a)<-"class_a" > choco_map<-dplyr::bind_cols(choco_map,class_1,class_2,class_a);head(choco_map) ID areaname chiho area Expenditure1 Expenditure2 Expenditure class_1 class_2 class_a 1 1 北海道 hokkaido 札幌市 5478 1976 7454 2 3 3 2 2 青森県 tohoku 青森市 3471 1125 4596 1 1 1 3 3 岩手県 tohoku 盛岡市 4317 1359 5676 1 2 1 4 4 宮城県 tohoku 仙台市 5064 1499 6563 2 2 2 5 5 秋田県 tohoku 秋田市 4639 1214 5853 2 1 1 6 6 山形県 tohoku 山形市 5697 1721 7418 3 3 3
額が小さい順に1→2→3のグループが出来たので可視化します。
今回は(も){Nippon}パッケージ。
デフォルトの色を変えてみたくて試行錯誤しましたがなんか直接色指定することしか成功しなかった...
#コロプレス(色指定がしたい)---------------------------------------------------- cols <- rev(RColorBrewer::brewer.pal(3,"Set2")) choco_map$class_1<-gsub("1",cols[1],choco_map$class_1) choco_map$class_1<-gsub("2",cols[2],choco_map$class_1) choco_map$class_1<-gsub("3",cols[3],choco_map$class_1) #描画 Nippon::JapanPrefecturesMap(col = choco_map$class_1,axes=FALSE) #チョコレート消費額 Nippon::JapanPrefecturesMap(col = choco_map$class_a) #チョコレート全般消費額
上が{RColorBrewer}のセットで色指定したやつ、下がデフォルトです。
なんかこんなやり方じゃなくていい気がする。。。むむむ
しかもちょっと待って。
地元が一番チョコレート食べてないエリアってどういうことなの、ねえ岩手。。。私が居なくなったから...?
地域性は特になさそう。。というか額の幅を均等にすると、ほとんど「2」に分類されてるから
極端に多いところと、極端に少ないところが目立つ感じに。
とりあえず金沢に行けばチョコレートを死ぬほど食べても浮くことはなさそう。
おまけ
「そんなチョコレート食べたら太るよ」って散々言われるので
都道府県別の肥満率をクラス分けしてクロス集計でもしてみた。
このへんの書き方、
table()から{tidyr}に移行していきたいなあと。
データ元は同じくe-statの国民健康・栄養調査(2010年)より。
> himan areaname himan 1 沖縄県 0.452 2 宮崎県 0.447 3 栃木県 0.405 4 福島県 0.403 5 徳島県 0.401 6 宮城県 0.395 7 岩手県 0.387 8 北海道 0.385 9 青森県 0.380 10 高知県 0.376 11 大分県 0.373 12 長崎県 0.365 13 熊本県 0.337 14 鹿児島県 0.335 15 愛媛県 0.330 16 奈良県 0.326 17 千葉県 0.317 18 和歌山県 0.315 19 大阪府 0.314 20 佐賀県 0.313 21 秋田県 0.312 22 茨城県 0.312 23 埼玉県 0.310 24 東京都 0.305 25 神奈川県 0.303 26 福岡県 0.298 27 富山県 0.296 28 群馬県 0.296 29 広島県 0.294 30 愛知県 0.294 31 山形県 0.293 32 三重県 0.292 33 岐阜県 0.292 34 石川県 0.284 35 島根県 0.278 36 兵庫県 0.277 37 新潟県 0.277 38 岡山県 0.275 39 山梨県 0.272 40 長野県 0.257 41 京都府 0.256 42 香川県 0.254 43 静岡県 0.252 44 鳥取県 0.251 45 滋賀県 0.230 46 福井県 0.225 47 山口県 0.221 #チョコマップとくっつける himan_map<-dplyr::left_join(choco_map,himan,by="areaname") #肥満率もクラス分け class_himan<-infotheo::discretize(subset(himan_map,select=himan),disc="equalwidth") colnames(class_himan)<-"class_himan" #クラスもくっつける himan_map<-dplyr::bind_cols(himan_map,class_himan) #クロス集計------------------------------------------------------- himan_map$class_himan<-gsub("1","S",himan_map$class_himan) himan_map$class_himan<-gsub("2","M",himan_map$class_himan) himan_map$class_himan<-gsub("3","L",himan_map$class_himan) > dplyr::count(himan_map,class_a,class_himan) %>% + tidyr::spread(.,class_himan,n) %>% + dplyr::select(.,class_a,S,M,L) Source: local data frame [3 x 4] class_a S M L 1 1 NA 7 4 2 2 17 8 3 3 3 4 1 3
最後にselect()したら並び順を変えられた。今更いいこと覚えた。
そして今気づいたけどクラス内の個数にだいぶ偏りがあるのに
単純にクロス集計なんてするもんじゃなかった。。
でもなんかクラス2とか肥満率Sが多いよ、ほら。
ほどほどチョコ食べたらむしろいいんじゃない、、いやなんでもないです。
追記
もっかい回したら謎の")"でエラーが出たので修正しまぴた。
class_himan<-infotheo::discretize(subset(himan_map,select=himan),disc="equalwidth")
colnames(class_himan)<-"class_himan"
こういう処理を外出しせずに、
mutate()とかの中にうまく入れてしまいたいんだけどどうにもうまくいかなかった..
infotheo::discretizeの戻り値の列名が分割元の列と同じになるのを制御したかったりするんだけどなあ..