次元の海で溺れる

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

【leaflet,ggplot2,ggmap】いたいけな気持ちでラブホテルのデータを集めてみた

毎度お馴染みの札幌からお届けしてます。(現在5℃)
さむい。ほんとさむい。

TokyoRに行ってきました

先日、第51回TokyoRに初参戦してきました。

一緒に行った竹馬の友が会場目前にしてぽつりと

「Rよりモテそうな趣味見つけようかと思って...」

と呟いた時はどうなることかと思いましたが、
最終的には誰よりもテンション高かったので皆様への感謝が止まりません。


モテそうな趣味ってなんだよ私だってモテたいよ。(消音)


勉強になること多すぎたのでちょこちょこDocument読んだり自分でも書いてみたりしつつ、
とりあえず目下、Generated Variables使いこなせるようになりたい...


SappoRoRにも行きます

11/14(土)らしいです。

年2回目開催!!!

関係者各位よろしくお願いします。
なんか納得いく資料できたらLTやりたい..かも..しれない...

本題

今回のテーマは「ラブホテル」です。

※やましい気持ちはありません
※いやらしい気持ちはありません

極めて純粋でいたいけな気持ちです。
極めて純粋でいたいけな気持ちです。

よし。


きっかけは
TokyoRに向かう、成田空港→東京のバスの道中にて。

私「なんかラブホばっかりあってすごい」


高速道路脇にラブホ多くない?なんで?すごくない?
ってなったので、

まず
「本当に千葉の高速道路脇にはラブホが多いのか論」
について考えてみました。

前提

前回エントリとかとあんま変わんない感じで

スクレイピングやら一部手作業で千葉全域のラブホテル255件取得
②前処理
③GoogleAPIで文字列ベクトルを座標に変換
④評価点と平日一泊の料金をマージ

平日一泊の料金がうまく取得出来たものが、このうち59件だったので
今回はこれを使います。

> location_love
        lat      lon  pt price
1  35.78402 140.3352 4.5  6000
2  35.80085 139.9191 4.5  7000
3  35.85322 140.4687 4.3  3880
4  35.91815 139.9271  NA  6450
5  35.48728 140.0462 5.0  3800
6  35.84596 140.0134 4.1  5820
7  35.44062 139.9772 3.5  4400
8  35.78536 139.8991 4.0  5700
9  35.37716 139.9362 4.1  6370
10 35.68156 140.1038 4.7  7400
11 35.82681 139.9213 4.0  6388
12 35.85934 139.9741 3.6  7700
13 35.91011 139.9380 4.7  7400
14 35.84737 139.9579  NA  6800
15 35.57963 140.1280 3.6  5250
16 35.64922 140.3053 4.6  3980
17 35.68822 139.9968 4.0  5980
18 35.65481 140.1078 4.1  5800
19 35.66906 139.9244 4.8  5980
20 35.81030 139.9156 3.5  6880
21 35.68156 140.1038 4.5  7500
22 35.79517 140.0617 4.5  9050
23 35.64458 140.5003 5.0  5500
24 35.41790 139.9408 4.5  6000
25 35.56509 140.1387 4.6  7000
26 35.38031 139.9222 5.0  4800
27 35.46777 140.0390 4.3  6000
28 35.67856 140.1265 4.8  7900
29 35.68342 140.4215 4.7  6300
30 35.57499 140.3303  NA  5500
31 35.61935 140.1264 4.9  7400
32 35.91993 139.9411 4.5  6480
33 35.85748 140.0115  NA  7800
34 35.79861 140.3392 4.0  6000
36 35.71079 140.1187 4.8  8800
37 35.70744 139.9606 3.6  5370
38 35.68763 140.0023 4.7  5800
39 35.37635 139.9365 4.2  6260
40 35.59229 140.3148  NA  7450
41 35.75037 140.3781 4.0  5380
42 35.60800 140.1194 4.6  9300
43 35.90121 139.9466 4.0  7500
44 35.41957 139.9433 4.2  6000
45 35.66947 140.1173 3.2  6800
46 35.66839 139.9241 5.0  7800
47 35.91281 139.9435 4.2  4970
48 35.68868 139.9975 3.7  5670
49 35.83821 139.9435 3.0  6500
50 35.78668 139.9019 4.8  5400
52 35.61221 140.1217 3.8  7300
53 35.67308 140.1259 4.5  7200
54 35.60908 140.1227 4.5  6500
55 35.44983 139.9938 4.0  5100
56 35.74332 140.0629  NA  8970
57 35.68150 140.1256 4.7  5900
58 35.61909 140.1259 4.5  5400
59 35.81782 139.9265 4.5  7500

{leaflet}で見てみる

まず{leaflet}に点を打ってみる。

>library(leaflet)
>m <- leaflet() %>% setView(lng = tokyo_station[,1], lat = tokyo_station[,2], zoom = 12)
>m %>% 
  addProviderTiles("CartoDB.Positron") %>% 
  addMarkers(data = location_love,~lon, ~lat,popup=~as.character(price)) 


f:id:WAFkw:20151014212242p:plain


※leafletほんとはぐりぐり動くんだけど静止画でごめんなさい...
※popupには平日一泊の料金が出るようにしてみました。

これを見ると!
高速道路&幹線道路沿いにきれいにならんでいるように見えます。

{ggmap}で見てみる

さらに詳細な道路情報とかが気になるので、{ggmap}ことgooglemapを使って見てみる。

>tokyo_map <- ggmap::get_googlemap(center = c(lon =tokyo_station[,1] , lat = tokyo_station[,2]),
                                    zoom = 9, scale = 2,maptype = "roadmap",color ="color")

>love_map<-ggmap::ggmap(tokyo_map)+geom_point(data=location_love,aes(x=lon,y=lat,colour="red"),size=5);love_map

f:id:WAFkw:20151014212349p:plain

love_mapとかいう最高のオブジェクト名...
marker引数使うの忘れてた...

こっちで見ると、黄色いラインである高速道路、幹線道路沿いなのがはっきり見て取れますね


総合すると

高速道路&幹線道路 + 松戸・柏エリア

にいわゆるラブホテルが分布してる感じでしょうか。

なんかあまりにも綺麗に道路沿いすぎて怖いぞラブホテル...
なんでこんなに道路沿いなの...みんな車なの...?

おまけ

評価点とかって、実は一泊の値段の単回帰とかであっさり予測できたりして!!!という
私の邪な期待はこんな感じで裏切られました。

>d <- ggplot2::ggplot(location_love, aes(price, pt))
>d+stat_binhex(bins = 10)

f:id:WAFkw:20151014215405p:plain

そんな単純な話じゃなさそうだ...

ICからの距離とか、繁華街からの距離、
築年数とか設備とかの要素も絡んで来るのかな-なんて。

引き続きなんか考えます。

おまけ2

今回使ったラブホテルたちの価格帯をヒストグラムなんぞにしてみました。
千葉の方、参考にしてください。

> summary(location_love$price) #中央値平均値などなど

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   3800    5670    6300    6405    7400    9300 

>library(ggthemes)
ggplot(location_love,aes(x=price,y= ..density..))+
  geom_histogram(alpha = 0.3,binwidth=500,fill="red")+
  geom_density(aes(colour="red",fill="red"),alpha=0.1,size=1.5)+
 xlim(2500,10500)+
  ggthemes::theme_solarized()

#透過はalpha引数
#{ggthemes}でplotにthemeを適用

#Generated Variablesはこういう使い方で良いのかな...

f:id:WAFkw:20151014235006p:plain

追記

ヒストグラムのサイドが切れてしまっていてむむむ、と思っていたら
@berobero11さんに教えて頂きました。qiita.com


xlim()で最小値、最大値に余裕をもたせると
端っこが切れない!!たしかに!!すごい!!

ということでヒストグラムを切れてないタイプに差し替えてます。

さらに追記

最後のヒストグラム

ヒストグラムの色とdensityの線の色を同じにできなくて、はて???
colourって普通に入れちゃだめだっけ?aesでくくんなきゃだめ?はて??ってなって謎のコードにしていたところ、
twitterにて助けて頂いたので...



(感動のわかりやすさ)
(元気のない日に読み返しまくった)

よって直します。

histgarmは変わらず。

geom_lineで線を引いてから、線なしのdensityを重ねて中に色をつけてます。
そしたらalpha指定も思うがまま!!!

ggplot(location_love,aes(x=price,y= ..density..))+
  geom_histogram(alpha=0.3, binwidth=500,fill="red") +
  geom_line(stat = "density", colour="red", alpha=0.3, size=1.5) +
  geom_density(colour = "transparent", fill="red", alpha=0.3)+
  xlim(2500,10500)+
  ggthemes::theme_solarized()

f:id:WAFkw:20151027210440p:plain


できたーー
わーーーい


ビジネスホテルの値段とかもそうだけど、
キリの悪い値段設定なんてなかなかないので、
binwidthで500円単位にカウントしないとスカスカになっちゃうなあ


おわり

私だってラブホテルを利用するチャンスがあれば現地調・・・ry

現場からは以上です。ご査収ください。

【R】【基本の前処理】しんぷるなサンプル抽出を考える

いい感じに韻を踏めたので大満足。


最近ggplot2系の派手めな記事が多かったんですが、
私の中でもっと大事にしたいことは山ほどあって
今日は今更地味なことを書きます。

卵が先か、サンプル抽出が先か

データは全数取れるに越したことはないのですが、
世の中のデータの全てがcsvやらスクレイピングで取れるなんてことは無くって。
しばしば母集団からのサンプル抽出なるものを行う羽目になります。

「15万世帯のばらばらのデータをひとつひとつ集めてくるなんて個人では無理ゲー」
「じゃあランダムに抽出した5000世帯ぶんにしよっか」

とかとか。

このサンプルサイズの設定も奥が深くて苦しみも深くてもう言いたいことは山ほどあるのですが、
あとrandomにしないでpairdするとかもあったりするのですが、ていうかpairdってやっry

...余計なことを言うのはやめます。

抽出方法も系統やら多段やらいろいろですが
今日はさくっとシンプルにrandom抽出したいねって時のScriptをメモ程度に。

Excelでの無作為抽出

よく見かけるのがExcelでやる方法です。

n個のサンプルが欲しかったら
RAND関数で乱数を発生→小さい順にソートして上からn個取ろう!みたいな。

ExcelのRAND関数も奥が深い...一様分布かつ、いかに重複しないかみたいな。仕様読むのたのしい。)

Rでやってみる

Rにも乱数の発生はいろいろあって、

一様分布ならrunif()
正規分布ならrnorm()

などなど

dplyr::manute()とかで乱数の列足してsortして~みたいな感じでやったら先述したExcelと同じ動きもできたりする

が。

RにSample関数なるものがあります。
これは1から200の連番からランダムに20個取ってきてね!みたいなことが出来る関数になります。

好きな関数のひとつなので、今日はそれで。

テーマ

上場企業1894社のIDから500社抽出したい

#データを用意

> head(data,10)
     ID
1  1301
2  1332
3  1333
4  1352
5  1377
6  1379
7  1414
8  1417
9  1419
10 1420

> tail(data,10)
       ID
1885 9984
1886 9986
1887 9987
1888 9989
1889 9990
1890 9991
1891 9993
1892 9994
1893 9995
1894 9997

#1894社のIDリストです。しかも昇順。
#このまま上から500社取っちゃうと業種が偏っちゃうよね~


#まず1から1894の連番を作る
> n<-1:1894

#その連番から500個ランダムに数を取得します。

> index<-sample(n,500);index 
  [1] 1868   78  502  380 1170  148  510   71 1499 1363  247 1344 1736  988 1782 1706 1208  123  165   44 1713
 [22]  185  589 1610 1387 1202  776 1220 1802   65   16 1615  979  919  434  654 1173  726  963 1559 1756 1467
 [43]  208 1545  923 1772  556 1693 1578  569 1765  387  426    4  178 1676 1280   26 1080 1669 1252 1808  130
 [64]  223 1256 1075  168 1889  539 1140 1402  617 1497 1634 1856  580 1627  271 1828 1101  576  483  581 1227
 [85]  491 1458 1152 1046 1131 1111 1775 1416  958 1247  249 1519 1484 1640  823  770 1614 1562  476 1838  454
[106]  652 1287 1163 1264  306 1404 1755  995 1586 1281  615  412 1103 1371 1892 1212 1059  182  423 1133  626
[127] 1268  925 1320  452  137 1514  336 1321  777  458 1463 1415  670  486 1027 1047 1068 1093  234 1481 1657
[148]  904  666   50 1623 1166 1377 1594   72  889   63  933 1366 1183 1023  728 1717  233 1611 1150 1010  408
[169]  926 1389 1688 1588   64 1253 1804 1500  744  893  821  942  273   45  787 1660 1169  467  511 1606  546
[190]  687  161  536 1277  103 1365 1025  621  890 1724 1665 1201  886  526  195 1272  342   81 1198 1102 1063
[211] 1155   12 1846  445  396   36  614 1124  950 1097 1223  503 1728 1721  515 1324  253 1205   95  849 1052
[232]  532  623  232  256 1153 1345 1584 1407 1376  419  939  221 1296  535  817 1275  354  319 1650 1476  283
[253]  573 1686   61  409 1442  339  829 1245  825   23  596 1894  561   39  151 1289  635  242 1720  606 1630
[274]  422  343  519 1830  119  406   30   82  472  390  240 1086  417  507  461 1333   28 1718  244 1644  216
[295]  320  210  713  854  672  497  802  693 1391 1125 1840  947 1290  166  921  743  987  796  633  549 1792
[316]  562  895  863  658 1674  816 1666  463  956  619   41  577 1000 1478  717  170 1524  994  525  102 1793
[337] 1791  344 1591  913  594  366 1842 1122  378  738 1477  109 1878  183  610  646 1043 1821  425 1766   32
[358]  608 1073 1525  752  235 1704  118 1196  891  348  250 1486  146 1279 1188  812  851  588   83  309  258
[379] 1848  605 1866  835 1271 1123  822  162  656  814 1331  792  847 1024  698 1241  448  141 1790  346 1329
[400] 1826  259 1482 1864  181 1430   57 1857 1457    3  735 1553 1727  285    1  512  383 1116  144  613  313
[421]   56  469 1194 1743  618 1816  827  418 1110  749  715 1156  918  528  523 1613  978  704 1739  625  564
[442]  873  498 1029  783  341 1883 1118 1157 1239 1211 1136   66 1694  788 1572   21 1647 1332  667 1831 1378
[463]  932 1642 1515 1168  872  251 1394 1570 1004 1327 1579  583  462 1603  661 1436  837  394 1249  986 1531
[484] 1367  159 1705  364  520  953 1703 1479  362 1013 1099  275 1632 1061  864 1278 1180

#この500個の整数をインデックスにして部分集合を作る

> data_sample[index,] %>>% 
   as.data.frame() ->data_sample500

> colnames(data_sample500)<-"ID" 


#ちゃんと500社に絞れてるかしら

> str(data_sample500)
'data.frame':	500 obs. of  1 variable:
 $ ID: int  8001 4549 8609 7874 6914 3371 4828 7864 1301 7251 ...


#完成

> tail(data_sample500,10)
      ID
491 3202
492 9504
493 8270
494 9997
495 6973
496 7989
497 5440
498 4826
499 2198
500 3222

この部分集合を元にデータマージしたり前処理したり色々です。

サンプルサイズ決めて
どうやって抽出するのが妥当なのか考えて
データ構造見てどうやって分析するのがいいのか考えて

みたいな

この分析の前部分が本当は一番好きだったりはする。かも。

おわり

短いけどおわり。

Tokyo.Rへの初参戦が決まったので
休日出勤を回避すべく馬車馬のようにはたらく!!!

11月はSapporo.Rもあるらしいよ、たのしみ。

【ggplot2】札幌圏におけるセイコーマートの強さをボロノイ分割で把握(したかった)

Good morning.
This is Silver weeeeeeeek!!!

さて。
進学で北海道に移住してからかれこれ4年とちょっと。

デビューしたての頃はずっと思っていました。

セイコーマートってなんだ?」

と。

セイコーマート
それは北海道最強を誇るコンビニです。
ローソンよりもセブンよりも、道内における圧倒的地位と人口カバー率を誇るコンビニです。

今回は
コンビニの出店位置を母点にしたボロノイ分割によって、
他のコンビニとの出店戦略の違いを把握出来たらいいな、みたいなのをやります。

首都圏だともうやられている方もたくさんいらっしゃるみたいです。


d.hatena.ne.jp

tomoshige-n.hatenablog.com

方向性

例のごとく、作業前の自らへの課題とか仮説とか。

・店舗住所を{rvest}で抜いてきてGoogleAPIに投げて緯度経度を取得したいよ
・最後はggplot2で書きたいよ
・【仮説】セイコーマートは中心部よりも郊外出店で広い商圏を稼いでる気がする

前処理

まず{rvest}でそれぞれ札幌圏のコンビニ店舗情報を取得します。

今回ここで文字コード問題でつっかかったりしていましたが、かの有名なr-wakarangで助けて頂きました...
Windows環境で文字化けてしまう方、encode="UTF8"の引数指定でだめな時はEncoding(df)<-"UTF-8"で直接変換するといけるみたいです

url<-"http://www.mapion.co.jp/phonebook/M02005007C/"
page = read_html(url,encoding = "UTF-8") #ここでのencode指定は無視された

accessx<-page %>% 
        html_nodes(xpath='//td') %>% 
        html_text()

Encoding(accessz)<- "UTF-8" #強制Encode

accessx #1ページ目
accessy #2ページ目
accessz #3ページ目

access_s<-c(accessx,accessy,accessz)#各ページの抽出結果を結合(セイコーマート)


#結果参照

> head(access_s)
[1] "北海道札幌市中央区円山西町4丁目7−25"     "011-616-7911"                                
[3] "北海道札幌市中央区北1条西19丁目2−1"     "011-615-2626"                                
[5] "北海道札幌市中央区南7条西5丁目289−54" "011-532-8610"

#電話番号が邪魔そうなので正規表現で抜きます。
#札幌圏の市外局番は011から始まっているので、前方一致「^011」で引っかかった列以外を抽出

Index<-grep("^(011)",access)
access[-Index]

#あとはゴミ行取ったり、ベクトルにしたりなんだりで完成したのがこんな感じ

adress_s<-as.vector(as.matrix(adress_s))

> str(adress_s)
 chr [1:299] "北海道札幌市厚別区もみじ台東4丁目2-12" "北海道札幌市厚別区厚別中央1条7丁目17-37" ...

> tail(adress_s)
[1] "北海道札幌市北区北22条西4丁目2-12" "北海道札幌市北区北24条西14丁目3-3" "北海道札幌市北区北27条西2丁目1-25"
[4] "北海道札幌市北区北31条西4丁目1-1"   "北海道札幌市北区北36条西2丁目2-1"   "北海道札幌市北区北8条西5丁目1" 

#ローソンとセブンもそれぞれ作りました

> str(adress_rr) #ローソン
 chr [1:242] "北海道札幌市厚別区厚別中央1条4丁目1-25" "北海道札幌市厚別区厚別中央3条6丁目1-1" ...

> str(adress_7) #セブン
 chr [1:296] "北海道札幌市厚別区厚別西4条2丁目4-15" "北海道札幌市厚別区厚別中央2条1丁目2-17" ...


セイコーマート、ローソン、セブンイレブン
札幌市内の店舗数はそれぞれ240~300店舗ほどと、それほど数に差があるようには見受けられません。

ちなみに全然関係無いんですけど、

> str(adress)
 chr [1:299] "北海道札幌市厚別区もみじ台東4丁目2-12""| __truncated__ "北海道札幌市厚別区もみじ台北5丁目1-6""| __truncated__ ...

こういう"|_truncated"とかいう邪魔者をスマートに消す方法があったら知りたいです...そもそもだれなのこれ...


GoogleAPIから緯度経度を取得

文字列ベクトル(3店舗合計900件)の座標を取得します。

GoogleAPIはJSONで返してくれるので、一件数投げて、緯度と経度だけを取得するならこんな感じで
{Rcurl}と{rjson}を使う感じになるのでしょうか。

address <- "住所文字列"
url <- paste("http://maps.googleapis.com/maps/api/geocode/json?address=",
               address,"&sensor=false&region=JP&language=ja",sep="")
  
# Geocoding APIからJSON形式で色々返してもらう
json<-RCurl::getURL(url)
  
# JSONからRに緯度・経度の情報を抽出してオブジェクトに格納
rjson <- rjson::fromJSON(json)
lat <- rjson$results[[1]]$geometry$location$lat
lon <- rjson$results[[1]]$geometry$location$lng

しっかし900件あるしな~forか関数作るかかなあ~という感じですが、

@teramonagi先生が複数対応の関数を作ってくださっていたので、一部お借りすることに。

d.hatena.ne.jp

#緯度経度情報へ変換(teramonagi先生関数)
location_s  <- GetLatitudeAndLongitude(adress_s)
location_r  <- GetLatitudeAndLongitude(adress_r)
location_7  <- GetLatitudeAndLongitude(adress_7)


#3店舗それぞれに店の種別「store」を足して別オブジェクトへ格納

> location_s %>>%
+ (dplyr::mutate(.,store="セイコーマート")->location_ss) %>>%
+ head(3)
       lat      lon          store
1 43.03022 141.4996 セイコーマート
2 43.03790 141.4800 セイコーマート
3 43.03768 141.4663 セイコーマート

> location_r %>>%
+ (dplyr::mutate(.,store="ローソン")->location_rr) %>>%
+ head(3)
       lat      lon    store
1 43.03524 141.4687 ローソン
2 43.04238 141.4731 ローソン
3 43.03987 141.4886 ローソン


> location_7 %>>%
+ (dplyr::mutate(.,store="セブンイレブン")->location_77) %>%
+ head(3)
       lat      lon          store
1 43.04993 141.4590 セブンイレブン
2 43.03077 141.4536 セブンイレブン
3 43.03966 141.4577 セブンイレブン


#3店舗をマージ
> location_ss%>>%
+ (rbind(.,location_rr)) %>>%
+ (rbind(.,location_77)->location) %>>%
+ tail(3)
         lat      lon          store
835 43.10258 141.3402 セブンイレブン
836 43.10580 141.3370 セブンイレブン
837 43.06910 141.3480 セブンイレブン

> location$store<-as.factor(location$store)
> str(location) #マージ完成
'data.frame':	837 obs. of  3 variables:
 $ lat  : num  43 43 43 43 43 ...
 $ lon  : num  141 141 141 141 141 ...
 $ store: Factor w/ 3 levels "セイコーマート",..: 1 1 1 1 1 1 1 1 1 1 ...

できた。計837件だそうです。
storeは図にするときに色分けのため、factor化してます。

ちょっと可視化

長き戦いを終えたので、ここでいったん地図に落とし込みます。

#札幌市の地図オブジェクトを取得(Zoom引数でちょっと調整)
sapporo_center <- geocode("Sapporo Station", source = "google") #札幌駅の位置を取得
sapporo_map <- ggmap::get_googlemap(center = c(lon =sapporo_center[1,1] , lat = sapporo_center[1,2]),
                                    zoom = 12, scale = 2,maptype = "roadmap",color ="color") #satellite', 'roadmap'

#コンビニマップを描画
conmap2<-ggmap::ggmap(sapporo_map)+geom_point(data=location,aes(x=lon,y=lat,colour=store),size=2)

f:id:WAFkw:20150922105723p:plain

できたぜ。

これだけでも中心部にローソンとセブンがわーーーっと集まってて、
セイコーマートは店舗を集中させずにまんべんなく出店させてそう...?みたいなのが見える気がする。


ボロノイ分割

さて。メインテーマであるボロノイ分割をやります。
真剣に説明しようとおもったけど、図を改めて作るのがアレだったので...
分かりやすい記事がありましたのでこちらを...

ボロノイ図とは

すっごい端的に言うと、

A点-------------------------B点

ここの間に垂直二等分線を引きます。
C点とD点、E点と...みたいにドロネー線に対してどんどん垂直二等分線(ボロノイ線)を引いていきます。
最後にドロネー線を消したら、各点を中心とした「領域」が出来るよね!って感じです。

やります。

library(deldir)

#deldir::分割
deldir <- deldir::deldir(x=location$lon,y=location$lat,
                         rw=c(min(location$lon),max(location$lon),min(location$lat),max(location$lat))) #すごいいっぱいのリストが出るよ

rw引数は分割するはじっこの線を決める感じで、この枠内を分割してねみたいな書き方をしてみました。

結果を表示したかったけれどもブログが長くなりすぎそうなので主要なものを以下に。


delsgs:ドロネー三角形。エッジの座標点(x1,y1,x2,y2)の後ろに母点(コンビニ店舗)のID

dirsgs:ディリクレ領域(ボロノイ領域)。エッジの座標点(x1,y1,x2,y2)の後ろに母点(コンビニ店舗)のID

n.data:分割されたデータ点(重複なし)

n.dum:分割されたデータ点(重複点なし)

del.area:ドロネー三角に分割された点の面積。

dir.area:ボロノイ境界領域によって囲まれている面積。

rw:正方形領域の枠。

....etc(もっといろいろあります)


今回はボロノイ領域を書きたいので、dirsgsの結果を使います。
geom_segment()でごにょごにょと。

conmap3<-ggmap::ggmap(sapporo_map) + 
  geom_point(aes(x=lon, y=lat,colour=factor(store)),size=2, data = location) +
  geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), size = .25,data = deldir$dirsgs, linetype = 1);conmap3#境界が書ける

f:id:WAFkw:20150922111816p:plain

見えない。見えにくいよパトラッシュ。

元の地図テーマを変えてみた。

f:id:WAFkw:20150922112019p:plain

なんかこわい。まあいいか。

ボロノイ境界を引いてみてわかったことは、特に北東部、南西部でセイコーマートのボロノイ領域が「広い」
西側はなかなかセブンも頑張っていますが、やはり市内の端にいけばいくほどセイコーマートの存在感が増しています。

ローソンの店舗は地下鉄南北線東西線に沿ってる感じですがね、人が多いところに出店しまくってる感じがします。
セブンは人が多いところを中心に、たまに穴場的なところへの出店。
セイコーマートは中心部はやや避け、とにかくまんべんなく、人口&土地カバー率といったところでしょうか。

見にくいから色を塗りたい

ここからはうまくいっていない編です。

geom_polygon()を使って母点(コンビニ)の色で領域を色分けしたら見やすいよなあって感じなんですが。。
どうやってtileと母点のFactorを結びつけるか方針が決まりませんでした...

#tile情報だけを切り出してきて、その中身を色塗り

tilelist <- unclass(tile.list(deldir))
tilelist <- lapply(tilelist, function(l){
  data.frame(x = l$x, y = l$y)
})
library(reshape2)
tiledf <- reshape2::melt(tilelist, id.vars = c("x"))
tiledf <- tiledf[,c(4,1,3)]
names(tiledf) <- c('tile','x','y')
tiledf$tile<-as.factor(tiledf$tile)


#各tileの頂点の座標が取得出来てます。ここに母点情報を足せればいいのかなあ...
> head(tiledf)
  tile        x        y
1    1 142.1004 43.17976
2    1 142.0103 43.27621
3    1 141.5015 43.03878
4    1 141.4951 43.03427
5    1 141.4888 43.02622
6    1 141.4889 43.02588

#描画
conmap3<-conmap3+geom_polygon(aes(x = x, y = y, fill = tile),data = tiledf, colour = 'black', alpha = .3)

f:id:WAFkw:20150922113947p:plain

ちがうそうじゃない....ってなる....

現状邪魔なラベルを消す元気もないです。
うーーーむ。


以上、現場からでした。

【ggmapで遊ぶ②】巡回スープカレー屋問題を解いてみた

二回目の更新です。

さっきの記事の続き!!!wafdata.hatenablog.com

札幌駅周辺のスープカレー屋の情報をスクレイピングしてggmapして、
誰得な食べ歩きルートを作ってやろうというシリーズとなっております。

前回記事ではルートがうまく引けずに、「これって巡回セールスマン問題じゃん~ぶ~」などと供述していましたが、

@berobero11さんに背中を押して頂いたのでやってみます。
(いつも本当にありがとうございます)

参考にさせて頂いた記事はこちら。
祇園祭の山鉾の最適巡回経路 - 驚異のアニヲタ社会復帰への道


ではやります。

まず巡回セールスマン問題ってなにさ

巡回セールスマン問題には
以前から私の聖書とあがめているこのスライドにて出会いました(後半)


いつ見ても泣いちゃう、、

てことでちょっとまとめます。

巡回セールスマン問題(TSP)

端的に言うと、セールスマンが複数のセールス先を最も効率良く回れる経路は??という問いです。
普通に考えても回らなければならない拠点が増えれば増えるほど、想定し得るルートは指数関数的に増えていくので厳密解を求めるのは難しいと言われてまっす。

たとえば今回は6店なので、、(n-1)!/2通り、、60通りかな、、(そんなでもなかった)

TSPは三角等式を満たすという仮定を与えてどーのこーのという小難しい話があったりしますが、私的には三角等式は

(i店からj店への距離)+(j店からk店への距離)≧(i店からk店への距離)

なので、「i店からk店に行こうとしてるのに、途中でj店に寄り道したら遠くなっちゃうよねー」っていう仮定のことだと解釈してます。

いざ巡回スープカレー屋問題

そんでもって、
RではどうやらこのTSPを解く{TSP}なるパッケージがあるとのことで、、

デフォルトで使えるアルゴリズムは以下の通り。一部知らないやつがあった、、

  • nearest_insertion..........最近追加法
  • cheapest_insertion.........最廉挿入法
  • farthest_insertion.........最遠挿入法
  • arbitrary_insertion........(?)
  • nn.........................最近傍法
  • repetitive_nn..............(?)
  • 2-opt......................2近似解法


間違ってたら糾弾してください。

前提のプロットはこれです。

> curry_map
    code_y   code_x
1 43.06401 141.3547
2 43.06757 141.3462
3 43.06761 141.3525
4 43.06672 141.3545
5 43.06827 141.3524
6 43.06596 141.3502

sapporo_center <- geocode("Sapporo Station", source = "google") #札幌駅の位置を取得
sapporo_center

sapporo_map <- ggmap::get_googlemap(center = c(lon =sapporo_center[1,1] , lat = sapporo_center[1,2]),
                          zoom = 16, size = c(640, 640), scale = 2,
                          maptype = "roadmap",color = "color",markers=Curry_p)
ggmap::ggmap(sapporo_map)

f:id:WAFkw:20150830162536p:plain


カレー屋さん問題を解きます。

install.packages("TSP")
library(TSP)
> tsp_curry <- TSP(dist(curry_map[, c("code_x", "code_y")]));tsp_curry #TSP関数を適用。準備
object of class ‘TSP’ 
6 cities (distance ‘euclidean’) 

# 使えるメソッドを全て適用したいので、与える用意
>m0 <- c("nearest_insertion", "cheapest_insertion", "farthest_insertion", "arbitrary_insertion", "nn", "repetitive_nn", "2-opt")

#TSP問題はsolve_TSP()で解けるみたい
> tours <- lapply(m0, FUN=function(m) solve_TSP(tsp_curry, method=m));tours #solveTSP()で解く。のをメソッドごとに繰り返し

[[1]]
object of class ‘TOUR’ 
result of method ‘nearest_insertion’ for 6 cities
tour length: 0.02103666 

[[2]]
object of class ‘TOUR’ 
result of method ‘cheapest_insertion’ for 6 cities
tour length: 0.02150029 

[[3]]
object of class ‘TOUR’ 
result of method ‘farthest_insertion’ for 6 cities
tour length: 0.02103666 

[[4]]
object of class ‘TOUR’ 
result of method ‘arbitrary_insertion’ for 6 cities
tour length: 0.02150029 

[[5]]
object of class ‘TOUR’ 
result of method ‘nn’ for 6 cities
tour length: 0.0223355 

[[6]]
object of class ‘TOUR’ 
result of method ‘repetitive_nn’ for 6 cities
tour length: 0.02103666 

[[7]]
object of class ‘TOUR’ 
result of method ‘2-opt’ for 6 cities
tour length: 0.02103666 


#メソッド名が無いとわかんない!!
> names(tours) <- m0 #メソッド名を結果の名前に設定。
> tours
$nearest_insertion
object of class ‘TOUR’ 
result of method ‘nearest_insertion’ for 6 cities
tour length: 0.02103666 

$cheapest_insertion
object of class ‘TOUR’ 
result of method ‘cheapest_insertion’ for 6 cities
tour length: 0.02150029 

$farthest_insertion
object of class ‘TOUR’ 
result of method ‘farthest_insertion’ for 6 cities
tour length: 0.02103666 

$arbitrary_insertion
object of class ‘TOUR’ 
result of method ‘arbitrary_insertion’ for 6 cities
tour length: 0.02150029 

$nn
object of class ‘TOUR’ 
result of method ‘nn’ for 6 cities
tour length: 0.0223355 

$repetitive_nn
object of class ‘TOUR’ 
result of method ‘repetitive_nn’ for 6 cities
tour length: 0.02103666 

$`2-opt`
object of class ‘TOUR’ 
result of method ‘2-opt’ for 6 cities
tour length: 0.02103666 

#結果を見ると、tour_lengthが各ルートの距離(的な)ものを表しているようだ

#tour_lengthの部分だけ抜いてきてattr()で整形
> tour_length <- c(sapply(tours, FUN=attr, "tour_length"));tour_length
  nearest_insertion  cheapest_insertion  farthest_insertion arbitrary_insertion                  nn       repetitive_nn 
         0.02103666          0.02150029          0.02103666          0.02150029          0.02233550          0.02103666 
             2-opt 
         0.02103666 

# 距離をソートして一番小さいものを取ってくる
> minlen <- sort(tour_length)[1];minlen
nearest_insertion 
       0.02103666 

#nearest_insertionで求めた結果が一番最短ルートを選べているもよう。

 #toursリストのメソッドごと繰り返して数値化
> curry_route <- sapply(tours, as.integer);curry_route
     nearest_insertion cheapest_insertion farthest_insertion arbitrary_insertion nn repetitive_nn 2-opt
[1,]                 2                  4                  3                   1  2             5     2
[2,]                 6                  1                  4                   6  6             3     6
[3,]                 1                  6                  1                   2  3             4     1
[4,]                 4                  2                  6                   3  5             1     4
[5,]                 3                  3                  2                   5  4             6     3
[6,]                 5                  5                  5                   4  1             2     5

#店を回る全体の順番の結論!
> root <- c(curry_route[, names(minlen)], curry_route[1, names(minlen)]);root
                                                                                                            nearest_insertion 
                2                 6                 1                 4                 3                 5                 2 


わちゃわちゃしましたが、
2→6→1→4→3→5→2
の順番でお店を回ればよさそうだ!!

単純に考えたら、
2の店→6の店
6の店→1の店、、
と、全部のルートを求めていけば良さそうなので、rootの結果をうまく与えてFor文で回すかなあ、、

しかし6店しかないので
いちいち処理を見たいという願望が芽生えたので、ちまちまやります

#店の順番を入れ替えるなどする。
> curry_map[root, c("code_x", "code_y")]
      code_x   code_y
2   141.3462 43.06757
6   141.3502 43.06596
1   141.3547 43.06401
4   141.3545 43.06672
3   141.3525 43.06761
5   141.3524 43.06827
2.1 141.3462 43.06757

travelmode<-"walking" #カレー屋は歩いて行くに限る

#それぞれの徒歩ルートを求めます

route_1<-route(c(lon[2],lat[2]),c(lon[6],lat[6]),structure="route",mode=travelmode)
route_2<-route(c(lon[6],lat[6]),c(lon[1],lat[1]),structure="route",mode=travelmode)
route_3<-route(c(lon[1],lat[1]),c(lon[4],lat[4]),structure="route",mode=travelmode)
route_4<-route(c(lon[4],lat[4]),c(lon[3],lat[3]),structure="route",mode=travelmode)
route_5<-route(c(lon[3],lat[3]),c(lon[5],lat[5]),structure="route",mode=travelmode)
route_6<-route(c(lon[5],lat[5]),c(lon[2],lat[2]),structure="route",mode=travelmode)

#本来はlon[i],lat[i]みたいな感じで渡していくべきなはず

#route1の中身を見てみる

     m    km     miles seconds   minutes       hours leg      lon      lat
1   48 0.048 0.0298272      35 0.5833333 0.009722222   1 141.3463 43.06795
2   51 0.051 0.0316914      37 0.6166667 0.010277778   2 141.3468 43.06803
3   19 0.019 0.0118066      14 0.2333333 0.003888889   3 141.3470 43.06758
4  119 0.119 0.0739466      86 1.4333333 0.023888889   4 141.3472 43.06757
5  111 0.111 0.0689754      80 1.3333333 0.022222222   5 141.3474 43.06651
6   35 0.035 0.0217490      25 0.4166667 0.006944444   6 141.3487 43.06663
7   58 0.058 0.0360412      42 0.7000000 0.011666667   7 141.3489 43.06636
8  104 0.104 0.0646256      75 1.2500000 0.020833333   8 141.3492 43.06601
9   41 0.041 0.0254774      29 0.4833333 0.008055556   9 141.3505 43.06618
10  NA    NA        NA      NA        NA          NA  NA 141.3506 43.06582

#48m行って~そのあと51m歩いて~みたいな所要時間と共に書いてありますね

#route1を描画

> ggmap(sapporo_map) +
+   geom_path(
+     aes(x=lon,y=lat), colour = 'red', size = 2,
+     data = route_1, lineend = 'round')

f:id:WAFkw:20150830214805p:plain

おお、スタートは左上からかな

(以降、ちまちま足して、ルートが繋がっていくのをいちいち喜びます)

#route2,3を追加
gmap(sapporo_map) +
  geom_path(
    aes(x=lon,y=lat), colour = 'red', size = 2,
    data = route_1, lineend = 'round')+
  geom_path(
    aes(x=lon,y=lat), colour = 'red', size = 2,
    data = route_2, lineend = 'round')+
  geom_path(
    aes(x=lon,y=lat), colour = 'red', size = 2,
    data = route_3, lineend = 'round')

f:id:WAFkw:20150830214848p:plain


完成!!!

ggmap(sapporo_map) +
  geom_path(
    aes(x=lon,y=lat), colour = 'red', size = 2,
    data = route_1, lineend = 'round')+
  geom_path(
    aes(x=lon,y=lat), colour = 'red', size = 2,
    data = route_2, lineend = 'round')+
  geom_path(
    aes(x=lon,y=lat), colour = 'red', size = 2,
    data = route_3, lineend = 'round')+
  geom_path(
    aes(x=lon,y=lat), colour = 'red', size = 2,
    data = route_4, lineend = 'round')+
  geom_path(
    aes(x=lon,y=lat), colour = 'red', size = 2,
    data = route_5, lineend = 'round')+
  geom_path(
    aes(x=lon,y=lat), colour = 'red', size = 2,
    data = route_6, lineend = 'round')

f:id:WAFkw:20150830214902p:plain


わーい!!!!つながった!!!!

※通常はいちいち経過を見たりしないで、どうか繰り返し処理をしてください。


超楽しかったー
素晴らしい日曜日。

仕事行きたくない!!!!!!

【ggmapで遊んだ話】札幌駅周辺のスープカレー屋マップ

札幌は夏が終わってしまいましたね。

近頃は恥ずかしいコードをばんばん公開して
マサカリを投げて頂くことに喜びを感じて生きています。

さて。

小ネタが続いていて、なんか分析っぽいことをしよーと思いつつ
前処理修行が終わらないので、今週も小ネタになります。

議題「札幌ごはんどころマップを作ってみたい」

ラーメンが良かったけどとりあえず件数少なめなスープカレーでためす

ググったらもう大手サイトさんでマップが存在していた!

・・まあRで同じ見た目のものが作れるかやってみよう

理想は、WEBスクレイピングで抜いてきた住所から座標を取得→マップ作り→食べ歩きルートも書けたら楽しいね!(私が)

って感じです。


方針

①座標から描画する方法をやってみる
②住所から描画する方法をやってみる
③ルートから書いてみる

「札幌駅 スープカレー」とかでテキトーにググったら
6件~10件くらいのお店しかヒットしないので、それを題材に。

パート1:座標から描画してみる

ソースを見たら、Googlemapの描画のとこから直接座標ゲット出来そうだったので、
{rvest}で引っ張ってこようとしたところ、Xpath指定のレベルが足りずに悲惨なことに。。

#6店分の座標を抜きたい

>library(rvest)
> html <- read_html("http://tabelog.com/hokkaido/A0101/A010101/rstLst/RC120501/")
> access <- html %>%
+ html_nodes(xpath = '//div[@class="js-panel js-panel-map list-panel-map"]/p/a/img[@data-original]') %>%
+ print(access)
{xml_nodeset (6)}
[1] <img alt="螂・闃晏膚蠎\x97\x85\x8d 蜑オ謌仙ッコ - 蝨ー蝗ウ" class="js-lazy" data-original="http://maps.google.com/maps/api/staticmap?client=gme-kakakucominc&amp;channel=tabelog.com&amp;sensor=false&amp;hl=ja&amp;center=43.066721045467624,141.35447237801213&amp;markers=color:red%7C43.066721045467624,141.35447237801213&amp;zoom=15&amp;size=545x130&amp;signature=zWO-s9C_IaI_hjbb-3AqnuKpIMY=" height="130" src="" width="545" />
[2] <img alt="繝斐き繝ウ繝\x86繧」 譛ュ蟷碁ァ\x85蜑榊コ\x97 - 蝨ー蝗ウ" class="js-lazy" data-original="http://maps.google.com/maps/api/staticmap?client=gme-kakakucominc&amp;channel=tabelog.com&amp;sensor=false&amp;hl=ja&amp;center=43.06401328397733,141.3547266482323&amp;markers=color:red%7C43.06401328397733,141.3547266482323&amp;zoom=15&amp;size=545x130&amp;signature=rNOqCsmfF8xTBoBsq2sVLmzax2w=" height="130" src="" width="545" />
・
・
・


店名。。文字化けた。。。。

(Googlemapの描画のソースから座標を取ってきて、Rでggmapを描画するという本末転倒なことをしていますが
暇な人だと思って頂ければ幸いです。)

"center="で指定されているところが座標部分になります。
本当はXpath指定時点でここを直接抜けたら前処理が楽なんだろうけど・・・レベル上げたい。

見やすくするとこんな感じに。

> curry_map
    code_y   code_x
1 43.06401 141.3547
2 43.06757 141.3462
3 43.06761 141.3525
4 43.06672 141.3545
5 43.06827 141.3524
6 43.06596 141.3502


お店の位置の座標データフレームが出来たので、描画を開始。
まずは「札幌駅周辺」がお題なので、札幌駅を中心に据えた地図を作ります。

geocode("住所",source="google")...住所から座標を取得
revgeocode(c(×××,△△△))...座標から住所を取得

get_googlemap()の引数zoom,size,scale周りをいろいろ変えながら模索しました。
デフォルト状態だと他の市町村まで入るくらい引きの地図になります。

> sapporo_center <- geocode("Sapporo Station", source = "google") #札幌駅の位置を取得
> sapporo_center
       lon      lat
1 141.3508 43.06862

> sapporo_map <- ggmap::get_googlemap(center = c(lon =sapporo_center[1,1] , lat = sapporo_center[1,2]),
+                                     zoom = 16, size = c(640, 640), scale = 2,
+                                     maptype = "roadmap",color = "color")
Map from URL : http://maps.googleapis.com/maps/api/staticmap?center=43.068625,141.350801&zoom=16&size=640x640&scale=2&maptype=roadmap&sensor=false
> ggmap::ggmap(sapporo_map) #描画

f:id:WAFkw:20150830160515p:plain


うん。

とりあえずカレーマップを作ります。
カレー屋さんの場所に点を打つ。ただそれだけ。

> ggmap(sapporo_map)+
+   geom_point(data=curry_map,aes(x=code_x,y=code_y),color="red",size=7)

f:id:WAFkw:20150830160832p:plain


なんかダサいけどできた!!

パート2:住所から描画したい

「でも座標データフレーム最初から用意すんのなんてめんどくさくね?」

ということで考えてみます

> revgeocode(c(141.3547,43.06401))
Information from URL : http://maps.googleapis.com/maps/api/geocode/json?latlng=43.06401,141.3547&sensor=false
[1] "1 Chome-8 Kita 2 Jōnishi, Chūō-ku, Sapporo-shi, Hokkaidō 060-0002, Japan"

この戻り値みたいな感じに正規化された住所を渡せば座標ゲット出来そう

住所→ローマ字→正規化

の納得いく処理が書けなかったので割愛しますが。。

> geocode("1 Chome-8 Kita 2 Jōnishi, Chūō-ku, Sapporo-shi", source = "google")
Information from URL : http://maps.googleapis.com/maps/api/geocode/json?address=1%20Chome-8%20Kita%202%20J%c5%8dnishi,%20Ch%c5%ab%c5%8d-ku,%20Sapporo-shi&sensor=false
       lon      lat
1 141.3547 43.06399

住所を渡して、座標ゲットして、、をうまいこと繰り返して、さっきのCurry_mapみたいな座標データフレームを作れればよいのかなと。

食べ歩きルートみたいなのを書いてみたい

さっきの座標データ(Curry_map)をマーカーで書いてみた

#マーカー用にデータ整形
> Curry_p = data.frame(
+                       lon <- c(141.3547, 141.3462, 141.3525, 141.3545,141.3524,141.3502),
+                       lat <- c(43.06401, 43.06757, 43.06761, 43.06672,43.06827,43.06596))

#引数markerを与えて描画
> sapporo_map <- ggmap::get_googlemap(center = c(lon =sapporo_center[1,1] , lat = sapporo_center[1,2]),
+                           zoom = 16, size = c(640, 640), scale = 2,
+                           maptype = "roadmap",color = "color",markers=Curry_p)
Map from URL : http://maps.googleapis.com/maps/api/staticmap?center=43.068625,141.350801&zoom=16&size=640x640&scale=2&maptype=roadmap&markers=43.06401,141.3547%7c43.06757,141.3462%7c43.06761,141.3525%7c43.06672,141.3545%7c43.06827,141.3524%7c43.06596,141.3502&sensor=false
> ggmap::ggmap(sapporo_map)

f:id:WAFkw:20150830162536p:plain

さっきの赤丸よりはダサくない!!Googlemap感!!!

さらにmarker引数と同じような感じで、path引数を与えるとルートも書けるっぽい

> ggmap::ggmap(sapporo_map)
> sapporo_map <- ggmap::get_googlemap(center = c(lon =sapporo_center[1,1] , lat = sapporo_center[1,2]),
+                           zoom = 16, size = c(640, 640), scale = 2,
+                           maptype = "roadmap",color = "color",markers=Curry_p,path=Curry_p)
Map from URL : http://maps.googleapis.com/maps/api/staticmap?center=43.068625,141.350801&zoom=16&size=640x640&scale=2&maptype=roadmap&markers=43.06401,141.3547%7c43.06757,141.3462%7c43.06761,141.3525%7c43.06672,141.3545%7c43.06827,141.3524%7c43.06596,141.3502&path=43.06401,141.3547%7c43.06757,141.3462%7c43.06761,141.3525%7c43.06672,141.3545%7c43.06827,141.3524%7c43.06596,141.3502&sensor=false
> ggmap::ggmap(sapporo_map)

f:id:WAFkw:20150830162759p:plain


・・・・うん。。。

それっぽいものは書けた。(ルートに納得はいかないけど。)

なんか循環セールスマン問題みたいだなあ


欲張らずに2点の間のルートだとroute()使ってからのgeom_path()で書けそうだけど、いまいちうまくいかなかった

#食べ歩きルート
from<-"6 Chome-1 Kita 6 Jōnishi, Chūō-ku, Sapporo-shi"
to<-"2 Chome Kita 5 Jōnishi, Chūō-ku, Sapporo-shi"
route <- route(from, to, structure = 'route')
ggmap(sapporo_map) +
  geom_path(
  aes(x=lon,y=lat), colour = 'red', size = 2,
  data = route, lineend = 'round')

f:id:WAFkw:20150830163733p:plain

書けてはいるけど。。。求めた座標がざっくりしすぎているからなのか、微妙。。。



私による私のための食べ歩きルート構築への道はまだまだ遠そう。

【ggplot2番外編】企業の年収ランキングで遊ぶ~facetする意味について~

17歳冬、私は「北海道には梅雨が無いよ」と言われ
札幌にやって来ました。

・・・あれから5年。

・・・・・・騙された気持ちでいっぱいです。(蝦夷梅雨)

注意書き

最近はクラスタリングやらコロプレスやら色々やってましたが、
今回は番外編です。

・間違った図を
・そのまんま
・公開してみよう

以上です。

なんか思ってたのと違う、ってなった話と
それに気づくまでの過程を述べて終わります。

分析っぽいことすらしてません
全般的にくだらないので短いです。

テーマ

・(高所得者への嫉妬がピークなので)年収ランキングを集めたい
・そういえばサブグループの図って作ったことなかったからやりたい

そもそもこのデータとやりたいことが一致してないのがその後詰まる原因に。

データ

東洋経済さんの「年収トップ企業500」のうち1~100位の企業をcsv

toyokeizai.net

1社ごとの業種(証券コード協議会のものに準拠)、本社本店所在地をセット


nensyu<-read.csv("nensyu_rank.csv",header=TRUE)
gyosyu<-read.csv("gyosyu.csv",header=TRUE)
nensyu_kako<-nensyu[,-2]

> nensyu_kako
    rank nensyu  age ninzu      area gyosyu
1      1   1947 29.9    36     tokyo   9050
2      2   1506 43.4    35     tokyo   5250
3      3   1499 51.3    70     tokyo   5250
4      4   1479 42.3   650     tokyo   5250
5      5   1454 47.0  1232     tokyo   5250
6      6   1440 34.8  2038     osaka   3650
7      7   1412 34.5   160     tokyo   9050
8      8   1395 42.1  1130     tokyo   5250
9      9   1384 41.3  4274     tokyo   6050
10    10   1356 42.8  6358     tokyo   6050
11    11   1351 42.4  6160     tokyo   6050
12    12   1351 44.8  1879     tokyo   5250
13    13   1304 42.7  5413     tokyo   6050
14    14   1303 51.3  1705     tokyo   6050
15    15   1275 41.7  4385     tokyo   6050
16    16   1268 41.7   116     tokyo   8050
17    17   1240 40.1    80     tokyo   3650
18    18   1221 44.5   113     tokyo   5250
19    19   1205 42.7   223   hukuoka   5250
20    20   1191 39.1  7384     tokyo   9050
21    21   1184 46.7    19     tokyo   8050
22    22   1174 44.0    40     tokyo   7050
23    23   1172 41.8   448     tokyo   7150
24    24   1157 44.5   102     tokyo   3300
25    25   1152 41.2   604     tokyo   7100
26    26   1146 38.9   185     tokyo   5250
27    27   1138 42.2   321     aichi   5250
28    28   1119 33.5    90     tokyo   9050
29    29   1119 46.7   310     tokyo   9050
30    30   1118 39.8   146     tokyo   7100
31    31   1107 40.7   711     tokyo   8050
32    32   1107 46.3    25     tokyo   5250
33    33   1101 41.3  1296     tokyo   8050
34    34   1095 47.9    69     tokyo   3250
35    35   1091 38.7  6026     tokyo   5250
36    36   1080 44.3    73     tokyo   3250
37    37   1070 45.2   118     tokyo   3200
38    38   1066 45.7   100     tokyo   3200
39    39   1056 41.0   116     tokyo   7100
40    40   1052 44.2   196     tokyo   9050
41    41   1052 42.2  2271     tokyo   6050
42    42   1041 36.2   370     tokyo   9050
43    43   1041 40.5  2809     aichi   6050
44    44   1041 42.7    36     tokyo   8050
45    45   1040 43.7  3502     tokyo   3250
46    46   1036 42.3  5744     tokyo   3250
47    47   1035 41.7  6578     tokyo   3250
48    48   1026 44.2   105     tokyo   2050
49    49   1017 46.5    21     osaka   8050
50    50   1014 42.4   244     tokyo   7100
51    51   1010 40.1  2427     tokyo   5250
52    52   1009 41.1   277     tokyo   5250
53    53   1008 42.6   273     tokyo   3050
54    54    995 43.6    85     tokyo   7150
55    55    995 44.7    48     tokyo   8050
56    56    985 35.7   414     tokyo   9050
57    57    983 43.2  2238  kanagawa   2050
58    58    980 43.4  2661 yamanashi   2050
59    59    975 43.7   209     tokyo   7100
60    60    974 39.9  1136     tokyo   5100
61    61    971 43.6    34     tokyo   3050
62    62    969 38.9   482     tokyo   3050
63    63    965 42.0    38     tokyo   4050
64    64    965 42.7   881     tokyo   5250
65    65    963 38.1    61     osaka   8050
66    66    960 39.3  2025     tokyo   7100
67    67    960 41.5  9965     tokyo   2050
68    68    958 44.9    11     tokyo   7100
69    69    955 46.5    10     tokyo   7200
70    70    950 42.8    74     tokyo   3100
71    71    944 41.7  1630  kanagawa   2050
72    72    944 41.7   118   okayama   9050
73    73    943 38.8  6734     osaka   3250
74    74    943 44.5    37     tokyo   3450
75    75    940 43.1  2332     osaka   3200
76    76    939 41.4 10837     tokyo   5250
77    77    938 41.0   110     tokyo   9050
78    78    937 41.5  4932     tokyo   3250
79    79    937 43.0  1485     tokyo   2050
80    80    935 44.5   953     tokyo   3300
81    81    934 47.8    56     tokyo   5250
82    82    934 49.7    75  kanagawa   5050
83    83    930 39.6  1499     tokyo   1050
84    84    925 38.3    35     tokyo   7100
85    85    924 44.5   212     tokyo   9050
86    86    917 38.3   230     chiba   5100
87    87    916 43.1   188  kanagawa   3650
88    88    909 41.7  3518     tokyo   3050
89    89    909 46.6    38     osaka   3250
90    90    908 45.4  2888     tokyo   3650
91    91    907 36.7   142     tokyo   5100
92    92    907 40.9   422     tokyo   8050
93    93    901 53.4    12  kanagawa   6050
94    94    900 45.4    61     tokyo   9050
95    95    899 44.1    21     tokyo   7100
96    96    898 38.1  2393     tokyo   7100
97    97    896 45.5   108     tokyo   3250
98    98    896 37.6   892     tokyo   5100
99    99    896 41.6    67     osaka   5050
100  100    895 44.9  1696     tokyo   2050
101  101    895 47.1    38     tokyo   5250

#業種コードをキーに業種名を別途JOIN
library(dplyr)
nensyu_kako<-dplyr::left_join(nensyu_kako,gyosyu,by = "gyosyu")


#従業員数を離散化してクラス分け

library(infotheo)
x=infotheo::discretize(subset(nensyu_kako,select=ninzu),disc="equalwidth")
colnames(x)<-c("ninzu_class")
nensyu_kako<-cbind(nensyu_kako,x)


#データ完成

> nensyu_kako
    rank nensyu  age ninzu      area gyosyu          gyosyu_name ninzu_class
1      1   1947 29.9    36     tokyo   9050           サービス業           1
2      2   1506 43.4    35     tokyo   5250         情報・通信業           1
3      3   1499 51.3    70     tokyo   5250         情報・通信業           1
4      4   1479 42.3   650     tokyo   5250         情報・通信業           1
5      5   1454 47.0  1232     tokyo   5250         情報・通信業           1
6      6   1440 34.8  2038     osaka   3650             電気機器           1
7      7   1412 34.5   160     tokyo   9050           サービス業           1
8      8   1395 42.1  1130     tokyo   5250         情報・通信業           1
9      9   1384 41.3  4274     tokyo   6050               卸売業           2
10    10   1356 42.8  6358     tokyo   6050               卸売業           3
11    11   1351 42.4  6160     tokyo   6050               卸売業           3
12    12   1351 44.8  1879     tokyo   5250         情報・通信業           1
13    13   1304 42.7  5413     tokyo   6050               卸売業           2
14    14   1303 51.3  1705     tokyo   6050               卸売業           1
15    15   1275 41.7  4385     tokyo   6050               卸売業           2
16    16   1268 41.7   116     tokyo   8050             不動産業           1
17    17   1240 40.1    80     tokyo   3650             電気機器           1
18    18   1221 44.5   113     tokyo   5250         情報・通信業           1
19    19   1205 42.7   223   hukuoka   5250         情報・通信業           1
20    20   1191 39.1  7384     tokyo   9050           サービス業           3
21    21   1184 46.7    19     tokyo   8050             不動産業           1
22    22   1174 44.0    40     tokyo   7050               銀行業           1
23    23   1172 41.8   448     tokyo   7150               保険業           1
24    24   1157 44.5   102     tokyo   3300       石油・石炭製品           1
25    25   1152 41.2   604     tokyo   7100 証券、商品先物取引業           1
26    26   1146 38.9   185     tokyo   5250         情報・通信業           1
27    27   1138 42.2   321     aichi   5250         情報・通信業           1
28    28   1119 33.5    90     tokyo   9050           サービス業           1
29    29   1119 46.7   310     tokyo   9050           サービス業           1
30    30   1118 39.8   146     tokyo   7100 証券、商品先物取引業           1
31    31   1107 40.7   711     tokyo   8050             不動産業           1
32    32   1107 46.3    25     tokyo   5250         情報・通信業           1
33    33   1101 41.3  1296     tokyo   8050             不動産業           1
34    34   1095 47.9    69     tokyo   3250               医薬品           1
35    35   1091 38.7  6026     tokyo   5250         情報・通信業           3
36    36   1080 44.3    73     tokyo   3250               医薬品           1
37    37   1070 45.2   118     tokyo   3200                 化学           1
38    38   1066 45.7   100     tokyo   3200                 化学           1
39    39   1056 41.0   116     tokyo   7100 証券、商品先物取引業           1
40    40   1052 44.2   196     tokyo   9050           サービス業           1
41    41   1052 42.2  2271     tokyo   6050               卸売業           1
42    42   1041 36.2   370     tokyo   9050           サービス業           1
43    43   1041 40.5  2809     aichi   6050               卸売業           2
44    44   1041 42.7    36     tokyo   8050             不動産業           1
45    45   1040 43.7  3502     tokyo   3250               医薬品           2
46    46   1036 42.3  5744     tokyo   3250               医薬品           3
47    47   1035 41.7  6578     tokyo   3250               医薬品           3
48    48   1026 44.2   105     tokyo   2050               建設業           1
49    49   1017 46.5    21     osaka   8050             不動産業           1
50    50   1014 42.4   244     tokyo   7100 証券、商品先物取引業           1
51    51   1010 40.1  2427     tokyo   5250         情報・通信業           1
52    52   1009 41.1   277     tokyo   5250         情報・通信業           1
53    53   1008 42.6   273     tokyo   3050               食料品           1
54    54    995 43.6    85     tokyo   7150               保険業           1
55    55    995 44.7    48     tokyo   8050             不動産業           1
56    56    985 35.7   414     tokyo   9050           サービス業           1
57    57    983 43.2  2238  kanagawa   2050               建設業           1
58    58    980 43.4  2661 yamanashi   2050               建設業           1
59    59    975 43.7   209     tokyo   7100 証券、商品先物取引業           1
60    60    974 39.9  1136     tokyo   5100               海運業           1
61    61    971 43.6    34     tokyo   3050               食料品           1
62    62    969 38.9   482     tokyo   3050               食料品           1
63    63    965 42.0    38     tokyo   4050         電気・ガス業           1
64    64    965 42.7   881     tokyo   5250         情報・通信業           1
65    65    963 38.1    61     osaka   8050             不動産業           1
66    66    960 39.3  2025     tokyo   7100 証券、商品先物取引業           1
67    67    960 41.5  9965     tokyo   2050               建設業           4
68    68    958 44.9    11     tokyo   7100 証券、商品先物取引業           1
69    69    955 46.5    10     tokyo   7200         その他金融業           1
70    70    950 42.8    74     tokyo   3100             繊維製品           1
71    71    944 41.7  1630  kanagawa   2050               建設業           1
72    72    944 41.7   118   okayama   9050           サービス業           1
73    73    943 38.8  6734     osaka   3250               医薬品           3
74    74    943 44.5    37     tokyo   3450                 鉄鋼           1
75    75    940 43.1  2332     osaka   3200                 化学           1
76    76    939 41.4 10837     tokyo   5250         情報・通信業           4
77    77    938 41.0   110     tokyo   9050           サービス業           1
78    78    937 41.5  4932     tokyo   3250               医薬品           2
79    79    937 43.0  1485     tokyo   2050               建設業           1
80    80    935 44.5   953     tokyo   3300       石油・石炭製品           1
81    81    934 47.8    56     tokyo   5250         情報・通信業           1
82    82    934 49.7    75  kanagawa   5050               陸運業           1
83    83    930 39.6  1499     tokyo   1050                 鉱業           1
84    84    925 38.3    35     tokyo   7100 証券、商品先物取引業           1
85    85    924 44.5   212     tokyo   9050           サービス業           1
86    86    917 38.3   230     chiba   5100               海運業           1
87    87    916 43.1   188  kanagawa   3650             電気機器           1
88    88    909 41.7  3518     tokyo   3050               食料品           2
89    89    909 46.6    38     osaka   3250               医薬品           1
90    90    908 45.4  2888     tokyo   3650             電気機器           2
91    91    907 36.7   142     tokyo   5100               海運業           1
92    92    907 40.9   422     tokyo   8050             不動産業           1
93    93    901 53.4    12  kanagawa   6050               卸売業           1
94    94    900 45.4    61     tokyo   9050           サービス業           1
95    95    899 44.1    21     tokyo   7100 証券、商品先物取引業           1
96    96    898 38.1  2393     tokyo   7100 証券、商品先物取引業           1
97    97    896 45.5   108     tokyo   3250               医薬品           1
98    98    896 37.6   892     tokyo   5100               海運業           1
99    99    896 41.6    67     osaka   5050               陸運業           1
100  100    895 44.9  1696     tokyo   2050               建設業           1
101  101    895 47.1    38     tokyo   5250         情報・通信業           1


ただランキングを並べるとこんな感じ

library(ggplot2)
nensyu_kako$gyosyu<-as.factor(nensyu_kako$gyosyu)
ggplot2::ggplot(nensyu_kako,aes(x=rank,y=nensyu,colour=gyosyu_name))+
  geom_point()

f:id:WAFkw:20150726232108p:plain


業種で色分けしてみたものの
もっとグループごとに見やすくしないことには始まらない

ggplot2のfacetを使ってみよう

どうやら
図を垂直・水平方向にサブグループで分割出来るらしい

ということは知っていましたが
どうもその「垂直」「水平」に分割するということがいまいちピンときていなかったので

やってみた

変な図その①:垂直・水平両方に切ってみる

#業種とエリア(本社所在地)で分割

ggplot2::ggplot(nensyu_kako,aes(x=rank,y=nensyu,colour=gyosyu_name))+
  geom_point()+
  facet_grid(gyosyu_name~area)

f:id:WAFkw:20150726233155p:plain


????

違くね???

変な図その②:水平方向に切ってみる

#エリアで水平に分割

ggplot2::ggplot(nensyu_kako,aes(x=rank,y=nensyu,colour=gyosyu_name))+
  geom_point()+
  facet_grid(area~.)

f:id:WAFkw:20150726233652p:plain

????

違くね???


ここで
年収データをY軸にしている今、
グループ間で比較したいのは「年収」であり
それを分割してはいけないのだと気が付いたので

少し何かを察してきた図①

#エリアで垂直に分割
ggplot2::ggplot(nensyu_kako,aes(x=rank,y=nensyu,colour=gyosyu_name))+
  geom_point()+
  facet_grid(.~area)

f:id:WAFkw:20150726234527p:plain


少し何かを掴みかけてきました

しかしながら東京以外に本社or本店を持つ企業が少なすぎてアレなんで

少し何かを察してきた図②

#従業員人数クラスで垂直に分割

ggplot2::ggplot(nensyu_kako,aes(x=rank,y=nensyu,colour=gyosyu_name))+
  geom_point()+
  facet_grid(.~ninzu_class)

f:id:WAFkw:20150726234901p:plain

(人数クラスは等間隔で分けてるので
約3000人くらいずつ1~4に分割されてるはず)

ここまでくると

年収トップ100位以内の企業は
1~3000人規模の企業が多め、でも従業員規模によって順位自体に違いがあるとは言えなそう

ってのが見えてきました

業種と従業員数にはちょっとした関連があるかも・・・というのも。


まとめにならないまとめ

はじめてfacetしてみて

・水平方向に分割

X軸をグループ別に比較したいとき→時系列データとかによいかも

・垂直方向に分割

Y軸をグループ別に比較したいとき→今回みたいなやつとか


という感覚を得ました
ふつーに箱ひげ図でいいと言われてしまえばそれまでなものの。


年収に関しては大して何の知見も得てません。


現場からは以上です。
番外編でした。

{GGally}と{Nippon}パッケージで都道府県データを腰を据えて可視化(したい)

札幌が嘘みたいに暑くて溶けそうです。

クーラー。クーラーほしい。

てーま

・久々に前処理について考えたい
・そういえば日本のコロプレス図やったことない
・SappoRo.Rでも話題に出ていた{GGally}使ってみようかな

てことで
いつものことながらe-statです。

お題

こちらの記事を拝見していて
ほう・・・都道府県でそういう違いもあるのね・・・と。

データえっせい: 47都道府県の保育タイプ

子供の養育を、父母中心となってやるか、保育園に預けるのがメインか
という都道府県別データがあるとのことなので
自前でいろいろ組み合わせてみました

都道府県別進学率
都道府県別学力テスト結果
都道府県別主要な保育者の割合

をe-statからダウンロードしてきて、
どういうアプローチが出来そうか、分析の「手前」部分を考えるというのが本日のメインです

データ整形

このへんはざっくりとscriptのみ。

ID<-read.csv("ID.csv",header=F) #自前の都道府県マスタ
singaku<-read.csv("sinngaku.csv",header=F) #学校基本調査【22-18】
hoiku<-read.csv("hoiku.csv",header=T) #国民生活基礎調査19表
gakuryoku<-read.csv("gakuryoku_chu.csv",header=T) #全国学力・学習状況調査

head(ID)
head(singaku)
head(hoiku)
head(gakuryoku)

#今回は都道府県順が一定なのでrownameをIDとしてつけて、JOINします

#gakuryokuの前処理
library(dplyr)
gakuryoku_kako<-gakuryoku[,-1]
head(gakuryoku_kako)
gakuryoku_kako<-dplyr::mutate(gakuryoku_kako,ID=row.names(gakuryoku_kako)) %>%
  select(.,ID,kokugoA:zentai) 
str(gakuryoku_kako)#なんか一行多い
gakuryoku_kako<-gakuryoku_kako[-48,]#消した
head(gakuryoku_kako)

#singakuの前処理
singaku_kako<-singaku
head(singaku_kako)
str(singaku_kako)
singaku_kako<-singaku_kako[-1,1:2] %>%
  dplyr::mutate(.,ID=as.numeric(row.names(.))-1) %>%
  select(.,ID,V2)
colnames(singaku_kako)<-c("ID","singaku")
head(singaku_kako)

#hoikuの前処理
head(hoiku)
hoiku_kako<-hoiku[-(1:4),]
head(hoiku_kako)
colnames(hoiku_kako)<-c("name","sousu","hubo","souhubo","ninka","ninkagai","youchien","sonota","husyou")
hoiku_kako<-hoiku_kako[,2:5] %>%
  dplyr::mutate(.,ID=as.numeric(row.names(.))-4) %>%
  select(.,ID,sousu,hubo,souhubo,ninka)
head(hoiku_kako)

#保育者が父母の割合、認可保育園の割合に変換
str(hoiku_kako)
hoiku_kako$sousu<-as.numeric(as.character(hoiku_kako$sousu))
hoiku_kako$hubo<-as.numeric(as.character(hoiku_kako$hubo))
hoiku_kako$ninka<-as.numeric(as.character(hoiku_kako$ninka))
head(hoiku_kako)

hoiku_kako<-hoiku_kako[,-4] %>%
  dplyr::mutate(.,huboritu=hubo/sousu*100,hoikuen=ninka/sousu*100) %>%
  select(.,ID,huboritu,hoikuen)
head(hoiku_kako)

#型確認,統合
str(gakuryoku_kako)
str(singaku_kako)
str(hoiku_kako)
str(ID)
gakuryoku_kako$ID<-as.numeric(gakuryoku_kako$ID)
ID$ID<-as.numeric(ID$ID)
colnames(ID)<-c("ID","name","area")


library(dplyr)
tougou<-dplyr::inner_join(ID,singaku_kako,by="ID") %>%
  dplyr::inner_join(.,gakuryoku_kako,by="ID") %>%
  dplyr::inner_join(.,hoiku_kako,by="ID")


#整形後データ
tougou

> tougou
   ID     name     area singaku kokugoA kokugoB sugakuA sugakuB zentai huboritu  hoikuen
1   1   北海道 hokkaido    40.4    76.0    66.2    62.3    39.1   63.4 47.69874 30.54393
2   2   青森県   tohoku    41.9    78.8    67.7    65.0    42.4   66.1 32.05128 52.56410
3   3   岩手県   tohoku    41.2    78.2    68.1    59.9    37.4   63.1 35.08772 49.12281
4   4   宮城県   tohoku    45.5    77.6    68.6    62.2    39.7   64.3 44.82759 25.00000
5   5   秋田県   tohoku    44.5    81.9    74.6    68.9    47.5   70.2 38.00000 50.00000
6   6   山形県   tohoku    46.3    78.9    69.1    63.1    40.7   65.2 34.00000 42.00000
7   7   福島県   tohoku    42.3    77.3    66.4    61.0    38.1   63.1 43.67816 25.28736
8   8   茨城県   kantou    50.9    77.2    69.5    62.9    42.1   64.9 45.18519 35.55556
9   9   栃木県   kantou    54.3    77.2    68.0    63.8    41.1   64.9 41.58416 28.71287
10 10   群馬県   kantou    52.5    78.1    68.8    64.9    42.8   66.1 39.78495 45.16129
11 11   埼玉県   kantou    57.1    76.5    68.8    62.8    40.6   64.3 50.13699 25.20548
12 12   千葉県   kantou    54.8    76.2    68.1    63.2    41.5   64.3 46.76923 24.61538
13 13   東京都   kantou    65.5    77.3    69.3    65.2    43.2   65.9 48.83721 28.57143
14 14 神奈川県   kantou    60.8    76.3    68.9    63.8    41.9   64.8 48.89868 21.14537
15 15   新潟県    tyubu    47.3    76.5    66.6    62.7    39.2   63.9 35.71429 53.57143
16 16   富山県    tyubu    54.2    78.9    70.4    65.8    43.9   66.9 36.17021 53.19149
17 17   石川県    tyubu    54.8    78.3    70.7    66.6    45.0   67.4 36.66667 60.00000
18 18   福井県    tyubu    56.0    80.0    71.7    69.9    49.2   70.1 29.26829 60.97561
19 19   山梨県    tyubu    57.9    76.9    67.4    62.1    40.0   63.9 42.85714 42.85714
20 20   長野県    tyubu    49.6    76.8    65.9    61.9    40.2   63.7 44.44444 50.50505
21 21   岐阜県    tyubu    57.1    77.1    70.2    66.6    45.7   67.0 42.70833 32.29167
22 22   静岡県    tyubu    54.1    77.1    68.7    65.0    44.6   66.0 47.12042 26.17801
23 23   愛知県    tyubu    58.9    76.3    67.1    66.3    44.5   66.0 48.26790 32.79446
24 24   三重県   kansai    52.2    75.0    65.8    63.2    39.3   63.4 41.30435 41.30435
25 25   滋賀県   kansai    58.0    75.5    65.6    64.4    40.4   64.3 44.30380 32.91139
26 26   京都府   kansai    66.1    76.3    68.2    64.2    42.9   65.1 39.68254 40.47619
27 27   大阪府   kansai    58.7    73.3    63.0    61.7    38.8   61.9 48.90511 29.68370
28 28   兵庫県   kansai    59.9    76.8    67.0    65.9    43.8   65.9 53.39506 28.08642
29 29   奈良県   kansai    58.1    77.1    67.5    65.5    42.9   65.9 54.23729 30.50847
30 30 和歌山県   kansai    49.3    74.4    64.3    63.4    40.3   63.3 48.78049 36.58537
31 31   鳥取県  tyugoku    43.9    77.6    68.6    64.8    43.0   65.8 34.61538 53.84615
32 32   島根県  tyugoku    47.2    77.2    69.1    62.9    40.8   64.5 30.30303 63.63636
33 33   岡山県  tyugoku    52.9    76.4    66.4    62.8    40.3   63.9 47.27273 34.54545
34 34   広島県  tyugoku    61.1    76.7    69.2    64.8    43.5   65.6 40.66667 43.33333
35 35   山口県  tyugoku    43.2    77.3    68.3    65.5    44.2   66.1 49.29577 29.57746
36 36   徳島県  shikoku    53.0    76.5    64.9    65.4    42.6   65.3 39.39394 39.39394
37 37   香川県  shikoku    51.1    76.6    67.0    66.3    44.6   66.1 35.55556 40.00000
38 38   愛媛県  shikoku    52.7    76.5    67.2    64.5    44.0   65.3 44.77612 29.85075
39 39   高知県  shikoku    45.4    74.3    64.8    59.3    35.4   60.9 28.94737 55.26316
40 40   福岡県   kyusyu    53.3    75.4    66.5    62.0    39.8   63.2 43.70370 34.07407
41 41   佐賀県   kyusyu    42.3    75.3    65.8    61.7    39.5   62.9 37.77778 44.44444
42 42   長崎県   kyusyu    42.2    76.1    66.6    63.2    41.3   64.2 41.17647 41.17647
43 43   熊本県   kyusyu    43.1    76.6    67.1    63.4    43.0   64.7 42.04545 45.45455
44 44   大分県   kyusyu    47.4    76.0    66.7    62.0    39.2   63.3 50.68493 31.50685
45 45   宮崎県   kyusyu    43.0    76.1    66.4    64.0    41.4   64.4 36.66667 51.66667
46 46 鹿児島県   kyusyu    42.0    75.4    64.8    61.5    39.2   62.7 36.55914 41.93548
47 47   沖縄県  okinawa    36.7    69.2    62.4    53.2    29.8   55.5 35.95506 33.70787

{GGaly}を使ってみよう

データが整ったので変数同士の相関を見たい。
普通にpairs()とかしてもよいのですが、どうやら巷にはggpairs()なる
ggplot2っぽい散布行列があるらしい・・・

このままだと説明変数が多くて見にくくなりそうなので、
今回は

"singaku","zentai","huboritu","hoikuen"

に的を絞って試してみます

自称「都道府県マスタ」を使って
都道府県に対して地域情報(東北、関東、中部・・・etc)
を加えたので、地域別に色分けもしてみました

install.packages("GGally")
library(GGally)
tougou_zentai<-tougou
head(tougou_zentai)
tougou_zentai<-tougou_zentai[,-(5:8)]

GGally::ggpairs(data = tougou_zentai,columns =4:ncol(tougou_zentai),colour="area",pointsize=9)

f:id:WAFkw:20150712222744p:plain

おおお
きれいだ

上対角部分は、それぞれの変数同士の相関係数を表示してくれています。

地域別に表示して貰った結果
変数によっては地域ごとに差が出ていて、階層モデルを適用出来そうな気もしてきますね・・・
(特に進学まわり)

地図にも描いてみよう

あれこれ考えたんですが、
いったん地図上に落としてみようかなと。

{Nippon}パッケージなるものがあるそうなので
使ってみました

#Nippon--------------------------------------------------------------
install.packages("Nippon")

#地域別でこんな感じ
Nippon::JapanPrefecturesMap(col = tougou_zentai$area)

#主な保育方法が「父母」の率を色分け
Nippon::JapanPrefecturesMap(col = tougou_zentai$huboritu)

地域の可視化
f:id:WAFkw:20150712223714p:plain

父母率での可視化
f:id:WAFkw:20150712223724p:plain


あまりいじってないのでかんたんにできました。

しかしながらデフォルトのカラーパレットはRGB系かつ8色なので、
どーも見ずらい。

あと、父母による養育率が地域ごとにバラついてるの?どうなの?色かぶってるだけ?
という感じなので、ある程度数値をまとめてグループにしてみることに。

数値データの離散化

たとえばたとえば、

0~20%:1
21~40%:2

みたいな感じに、データの幅でグループに分けられたらいいなあと。

huboritu(父母養育率)と
singaku(進学率)

でそれぞれ試してみます。

#huborituのクラス分けを追加----------------------------------------

install.packages("infotheo")
head(tougou_zentai,10)

x=infotheo::discretize(subset(tougou_zentai,select=huboritu),disc="equalwidth")
colnames(x)<-c("huboritu_class")
tougou_zentai<-cbind(tougou_zentai,x)

#singakuのクラス分け---------------------------------------------
x_singaku=infotheo::discretize(subset(tougou_zentai,select=singaku),disc="equalwidth")
colnames(x_singaku)<-c("singaku_class")
tougou_zentai<-cbind(tougou_zentai,x_singaku)


#出来たデータ
> tougou_zentai
   ID     name     area singaku zentai huboritu  hoikuen huboritu_class singaku_class
1   1   北海道 hokkaido    40.4   63.4 47.69874 30.54393              3             1
2   2   青森県   tohoku    41.9   66.1 32.05128 52.56410              1             1
3   3   岩手県   tohoku    41.2   63.1 35.08772 49.12281              1             1
4   4   宮城県   tohoku    45.5   64.3 44.82759 25.00000              2             1
5   5   秋田県   tohoku    44.5   70.2 38.00000 50.00000              2             1
6   6   山形県   tohoku    46.3   65.2 34.00000 42.00000              1             1
7   7   福島県   tohoku    42.3   63.1 43.67816 25.28736              2             1
8   8   茨城県   kantou    50.9   64.9 45.18519 35.55556              2             2
9   9   栃木県   kantou    54.3   64.9 41.58416 28.71287              2             2
10 10   群馬県   kantou    52.5   66.1 39.78495 45.16129              2             2
11 11   埼玉県   kantou    57.1   64.3 50.13699 25.20548              3             3
12 12   千葉県   kantou    54.8   64.3 46.76923 24.61538              3             2
13 13   東京都   kantou    65.5   65.9 48.83721 28.57143              3             3
14 14 神奈川県   kantou    60.8   64.8 48.89868 21.14537              3             3
15 15   新潟県    tyubu    47.3   63.9 35.71429 53.57143              1             2
16 16   富山県    tyubu    54.2   66.9 36.17021 53.19149              1             2
17 17   石川県    tyubu    54.8   67.4 36.66667 60.00000              1             2
18 18   福井県    tyubu    56.0   70.1 29.26829 60.97561              1             2
19 19   山梨県    tyubu    57.9   63.9 42.85714 42.85714              2             3
20 20   長野県    tyubu    49.6   63.7 44.44444 50.50505              2             2
21 21   岐阜県    tyubu    57.1   67.0 42.70833 32.29167              2             3
22 22   静岡県    tyubu    54.1   66.0 47.12042 26.17801              3             2
23 23   愛知県    tyubu    58.9   66.0 48.26790 32.79446              3             3
24 24   三重県   kansai    52.2   63.4 41.30435 41.30435              2             2
25 25   滋賀県   kansai    58.0   64.3 44.30380 32.91139              2             3
26 26   京都府   kansai    66.1   65.1 39.68254 40.47619              2             3
27 27   大阪府   kansai    58.7   61.9 48.90511 29.68370              3             3
28 28   兵庫県   kansai    59.9   65.9 53.39506 28.08642              3             3
29 29   奈良県   kansai    58.1   65.9 54.23729 30.50847              3             3
30 30 和歌山県   kansai    49.3   63.3 48.78049 36.58537              3             2
31 31   鳥取県  tyugoku    43.9   65.8 34.61538 53.84615              1             1
32 32   島根県  tyugoku    47.2   64.5 30.30303 63.63636              1             2
33 33   岡山県  tyugoku    52.9   63.9 47.27273 34.54545              3             2
34 34   広島県  tyugoku    61.1   65.6 40.66667 43.33333              2             3
35 35   山口県  tyugoku    43.2   66.1 49.29577 29.57746              3             1
36 36   徳島県  shikoku    53.0   65.3 39.39394 39.39394              2             2
37 37   香川県  shikoku    51.1   66.1 35.55556 40.00000              1             2
38 38   愛媛県  shikoku    52.7   65.3 44.77612 29.85075              2             2
39 39   高知県  shikoku    45.4   60.9 28.94737 55.26316              1             1
40 40   福岡県   kyusyu    53.3   63.2 43.70370 34.07407              2             2
41 41   佐賀県   kyusyu    42.3   62.9 37.77778 44.44444              2             1
42 42   長崎県   kyusyu    42.2   64.2 41.17647 41.17647              2             1
43 43   熊本県   kyusyu    43.1   64.7 42.04545 45.45455              2             1
44 44   大分県   kyusyu    47.4   63.3 50.68493 31.50685              3             2
45 45   宮崎県   kyusyu    43.0   64.4 36.66667 51.66667              1             1
46 46 鹿児島県   kyusyu    42.0   62.7 36.55914 41.93548              1             1
47 47   沖縄県  okinawa    36.7   55.5 35.95506 33.70787              1             1

右側2列に、進学率と父母養育率のデータを等間隔に3分割したグループが追加されました。

これを基に改めて日本を描いてみます

#父母養育率(グループ色分け)
Nippon::JapanPrefecturesMap(col = tougou_zentai$huboritu_class)
#進学率(グループ色分け)
Nippon::JapanPrefecturesMap(col = tougou_zentai$singaku_class)

f:id:WAFkw:20150712224955p:plainf:id:WAFkw:20150712225018p:plain

左が父母養育率、右が進学率です。

ぱっと見ただけじゃなんともいえないですが、
関東から西のエリアでは父母養育率と大学進学率のグループ一致が見られるような。

特に父母養育率地域性濃そうだなあ~

階層的な分布でもあるし
もう少し調べてみられるかも。。

ちなみに

私自身両親フル共働きの「保育園型」で育った身なので、
「父母養育型」子育てだと進学率に影響あるよ!みたいな短絡的かつ思想的な話をするつもりは1ミリも無く。

なんとなく出来心のエントリでした。


ああ、休日がもう終わってしまう