次元の海で溺れる

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

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

【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軸をグループ別に比較したいとき→今回みたいなやつとか


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


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


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