次元の海で溺れる

Rとデータ解析と統計手法たちとわたし

【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()

f:id:WAFkw:20160131172023p:plain


取得したシェープファイルを描画する。
JapanPrefectureMapでの描画に比べて、沖縄が定位置にある。

plot(m,col=gray(0.8))


f:id:WAFkw:20160131172148p:plain


これをこんな感じで二つに分けたい。

f:id:WAFkw:20160131172507p:plain


(こんな感じ)

そのままぱっかーんてすると罰当たりな感じがするので
もうちょっとささやかな感じで分けたい。

ということで、
ぱっかーんと分けた日本を、サブプロットとして埋め込むことを検討する。


分けたいところの座標を取得

「この辺!!特に何もないけどこの辺で分けたいんだよ!!」

という時は、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で囲んでね!としている。
これで描画するとこんな感じ。


f:id:WAFkw:20160131173432p:plain


ぱっかーん


できた。
いい。いいよ、ささやかだよ。


でもなんかすごい悪いことをした気持ちになる。

やはり世の中の事象を単純に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))

f:id:WAFkw:20160131174124p:plain


さっきと同じやり方をすると、沖縄が二つに分身してしまう。



これは元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))

f:id:WAFkw:20160131174153p:plain


できた。

他のplotでもこんな感じでlocatorで座標取得してよきに指定すれば
便利なことが多々あるかもしれない。

という話。(だったことにする)

【reshape2,tidyr】 豆について考える(番外編)~溶けるの概念を見失った時のためのメモ~

前回の記事を書いていて、
2年前に

「reshape2::meltってなんだ。そもそもmeltってなんだ、溶けるってなんだ」

という、鳥はなぜ空を飛ぶの的な疑問に直面してたのを思い出したので、自分用メモ。

溶かすとは

当時釈然としてなかったのは、reshape2::meltを「えくせる的な行列入れ替え」と解釈していたことに端を発する。

◎えくせる的な行列入れ替え

f:id:WAFkw:20160121233012p:plain

◎reshape2::meltでの変換

f:id:WAFkw:20160121233133p:plain

・・・ちがうじゃんと。
思ってたのと違うじゃんと。

こんな変換誰が使うんだよと。 (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|

使いどころ

こちらも前回の話だけど、
上記データの状態から積み上げ棒グラフを書きたいと思ったとき。

f:id:WAFkw:20160101040839p:plain

考えるのは、

・列名を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)

明けまして、おめでとうございます。

気付いたら年が明けていました。恐ろしい話です。

さて、正月なので実家では煮豆が食卓に並ぶなどしているのですが、
そこでそういえば大豆について真剣に考えたこと無いな、と箸が止まりました。

大豆からの加工食品ってやたらたくさんあるよね?
大豆たくさん作ってるとこと加工品たくさん作ってるとこって一致する?の?

もう煮豆をつまんでいる場合ではありません。
気になったことはすぐ調べろってえらい人も言ってた。

大豆のデータ集を発見

普通にググって終わろうと思ってたらなんか大豆データが芋づる式に出てきた。
農林水産省/大豆関連データ集

PDFだけど謎の充実度である。何か色々できそう。

今回のテーマ

・取り急ぎ大豆加工品についてのデータ集めつつ、今まであまりやってなかった系の可視化の操作をしてみる。

次回以降は地図と組み合わせて色々見てみたい。今回はその前段階として。

大豆加工品いろいろ

大豆から派生する加工品について、フロー図で見てみる。
Windowsでは日本語の文字化けがツラかったのでUbuntuで動かしてみた。

>library(DiagrammeR)
>DiagrammeR("
   graph LR
     大豆-->醤油
     大豆-->味噌
     大豆-->納豆
     大豆-->豆腐
     豆腐-->油揚げ
     豆腐-->豆乳
")

f:id:WAFkw:20160101033941p:plain

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")))

f:id:WAFkw:20160101035603p:plain

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)")

f:id:WAFkw:20160101040839p:plain

年分をきっちり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")

f:id:WAFkw:20160101042127p:plain

こうすると「パイのでかさ」がそれぞれの加工品カテゴリの消費量を現したちょっと見辛いグラフが出来る。
これを年別で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)

f:id:WAFkw:20160101042943p:plain

(わかっちゃいたけど見えない)

オブジェクトに連番を振る、というか動的にオブジェクトを増やすやり方、
他にもスマートなやり方があるのかもしれませんが...とりあえず

(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)

f:id:WAFkw:20160101045945p:plain

繰り返し処理の中身は①と同じで、それをまとめてlistにぶっこんでいます。
で、do.coll()にそのリストを渡せばリスト各要素を取ってきてfunctionを適用してくれるぜ...のつもりだったんだけど
list(graph.mame,~)で渡したら盛大に怒られた。

ぐるぐる悩んで下記にて解決...grid.Grob()側の最初の引数が可変長....むずかしい...

qiita.com

とりあえず①、②でもいけた。②の方がメジャーなやり方なのかしら...

おわり

次回は大豆収穫量のデータも都道府県データでなんかする。よてい。

正月っぽい話

去年の1月、2月あたりは卒論にのめりこんでみたり、出し終わった直後に知恵熱で倒れてみたり
その後一か月一人旅と称して失踪したりしていた。。気がする。。
今年は取り急ぎ行き倒れないのが目標。

※R関連でお会いした皆さま本当にありがとうございました。FOSS4Gも今年は行けたらいいな
※このまま日々を過ごしていたら平気で数年経ちそうで恐い。人間的成長みたいなものは。どこへ。

なにはともあれ「Rが趣味」というのを勇気を出して言えたのが大きかった1年でありました。
今年はなんとか地面を見つけたいところ。

2016年は何かしらの決断をする、はず

【leaflet】ラブホマップ(改)~orverpass turboを添えて~

R Advent Calendar 2015 - Qiita 16日目の記事です。

初めてなので勝手が分からない。。

今回のテーマ

これの続きをやります。

wafdata.hatenablog.com


ただやるだけだと日々進歩の無い人間だということが露呈してしまうので
小さいテーマとして

  • シェープファイルの属性テーブルに別なデータをマージしてみる
  • 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)

f:id:WAFkw:20151216001625p:plain


とりあえず描けました。

うーん
南東側は地価の変化がほとんど無いのでコロプレス感が出ませんでした。
肝心のラブホも地価の高い千葉、松戸あたりに集中しているかといえばそうでもない、、
かといって郊外にあるかといえばそうでもない、、といった感じです。

気を取り直して、
学校のそばにラブホは置けないんじゃないか説を考えてみます。

噂によると200M離さないといけないらしい...ほう...?

orverpass turboから学校のデータを抽出編

先日縁あってFOSS4Gの会に混ぜて頂いたのですが、
そこで「ジオコーディングが手間ならoverpass turboのタグで抜けばいいじゃない」みたいな話が出たのでやってみます。

overpass turbo 、みんな大好きopenstreetmapのデータを抜いてくることが出来ます。
Rでは無いので深くは語りませんがこんな感じ、、


f:id:WAFkw:20151216003526p:plain

学校のデータを抜きたいので「amenity="school"」のタグを指定、
千葉付近だけでいいので範囲指定をします。

f:id:WAFkw:20151216003938p:plain

これで実行するとデータが抜いてこれるのですが、そのとき右ウィンドウに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)

f:id:WAFkw:20151216005221p:plain


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")


f:id:WAFkw:20151216005352p:plain


近づく


f:id:WAFkw:20151216005413p:plain


確かに200Mくらいは離れている気がしなくもない。

が。

ここからは「半径200Mの円」みたいなものが欲しくなる...
うう...

amenity="school"だと予備校や塾が稀に混ざってくるので、
その辺をうまいことクエリで弾いてあげられたらもっと分かりやすいのかもしれない。
修行します。

まとめ


今回はここまでで力尽きました。いいのかこんなことで...

ラブホの立地の奥深さが分かって頂けたでしょうか。
私的にはさらに謎が深まってきてます。

なんとなく直感的に
「ラブホっぽい立地」とか「この建物ラブホだろたぶん」みたいな
そういう感覚はあるもので、
その「っぽさ」が何なのか、個人的には大変気になります。

まじめ。

おわり

アドベントカレンダーなのにお恥ずかしい限り。

SappoRoR#5に行ってきました&LT資料

先日SappoRoRに行ってきました。

年2回目開催!!!
めでたい!!!!!

楽しかったです。みなさん大変お世話になってます。。。

広島関西の先生方ありがとうございました。
@R_beginnerさんのカルテどんどん進化しててわくわくするなあ。。すごいなあ。。


札幌のみなさんごはんに行きましょう...ともだち..トモダチホシイ



今回はうっかりLTをしてしまったので遅ればせながら資料を載せて逃げます。

おわり

許して。ころさないで。

【plotly,ggplot2】チョコレート狂と肥満のイケナイ関係をグリグリ動くplotにしてサイトに埋め込みたい

11月です。


キャンプをしに海を越えてやって来た友人が、

「いや、まだ死にたくない」

との言葉を残してホテルを取ったくらいには、冬です。

試される大地が結構本気を出してきているので、
近々北海道に出張のご予定がある方は防寒に気を付けてください。

インタラクティブな可視化」とは

グリグリ動く図、いわゆる「インタラクティブな図」というものを
見たり耳にしたりはしていたんですが、

見せる相手も居なければ
埋め込むの難しそうだし。。。

なんとなくあまり触らずにいました。
{leaflet}でラブホデータ動かしておおお、って思ったくらい。

しかしながら。

最近

TokyoRで@teramonagiさんが{dygraph}で時系列グラフをグリグリ動かしたり、
@dichikaさんが{leaflet}で巡回経路をグリグリ動かしたり、
id:yutannihilationさんが{leaflet}でチョコ狂地図をグリグリ動かしたり、

notchained.hatenablog.com

しているのを見て

かっこいい!!!
やっぱ動くのかっこいいよ!!!!!

という
ガンダムを見た子供のような気持ちになったので、
勇気を出して動かしてみようと思います。

今回のテーマ

・{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!!
ってなったらブラウザが立ち上がって図を表示してくれます。

でもって

表示された図の右下「<>」を押すとサイト埋め込み用のコードが表示されるので
埋め込んでみたりなんかして。


himan vs Expenditure

おおお
埋め込めた。。。

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))


himan vs Expenditure

ggplot2が動いてる!!!!!

見た目と表記の比較

同じデータで同じ箱ひげ図をplot_ly()とggplotly()で描いてみました。
絶妙に違う....。

#ggplot2で箱ひげ図
g <- ggplot(himan_map, aes(x = class_a, y = himan)) +
  geom_boxplot(aes(fill = class_a))

(gg <- ggplotly(g))


himan vs class_a

#plot_lyで箱ひげ図
plot_ly(himan_map, y = himan, color = class_a, type = "box")


3, 2, 1

こんな感じです。
サンプルレベルで恐縮ですがご査収ください。

コロプレス図も描けるっぽいから描きたかったけど修行が足りなかった...
あとでゆっくりやります。

日本って"jpn"指定でいけるのかなあ

おわりに

作った図を見てると、

チョコ消費額と肥満率に相関が把握できなそうなのはまあいいとして、

大事なのは

少なからず正の相関では...なさげ...!

外れ値レベルでチョコを食べてる石川県でさえ肥満クラスはS。

希望を持って生きよう。
チョコレートの季節だ。

【Nippon,infotheo,tidyr】チョコレート狂が生きていきやすい場所を探す

ここ2週間ほど
バグの地雷原とログの森で迷子になっている間に、

札幌では初雪が降りました。

まだ夏が終わったのを受け入れていないのになんてことだ。


ということで
冬の楽しみを一生懸命考えてみました。

クリスマス → いい子にしていたからきっと12/25にはPS4が枕元にあるに違いない

スキー   → 行く。

バレンタイン→ ???

???

そ う だ バ レ ン タ イ ン が あ る

バレンタインは恋人たちだけのものじゃない。
私は世界で一番チョコレートが好きだ。
チョコレートの海で溺れて死にたい。

ということでチョコレートを死ぬほど食べても恥ずかしくないエリアを探します。

テーマ

チョコレートの消費額の多いエリアを可視化

あんま目新しいことはしないです。

データ

e-statから以下を取得
家計調査品目別都道府県庁所在市及び政令指定都市(※)ランキング平成24年(2012年)~26年(2014年)平均)

さくっとやる

> 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) #チョコレート全般消費額


f:id:WAFkw:20151026233449p:plain

f:id:WAFkw:20151026233458p:plain

上が{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の戻り値の列名が分割元の列と同じになるのを制御したかったりするんだけどなあ..