読者です 読者をやめる 読者になる 読者になる

次元の海で溺れる

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

【TeachingDemos】誕生日なので大豆について考えてみた(2)

n+1歳したよポエムは後に回すとして、

世は節分なので大豆について考える。パート2。


前回
wafdata.hatenablog.com

テーマ

都道府県別の大豆データがあったので
サブプロットとして地図に埋め込んでみる。

実はちょっと夢だったサブプロット。わくわく。

使用データ

農林水産省/大豆関連データ集)より、


都道府県別生産状況(大豆収穫量(t))
・豆腐・納豆の都市別購入順位(豆腐都市別購入金額・納豆都市別購入金額)

このへんをお借りしてやってみる。

準備

シェープファイルはNipponパッケージのフォルダに含まれているやつを借りる。
CRSクラス作成では投影法を地球座標系、準拠楕円体をWGS84に指定した。

>map <- system.file("shapes/jpn.shp", package = "Nippon")[1] %>% 
   maptools::readShapePoly(., proj4string = CRS("+proj=longlat +datum=WGS84"))

> map@data
   SP_ID jiscode      name population           region
0      1      01  Hokkaido    5506419         Hokkaido
1      2      02    Aomori    1373339           Tohoku
2      3      03     Iwate    1330147           Tohoku
3      4      04    Miyagi    2348165           Tohoku
4      5      05     Akita    1085997           Tohoku
5      6      06  Yamagata    1168924           Tohoku
6      7      07 Fukushima    2029064           Tohoku
7      8      08   Ibaraki    2969770            Kanto
8      9      09   Tochigi    2007683            Kanto
9     10      10     Gunma    2008068            Kanto
10    11      11   Saitama    7194556            Kanto
11    12      12     Chiba    6216289            Kanto
12    13      13     Tokyo   13159388            Kanto
13    14      14  Kanagawa    9048331            Kanto
14    15      15   Niigata    2374450            Chubu
15    16      16    Toyama    1093247            Chubu
16    17      17  Ishikawa    1169788            Chubu
17    18      18     Fukui     806314            Chubu
18    19      19 Yamanashi     863075            Chubu
19    20      20    Nagano    2152449            Chubu
20    21      21      Gifu    2080773            Chubu
21    22      22  Shizuoka    3765007            Chubu
22    23      23     Aichi    7410719            Chubu
23    24      24       Mie    1854724            Chubu
24    25      25     Shiga    1410777            Kinki
25    26      26     Kyoto    2636092            Kinki
26    27      27     Osaka    8865245            Kinki
27    28      28     Hyogo    5588133            Kinki
28    29      29      Nara    1400728            Kinki
29    30      30  Wakayama    1002198            Kinki
30    31      31   Tottori     588667          Chugoku
31    32      32   Shimane     717397          Chugoku
32    33      33   Okayama    1945276          Chugoku
33    34      34 Hiroshima    2860750          Chugoku
34    35      35 Yamaguchi    1451338          Chugoku
35    36      36 Tokushima     785491          Shikoku
36    37      37    Kagawa     995842          Shikoku
37    38      38     Ehime    1431493          Shikoku
38    39      39     Kochi     764456          Shikoku
39    40      40   Fukuoka    5071968 Kyushu / Okinawa
40    41      41      Saga     849788 Kyushu / Okinawa
41    42      42  Nagasaki    1426779 Kyushu / Okinawa
42    43      43  Kumamoto    1817426 Kyushu / Okinawa
43    44      44      Oita    1196529 Kyushu / Okinawa
44    45      45  Miyazaki    1135233 Kyushu / Okinawa
45    46      46 Kagoshima    1706242 Kyushu / Okinawa
46    47      47   Okinawa    1392818 Kyushu / Okinawa

data部抜くとこんな感じ。
ちなみに人口も地域も入っているので相当便利。

で、
このデータ部の行番号の順を動かさずに、大豆のデータをくっつけたいので、
nameをキーにしてJOINすればいいかなーという方針を立てる。


各種大豆データを
PDF→CSVして、都道府県名をローマ字にするなどすると

>mame_sub<-read.csv("0203mame.csv",header = TRUE)
>knitr::kable(mame_sub)

|name      | natto| tofu| mame_t|
|:---------|-----:|----:|------:|
|Hokkaido  |  3847| 4362|  73600|
|Aomori    |  4807| 5140|   5370|
|Iwate     |  4654| 6945|   5470|
|Miyagi    |  5485| 6264|  19300|
|Akita     |  4477| 5123|   9640|
|Yamagata  |  5569| 5906|   7720|
|Fukushima |  5298| 5254|   2220|
|Ibaraki   |  5916| 4839|   5410|
|Tochigi   |  3962| 5111|   4250|
|Gunma     |  4808| 5226|    444|
|Saitama   |  4406| 6328|    786|
|Chiba     |  4064| 6151|   1080|
|Tokyo     |  3618| 5969|      4|
|Kanagawa  |  3418| 5820|     64|
|Niigata   |  4586| 5070|   8840|
|Toyama    |  4329| 4927|   7630|
|Ishikawa  |  3505| 5176|   2310|
|Fukui     |  3238| 4815|   2430|
|Yamanashi |  4501| 5274|    289|
|Nagano    |  4157| 4510|   3380|
|Gifu      |  3160| 5078|   3430|
|Shizuoka  |  3735| 6057|    317|
|Aichi     |  3348| 5350|   7180|
|Mie       |  2429| 5307|   3750|
|Shiga     |  2912| 5059|   9450|
|Kyoto     |  2680| 5982|    455|
|Osaka     |  1945| 5470|     20|
|Hyogo     |  2289| 5709|   3320|
|Nara      |  2421| 5408|    256|
|Wakayama  |  1994| 4864|     43|
|Tottori   |  2658| 6728|   1120|
|Shimane   |  2605| 6213|   1320|
|Okayama   |  2428| 4534|   2370|
|Hiroshima |  2592| 5258|    667|
|Yamaguchi |  2744| 4971|   1020|
|Tokushima |  2306| 6763|     45|
|Kagawa    |  2528| 5425|     97|
|Ehime     |  2628| 6170|    457|
|Kochi     |  2017| 6009|     61|
|Fukuoka   |  3125| 4563|  14300|
|Saga      |  3317| 6053|  15300|
|Nagasaki  |  2672| 4824|    496|
|Kumamoto  |  3861| 5417|   3710|
|Oita      |  3604| 6288|   1690|
|Miyazaki  |  2937| 5239|    317|
|Kagoshima |  3513| 5471|    301|
|Okinawa   |  2389| 7478|      1|

#natto<-納豆購入額
#tofu<-豆腐購入額
#mame_t<-大豆収穫量(t)


あとはJOINして準備するだけ。

#JOINしたものをデータ部に置き換え
map@data<- dplyr::left_join(map@data,mame_sub,"name") 

#各都道府県の代表点抽出
>map.c<-coordinates(map) %>% 
  as.data.frame(.)
>knitr::kable(map.c)


|   |       V1|       V2|
|:--|--------:|--------:|
|0  | 142.5637| 43.37322|
|1  | 140.8369| 40.78999|
|2  | 141.3672| 39.59491|
|3  | 140.9347| 38.45849|
|4  | 140.4040| 39.75225|
|5  | 140.1059| 38.44662|
|6  | 140.2207| 37.38554|
|7  | 140.3268| 36.33433|
|8  | 139.8238| 36.68965|
|9  | 138.9818| 36.51044|
|10 | 139.3504| 35.99388|
|11 | 140.2134| 35.53588|
|12 | 139.4481| 35.69395|
|13 | 139.3502| 35.40736|
|14 | 138.9373| 37.46545|
|15 | 137.2517| 36.63167|
|16 | 136.7571| 36.73964|
|17 | 136.2342| 35.83485|
|18 | 138.6130| 35.61755|
|19 | 138.0369| 36.12952|
|20 | 137.0573| 35.78676|
|21 | 138.3440| 35.00518|
|22 | 137.2163| 35.04840|
|23 | 136.3712| 34.54634|
|24 | 136.1268| 35.22382|
|25 | 135.4460| 35.24641|
|26 | 135.5121| 34.62303|
|27 | 134.8311| 35.08439|
|28 | 135.8637| 34.31070|
|29 | 135.5186| 33.90602|
|30 | 133.8624| 35.36655|
|31 | 132.4981| 35.00385|
|32 | 133.8122| 34.89499|
|33 | 132.7951| 34.63696|
|34 | 131.5512| 34.20905|
|35 | 134.2566| 33.91387|
|36 | 133.9805| 34.20724|
|37 | 132.8611| 33.60891|
|38 | 133.3812| 33.41964|
|39 | 130.6720| 33.53417|
|40 | 130.1211| 33.28651|
|41 | 129.9260| 32.95754|
|42 | 130.8424| 32.64685|
|43 | 131.4390| 33.18740|
|44 | 131.2934| 32.18176|
|45 | 130.6119| 31.62818|
|46 | 127.9566| 26.48630|

cols<-c("#E06A3B","#FBE481") #色スタンバイ

抽出した代表点に、各サブプロットを置いていくイメージです。

棒グラフで豆腐と納豆を比較する

分かりそうなことは、
豆腐と納豆の購入額を純粋に比較して、地域差がどう出るか、みたいなとこでしょうか。
ただの差の比較にしかならないけど。

#元となるplot
plot(map,col=gray(0.8))


#サブプロット用データと、Y軸の最大値決めるためのMax値
>map.d<-cbind(map@data$natto,map@data$tofu)
>map.m<-max(map.d)

#各ポリゴンの代表点の位置にsubplotをする
for(i in 1:nrow(map.c)){
  subplot(barplot(map.d[i,],ylim=c(0,map.m),col=cols,
                  names=c("",""),yaxt="n"),x=map.c[i,1],
          y=map.c[i,2],size=c(0.1,0.5),vadj=0)
}

locator(2)
legend(139,29,c("納豆","豆腐"),fill=cols,cex=0.8)

f:id:WAFkw:20160203001022p:plain

(forで回しちゃったけどいいやり方あるかしら...)


Y軸を共通にしているので一応単純比較出来るはず。

これが結構おもしろい。


圧倒的西日本の豆腐消費がまず目につく。
が、
圧倒的納豆消費の少なさも目に付く。

東日本は豆腐消費はほどほど、
納豆もほどほど、といった感じ。

これはそれぞれコロプレス図みたいにしてもパキっと分かれて綺麗そう。

特に納豆。納豆。

近畿・中国・四国は特に少ないけどたまたまかなあ、
経年でデータ持ってきてみれば良かった。失敗。

円グラフもしてみる

円グラフもかいてみた

plot(map,col=gray(0.8))

for(i in 1:nrow(map.c)){
  subplot(pie(cbind(map@data$natto[i],map@data$tofu[i]),col=cols,labels=c("","")),
          x=map.c[i,1],y=map.c[i,2],size=c(0.3,0.3),vadj=0)
}
legend(139,29,c("納豆","豆腐"),fill=cols,cex=0.8)

f:id:WAFkw:20160203001959p:plain


なんか凡例がうまく表示されない。はて。

円でも黄色比重が高まっているエリアを見つけられる。
このデータの作りだとあまり円にする意味は無かったかな...

円の大きさを大豆の収穫量で変化するようにしてみた

第3の要素として、ここに各都道府県の大豆の収穫量をちゃっかり入れて、
円グラフの半径として使う。

大豆収穫量の多いところと消費の関連とか掴めたらおもしろいなーと思ったんだけど...

#サイズ変える
r<-sqrt(map@data$mame_t/pi) #円の大きさは大豆収穫量/パイの二乗根
r<-r/max(r)*0.4

plot(map,col=gray(0.8))

for(i in 1:nrow(map.c)){
  subplot(pie(cbind(map@data$natto[i],map@data$tofu[i]),col=cols,labels=c("","")),
              x=map.c[i,1],y=map.c[i,2],size=c(r[i],r[i]),vadj=0)
}
legend(139,29,c("納豆","豆腐"),fill=cols,bty="n",cex=0.8)

f:id:WAFkw:20160203002446p:plain


...世の中そううまくはいかなかった。

作りなよ。みんなもっと大豆作りなよ。ってくらいの収穫量してた。
何も見えやしない。

豆の話(2)はおしまい

後味は悪いが今回はここまで。
まだ大豆データがあるから何か閃いたら(3)としてやろうかな



誕生日

あんまりめでたくないけどせっかく年が一つ増えて最初なので
なんか振り返りながらつらつらと書いてみる。

振り返る

・卒業:卒論を提出後完全にスイッチが切れて日本各地をぷらぷら
    大阪→京都 →秋田→(どこに居たか覚えてない10日)→
    気付いたら埼玉の某所で寿司食べてた

・仕事:こんなポンコツ根暗でも上司に恵まれてなんとか仕事が出来ている。
    頭が上がらない。

・趣味:卒業したらRを触る「理由」みたいなものが無くなってしまったので、
    趣味と開き直ってブログを始めたり、
    各所のRコミュニティーに勇気を振り絞って出たりした。
    塩を撒かれて追い返されるんだと思ってたのに、
    気が付いたらR繋がりで知り合いの方が増えてきて。
    
    Rについてはもっとわかるようになりたい。
    何をもってわかるとするのか、みたいのはあるけど。
    わかりたい、とは思う。し、
    そろそろ逃げない分析をやらなきゃなあ、とも思う。IRとかIRとか。

100万円貯まったら次の街へ行く


北の大地を出ることにした。


と、結構な決断をしたつもりだったのに、
どうやら自分から出ていかなくてもそうなりそうな予感。
多分近くも遠くもないうちに。

元々縁もゆかりも無かったけど、今じゃ永住出来ると思えるくらい一番好きな街なので、
札幌は心からおすすめ。

住んでるうちに変わるものも変わらないものもあって、
5年間少し穏やかに過ごし過ぎたので、次の街ではちょっと苦しみたいなというのが希望です。


まだもうしばらくは居る。予定。


ちなみにこれに感化されたわけではないけど良い映画。
とにもかくにも主題歌が名曲です。

百万円と苦虫女 [DVD]

百万円と苦虫女 [DVD]

おわり。