浅野・矢内『Rによる計量政治学』(2018,オーム社)

Chapter 09 変数間の関連性

Step1 : データ分析の開始

tidyverse パッケージを読み込む

library("tidyverse")
## ─ Attaching packages ── tidyverse 1.2.1 ─
## ✔ ggplot2 3.1.0     ✔ purrr   0.3.0
## ✔ tibble  1.4.2     ✔ dplyr   0.7.8
## ✔ tidyr   0.8.2     ✔ stringr 1.3.1
## ✔ readr   1.3.1     ✔ forcats 0.3.0
## Warning: package 'purrr' was built under R version 3.5.2
## ─ Conflicts ─── tidyverse_conflicts() ─
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
if (capabilities("aqua")) { # Macかどうか判定し、Macの場合のみ実行
  theme_set(theme_gray(base_size = 10, base_family = "HiraginoSans-W3"))
}

データを読み込む

衆院選データを読み込み。読み込みと同時にすぐさま確認する。

HR <- read_rds("data/hr-data.Rds")
glimpse(HR)
## Observations: 8,803
## Variables: 22
## $ year       <int> 1996, 1996, 1996, 1996, 1996, 1996, 1996, 1996, 199...
## $ ku         <chr> "aichi", "aichi", "aichi", "aichi", "aichi", "aichi...
## $ kun        <int> 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, ...
## $ status     <fct> 現職, 元職, 現職, 新人, 新人, 新人, 新人, 現職, 元職, 新人, 新人, 新人, 新人,...
## $ name       <chr> "KAWAMURA, TAKASHI", "IMAEDA, NORIO", "SATO, TAISUK...
## $ party      <chr> "NFP", "LDP", "DPJ", "JCP", "others", "kokuminto", ...
## $ party_code <int> 8, 1, 3, 2, 100, 22, 99, 8, 1, 3, 2, 10, 100, 99, 2...
## $ previous   <int> 2, 3, 2, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 3, ...
## $ wl         <fct> 当選, 落選, 落選, 落選, 落選, 落選, 落選, 当選, 落選, 復活当選, 落選, 落選, 落...
## $ voteshare  <dbl> 40.0, 25.7, 20.1, 13.3, 0.4, 0.3, 0.2, 32.9, 26.4, ...
## $ age        <int> 47, 72, 53, 43, 51, 51, 45, 51, 71, 30, 31, 44, 61,...
## $ nocand     <int> 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 7, 7, ...
## $ rank       <int> 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, ...
## $ vote       <int> 66876, 42969, 33503, 22209, 616, 566, 312, 56101, 4...
## $ eligible   <int> 346774, 346774, 346774, 346774, 346774, 346774, 346...
## $ turnout    <dbl> 49.2, 49.2, 49.2, 49.2, 49.2, 49.2, 49.2, 51.8, 51....
## $ exp        <int> 9828097, 9311555, 9231284, 2177203, NA, NA, NA, 129...
## $ expm       <dbl> 9.828097, 9.311555, 9.231284, 2.177203, NA, NA, NA,...
## $ vs         <dbl> 0.400, 0.257, 0.201, 0.133, 0.004, 0.003, 0.002, 0....
## $ exppv      <dbl> 28.341505, 26.851941, 26.620462, 6.278449, NA, NA, ...
## $ smd        <fct> 当選, 落選, 落選, 落選, 落選, 落選, 落選, 当選, 落選, 落選, 落選, 落選, 落選,...
## $ party_jpn  <chr> "新進党", "自民党", "民主党", "共産党", "その他", "国民党", "無所属", "新...
names(HR)
##  [1] "year"       "ku"         "kun"        "status"     "name"      
##  [6] "party"      "party_code" "previous"   "wl"         "voteshare" 
## [11] "age"        "nocand"     "rank"       "vote"       "eligible"  
## [16] "turnout"    "exp"        "expm"       "vs"         "exppv"     
## [21] "smd"        "party_jpn"
summary(HR) #いわゆる記述統計
##       year           ku                 kun          status    
##  Min.   :1996   Length:8803        Min.   : 1.000   新人:5096  
##  1st Qu.:2000   Class :character   1st Qu.: 2.000   現職:3138  
##  Median :2005   Mode  :character   Median : 4.000   元職: 569  
##  Mean   :2007                      Mean   : 5.738              
##  3rd Qu.:2012                      3rd Qu.: 8.000              
##  Max.   :2017                      Max.   :25.000              
##                                                                
##      name              party             party_code        previous     
##  Length:8803        Length:8803        Min.   :  1.00   Min.   : 0.000  
##  Class :character   Class :character   1st Qu.:  1.00   1st Qu.: 0.000  
##  Mode  :character   Mode  :character   Median :  3.00   Median : 0.000  
##                                        Mean   : 12.04   Mean   : 1.712  
##                                        3rd Qu.:  8.00   3rd Qu.: 3.000  
##                                        Max.   :100.00   Max.   :20.000  
##                                                                         
##         wl         voteshare          age           nocand     
##  落選    :5563   Min.   : 0.10   Min.   :25.0   Min.   :2.000  
##  当選    :2379   1st Qu.: 8.90   1st Qu.:43.0   1st Qu.:3.000  
##  復活当選: 861   Median :25.76   Median :51.0   Median :4.000  
##                  Mean   :27.08   Mean   :50.9   Mean   :3.956  
##                  3rd Qu.:42.90   3rd Qu.:59.0   3rd Qu.:5.000  
##                  Max.   :95.30   Max.   :94.0   Max.   :9.000  
##                                  NA's   :5                     
##       rank            vote           eligible         turnout     
##  Min.   :1.000   Min.   :   177   Min.   :115013   Min.   :48.90  
##  1st Qu.:1.000   1st Qu.: 18240   1st Qu.:269294   1st Qu.:57.80  
##  Median :2.000   Median : 49021   Median :330188   Median :62.70  
##  Mean   :2.477   Mean   : 54911   Mean   :325666   Mean   :62.96  
##  3rd Qu.:3.000   3rd Qu.: 86494   3rd Qu.:390637   3rd Qu.:67.53  
##  Max.   :9.000   Max.   :201461   Max.   :495212   Max.   :83.80  
##                                   NA's   :959      NA's   :1895   
##       exp                expm               vs             exppv         
##  Min.   :     535   Min.   : 0.0005   Min.   :0.0010   Min.   :  0.0013  
##  1st Qu.: 2803566   1st Qu.: 2.8036   1st Qu.:0.0890   1st Qu.:  8.1711  
##  Median : 6541589   Median : 6.5416   Median :0.2576   Median : 18.7049  
##  Mean   : 7542700   Mean   : 7.5427   Mean   :0.2708   Mean   : 23.0375  
##  3rd Qu.:11044485   3rd Qu.:11.0445   3rd Qu.:0.4290   3rd Qu.: 33.4005  
##  Max.   :27462362   Max.   :27.4624   Max.   :0.9530   Max.   :119.2479  
##  NA's   :2043       NA's   :2043                       NA's   :2043      
##    smd        party_jpn        
##  落選:6424   Length:8803       
##  当選:2379   Class :character  
##              Mode  :character  
##                                
##                                
##                                
##

理論的検討：データの外形から目星をつける

理論的検討：「（例えば）選挙費用と当落は関係あるのか？」（探りの段階）
まず、選挙費用と得票率の関係をみてみる必要がある。そこでまずは散布図を作成してみよう。

  1. 散布図１：選挙費用*得票率
hy_plot1 <- HR %>%  ggplot(aes( x =expm , y = voteshare))+
  geom_point() + #()の中を省略すると同上の内容を自動で入力してくれる。
  geom_smooth(method = "lm", se = FALSE) +
  labs(x = "選挙費用 (100万円)", y = "得票率 (%)")
print(hy_plot1)
## Warning: Removed 2043 rows containing non-finite values (stat_smooth).
## Warning: Removed 2043 rows containing missing values (geom_point).

Step2：データの整形。目的に応じてデータを整形しよう

サンプルサイズが大きかったので、見辛い結果となった。
また、選挙実施年によって二変数の関係は異なるのでは？
そこで、選挙年を統一（コントロール）して、特定の年のだけを見てみよう。

HR2012 <- dplyr::filter(HR, year == 2012)
glimpse(HR2012)
## Observations: 1,294
## Variables: 22
## $ year       <int> 2012, 2012, 2012, 2012, 2012, 2012, 2012, 2012, 201...
## $ ku         <chr> "aichi", "aichi", "aichi", "aichi", "aichi", "aichi...
## $ kun        <int> 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 4, ...
## $ status     <fct> 新人, 現職, 現職, 新人, 現職, 新人, 新人, 新人, 新人, 現職, 新人, 新人, 新人,...
## $ name       <chr> "KUMADA, HIROMICHI", "SATO, YUKO", "YOSHIDA, TSUNEH...
## $ party      <chr> "LDP", "mirai", "DPJ", "JCP", "DPJ", "LDP", "mirai"...
## $ party_code <int> 1, 12, 3, 2, 3, 1, 12, 2, 1, 3, 12, 2, 1, 12, 11, 3...
## $ previous   <int> 1, 1, 0, 0, 5, 1, 0, 0, 1, 6, 0, 0, 1, 4, 0, 0, 0, ...
## $ wl         <fct> 当選, 落選, 落選, 落選, 当選, 復活当選, 落選, 落選, 当選, 復活当選, 落選, 落選,...
## $ voteshare  <dbl> 40.7, 31.8, 19.3, 8.2, 44.8, 31.9, 15.2, 8.1, 36.7,...
## $ age        <int> 48, 49, 38, 49, 47, 41, 51, 64, 46, 54, 38, 47, 48,...
## $ nocand     <int> 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, ...
## $ rank       <int> 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 5, ...
## $ vote       <int> 77215, 60293, 36578, 15512, 94058, 67086, 31974, 16...
## $ eligible   <int> 373297, 373297, 373297, 373297, 383295, 383295, 383...
## $ turnout    <dbl> 52.7, 52.7, 52.7, 52.7, 56.8, 56.8, 56.8, 56.8, 56....
## $ exp        <int> 15215857, 3864350, 11853832, 1220570, 7592182, 7048...
## $ expm       <dbl> 15.215857, 3.864350, 11.853832, 1.220570, 7.592182,...
## $ vs         <dbl> 0.407, 0.318, 0.193, 0.082, 0.448, 0.319, 0.152, 0....
## $ exppv      <dbl> 40.760727, 10.351945, 31.754426, 3.269702, 19.80767...
## $ smd        <fct> 当選, 落選, 落選, 落選, 当選, 落選, 落選, 落選, 当選, 落選, 落選, 落選, 当選,...
## $ party_jpn  <chr> "自民党", "未来", "民主党", "共産党", "民主党", "自民党", "未来", "共産党...
summary(HR2012)
##       year           ku                 kun         status   
##  Min.   :2012   Length:1294        Min.   : 1.00   新人:790  
##  1st Qu.:2012   Class :character   1st Qu.: 2.00   現職:404  
##  Median :2012   Mode  :character   Median : 4.00   元職:100  
##  Mean   :2012                      Mean   : 5.86             
##  3rd Qu.:2012                      3rd Qu.: 8.00             
##  Max.   :2012                      Max.   :25.00             
##                                                              
##      name              party             party_code         previous     
##  Length:1294        Length:1294        Min.   :  1.000   Min.   : 0.000  
##  Class :character   Class :character   1st Qu.:  2.000   1st Qu.: 0.000  
##  Mode  :character   Mode  :character   Median :  3.000   Median : 0.000  
##                                        Mean   :  8.936   Mean   : 1.519  
##                                        3rd Qu.: 11.000   3rd Qu.: 2.000  
##                                        Max.   :100.000   Max.   :15.000  
##                                                                          
##         wl        voteshare          age            nocand     
##  落選    :869   Min.   : 0.20   Min.   :25.00   Min.   :2.000  
##  当選    :300   1st Qu.: 8.50   1st Qu.:41.00   1st Qu.:4.000  
##  復活当選:125   Median :18.95   Median :50.00   Median :4.000  
##                 Mean   :23.18   Mean   :50.28   Mean   :4.556  
##                 3rd Qu.:34.62   3rd Qu.:59.00   3rd Qu.:5.000  
##                 Max.   :84.50   Max.   :94.00   Max.   :9.000  
##                                                                
##       rank            vote           eligible         turnout     
##  Min.   :1.000   Min.   :   608   Min.   :203712   Min.   :50.20  
##  1st Qu.:2.000   1st Qu.: 17538   1st Qu.:299363   1st Qu.:57.20  
##  Median :3.000   Median : 39278   Median :358266   Median :59.10  
##  Mean   :2.778   Mean   : 46079   Mean   :354494   Mean   :59.37  
##  3rd Qu.:4.000   3rd Qu.: 69254   3rd Qu.:413960   3rd Qu.:61.70  
##  Max.   :9.000   Max.   :192604   Max.   :495212   Max.   :69.80  
##                                                                   
##       exp                expm                 vs        
##  Min.   :     535   Min.   : 0.000535   Min.   :0.0020  
##  1st Qu.: 2268244   1st Qu.: 2.268244   1st Qu.:0.0850  
##  Median : 5381219   Median : 5.381219   Median :0.1895  
##  Mean   : 5761645   Mean   : 5.761645   Mean   :0.2318  
##  3rd Qu.: 8104032   3rd Qu.: 8.104032   3rd Qu.:0.3463  
##  Max.   :27462362   Max.   :27.462362   Max.   :0.8450  
##  NA's   :14         NA's   :14                          
##      exppv            smd       party_jpn        
##  Min.   : 0.00126   落選:994   Length:1294       
##  1st Qu.: 6.08015   当選:300   Class :character  
##  Median :14.86205              Mode  :character  
##  Mean   :17.16598                                
##  3rd Qu.:23.62160                                
##  Max.   :94.59168                                
##  NA's   :14

結果、year変数2012に限った、1294のサンプルサイズのデータフレームとなる。
さらに、政党数も多すぎるので、主要政党に限定してみよう。 ここは無難に、自民、民主、公明、共産、社民を抽出する。

HR2 <- dplyr::filter(HR2012, party %in% c("LDP", "DPJ", "CGP", "SDP", "JCP"))
glimpse(HR2)
## Observations: 884
## Variables: 22
## $ year       <int> 2012, 2012, 2012, 2012, 2012, 2012, 2012, 2012, 201...
## $ ku         <chr> "aichi", "aichi", "aichi", "aichi", "aichi", "aichi...
## $ kun        <int> 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, ...
## $ status     <fct> 新人, 現職, 新人, 現職, 新人, 新人, 新人, 現職, 新人, 新人, 新人, 新人, 新人,...
## $ name       <chr> "KUMADA, HIROMICHI", "YOSHIDA, TSUNEHIKO", "ONO, HI...
## $ party      <chr> "LDP", "DPJ", "JCP", "DPJ", "LDP", "JCP", "LDP", "D...
## $ party_code <int> 1, 3, 2, 3, 1, 2, 1, 3, 2, 1, 3, 2, 1, 3, 2, 1, 3, ...
## $ previous   <int> 1, 0, 0, 5, 1, 0, 1, 6, 0, 1, 0, 0, 1, 7, 0, 3, 0, ...
## $ wl         <fct> 当選, 落選, 落選, 当選, 復活当選, 落選, 当選, 復活当選, 落選, 当選, 落選, 落選,...
## $ voteshare  <dbl> 40.7, 19.3, 8.2, 44.8, 31.9, 8.1, 36.7, 34.9, 9.6, ...
## $ age        <int> 48, 38, 49, 47, 41, 64, 46, 54, 47, 48, 42, 58, 49,...
## $ nocand     <int> 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 4, 4, ...
## $ rank       <int> 1, 3, 4, 1, 2, 4, 1, 2, 4, 1, 4, 5, 1, 2, 5, 1, 2, ...
## $ vote       <int> 77215, 36578, 15512, 94058, 67086, 16991, 77700, 73...
## $ eligible   <int> 373297, 373297, 373297, 383295, 383295, 383295, 387...
## $ turnout    <dbl> 52.7, 52.7, 52.7, 56.8, 56.8, 56.8, 56.8, 56.8, 56....
## $ exp        <int> 15215857, 11853832, 1220570, 7592182, 7048547, 1028...
## $ expm       <dbl> 15.215857, 11.853832, 1.220570, 7.592182, 7.048547,...
## $ vs         <dbl> 0.407, 0.193, 0.082, 0.448, 0.319, 0.081, 0.367, 0....
## $ exppv      <dbl> 40.760727, 31.754426, 3.269702, 19.807673, 18.38935...
## $ smd        <fct> 当選, 落選, 落選, 当選, 落選, 落選, 当選, 落選, 落選, 当選, 落選, 落選, 当選,...
## $ party_jpn  <chr> "自民党", "民主党", "共産党", "民主党", "自民党", "共産党", "自民党", "民...
head(HR2, n = 10)
## # A tibble: 10 x 22
##     year ku      kun status name  party party_code previous wl    voteshare
##    <int> <chr> <int> <fct>  <chr> <chr>      <int>    <int> <fct>     <dbl>
##  1  2012 aichi     1 新人   KUMA… LDP            1        1 当選       40.7
##  2  2012 aichi     1 現職   YOSH… DPJ            3        0 落選       19.3
##  3  2012 aichi     1 新人   ONO,… JCP            2        0 落選        8.2
##  4  2012 aichi     2 現職   FURU… DPJ            3        5 当選       44.8
##  5  2012 aichi     2 新人   TOGO… LDP            1        1 復活当選…      31.9
##  6  2012 aichi     2 新人   KURO… JCP            2        0 落選        8.1
##  7  2012 aichi     3 新人   IKED… LDP            1        1 当選       36.7
##  8  2012 aichi     3 現職   KOND… DPJ            3        6 復活当選…      34.9
##  9  2012 aichi     3 新人   ISHI… JCP            2        0 落選        9.6
## 10  2012 aichi     4 新人   KUDO… LDP            1        1 当選       34  
## # ... with 12 more variables: age <int>, nocand <int>, rank <int>,
## #   vote <int>, eligible <int>, turnout <dbl>, exp <int>, expm <dbl>,
## #   vs <dbl>, exppv <dbl>, smd <fct>, party_jpn <chr>

結果として、サンプルサイズ884のデータフレームが出来上がる。

step3：記述統計の章用に図表を作成しよう

記述統計表はsummaruコマンドで良いが、論文としては理論的検討に応じた図表が欲しいところだ。
ここでは、仮説を補強するような集計表と散布図を作成する。

単純な集計表の用意

table1 <- with(HR2, table(status, party))
print(table1)
##       party
## status CGP DPJ JCP LDP SDP
##   新人   3  53 295 113  20
##   現職   2 209   2 108   3
##   元職   4   2   2  68   0
table2 <- with(HR2, table(status, smd))
print(table2)
##       smd
## status 落選 当選
##   新人  403   81
##   現職  193  131
##   元職   14   62
table3 <- with(HR2, table(party, status))
print(table3)
##      status
## party 新人 現職 元職
##   CGP    3    2    4
##   DPJ   53  209    2
##   JCP  295    2    2
##   LDP  113  108   68
##   SDP   20    3    0
table4 <- with(HR2, table(party, smd))
print(table4)
##      smd
## party 落選 当選
##   CGP    0    9
##   DPJ  237   27
##   JCP  299    0
##   LDP   52  237
##   SDP   22    1

散布図２：選挙費用*得票率, in 2012

hy_plot2 <- HR2 %>%  ggplot(mapping = aes( x =expm , y = voteshare))+
  geom_point() +
  geom_smooth(method = "lm", se = FALSE) +
  labs(x = "選挙費用 (100万円)", y = "得票率 (%)",
       title = "2012年衆院選における選挙費用と得票率との関係" ) #タイトル付けないと後で自分でわからない。
print(hy_plot2)
## Warning: Removed 10 rows containing non-finite values (stat_smooth).
## Warning: Removed 10 rows containing missing values (geom_point).

ここで、[警告メッセージ]が出るが、選挙費用に関して欠損値が10あるためだ。

図表から読み取れること：「選挙費用と得票率との間には右肩上がりの線形関係が予想できる」

理論的検討２：「でもこれって、立候補者の属性（現職―新人）や所属政党が関係するのでは？

Step4：グループごとの散布図を綺麗に作ろう

散布図３：選挙費用*得票率, 立候補者属性ごと

hy_plot3 <- HR2 %>% ggplot(mapping = aes( x = expm, y = voteshare,
              group = status, colour = status))+ #groupでグループ分けして、colourで色付け
              geom_point()+
  labs(x = "選挙費用 (100万円)", y = "得票率 (%)",
       title ="2012年衆院選における立候補者属性ごとの選挙費用と得票率の関係" )
print(hy_plot3)
## Warning: Removed 10 rows containing missing values (geom_point).

雑感：「どうやら、ステータスごとに相関関係は異なりそう」

報告：「立候補者の属性によって選挙費用と得票率の関係は変化していることが予想できる」

では、次に、政党ごとの散布図も作成する。

散布図４：選挙費用*得票率, 政党ごと

hy_plot4 <- HR2 %>% ggplot(mapping = aes( x = expm, y = voteshare,
                                   group = party, colour = party))+ #groupでグループ分けして、colourで色付け
  geom_point()+
  labs(x = "選挙費用 (100万円)", y = "得票率 (%)",
       title ="2012年衆院選における所属政党ごとの選挙費用と得票率の関係" )
print(hy_plot4)
## Warning: Removed 10 rows containing missing values (geom_point).

さらに、視認性を考慮して近似直線を加える。

散布図５:属性ごと+近似直線

hy_plot5 <- HR2 %>% ggplot(mapping = aes( x = expm, y = voteshare ))+
  geom_point() +
  geom_smooth(mapping = aes( group = status, colour = status), method = lm)+
  labs(x = "選挙費用 (100万円)", y = "得票率 (%)",
       title ="2012年衆院選における立候補者属性ごとの選挙費用と得票率の関係" )
print(hy_plot5)
## Warning: Removed 10 rows containing non-finite values (stat_smooth).
## Warning: Removed 10 rows containing missing values (geom_point).

雑感：「線の傾きに少しだけ差異があるようにも見える。いずれにせよ、今後の仮説検証の変数候補には残るだろう。」

散布図６：所属政党ごと+近似直線

hy_plot6 <- HR2 %>% ggplot(mapping = aes( x = expm, y = voteshare))+
  geom_point()+
  geom_smooth(mapping = aes(group = party, colour = party), method = "lm") +
  labs(x = "選挙費用 (100万円)", y = "得票率 (%)",
       title ="2012年衆院選における所属政党ごとの選挙費用と得票率の関係" )
print(hy_plot6)
## Warning: Removed 10 rows containing non-finite values (stat_smooth).
## Warning: Removed 10 rows containing missing values (geom_point).

雑感：「あまり報告向きではない。ただ、政党によっては選挙費用の係数の+-が反転していたりする。興味深い。」ぐらいの認識で今は留めていてOK

以上のような流れをデータ取得と同時に考えながらできると良い。

Tips

散布図の点の形状(shape)や、大きさ(size)、線の種類(linetype)は操作できる。
論文報告に耐え得るように、見栄えを加工しておこう。 ある変数ごとにエステティックを変更するには、geom_point()の中で指定する。 全水準でエステティックを変更するには、geom_point()の外で指定する。 点の形状に関しては、「?points」と入力してヘルプを参照しよう

散布図７：散布図５（属性ごと）の見栄え修正

hy_plot7 <- HR2012 %>% ggplot(mapping = aes( x = expm, y = voteshare ))+
  geom_point(mapping = aes(colour = status, shape = status)) +
  geom_smooth(mapping = aes( group = status, colour = status), method = lm)+
  labs(x = "選挙費用 (100万円)", y = "得票率 (%)",
       title ="2012年衆院選における立候補者属性ごとの選挙費用と得票率の関係" )
print(hy_plot7)
## Warning: Removed 14 rows containing non-finite values (stat_smooth).
## Warning: Removed 14 rows containing missing values (geom_point).

雑感：「多少、見えやすくなった。点の形状を変えておくとモノクロ印刷の論文でも耐え得るというのが大きい」

次に点の形状、色、大きさ、透過度(alpha)も変更する例を示す。

hy_plot100 <- HR2012 %>% ggplot(mapping = aes( x = expm, y = voteshare, colour = status ))+
  geom_point(shape = 17, size = 2, alpha = 0.8 ) +
  geom_smooth(mapping = aes( group = status, colour = status), method = "lm")+
  labs(x = "選挙費用 (100万円)", y = "得票率 (%)",
       title ="点の形状変更のテスト" )
print(hy_plot100)
## Warning: Removed 14 rows containing non-finite values (stat_smooth).
## Warning: Removed 14 rows containing missing values (geom_point).

グループごとの識別に特化したファセットを使いこなそう

facet_wrap や facet_gridによって、縦or横に図を並べることができる。 これを使用して属性ごとの散布図を並べよう

散布図８：属性ごと,並列

P1 <- HR2 %>% ggplot(mapping = aes( x = expm, y = voteshare)) +geom_point() 
P1 + facet_wrap(vars(status))
## Warning: Removed 10 rows containing missing values (geom_point).

ここでは、labsは省略した。
facet_wrap()は図を並列に並べることができる。
()の中で分ける単位となる変数を指定している。
すると、比較しやすい図ができる。以下で、様々並べてみる。

P1 + facet_grid(rows = vars(status))
## Warning: Removed 10 rows containing missing values (geom_point).

facet_grid では縦に並べることができる

P1 + facet_wrap(c("status", "party"), labeller = "label_both")
## Warning: Removed 10 rows containing missing values (geom_point).

観察数に偏りが見えるものの、論文掲載に耐え得る説得力のある図表が作成できた。

facetの練習

この散布図のファセットは、データセットによって様々に使える記述統計に欠かせない優良コマンドである。ヘルプに用意されている例題を再現してみよう。 まずはサンプルデータの読み込む

data(mpg)  #サンプルデータの読み込み
glimpse(mpg)  #サンプルデータの確認
## Observations: 234
## Variables: 11
## $ manufacturer <chr> "audi", "audi", "audi", "audi", "audi", "audi", "...
## $ model        <chr> "a4", "a4", "a4", "a4", "a4", "a4", "a4", "a4 qua...
## $ displ        <dbl> 1.8, 1.8, 2.0, 2.0, 2.8, 2.8, 3.1, 1.8, 1.8, 2.0,...
## $ year         <int> 1999, 1999, 2008, 2008, 1999, 1999, 2008, 1999, 1...
## $ cyl          <int> 4, 4, 4, 4, 6, 6, 6, 4, 4, 4, 4, 6, 6, 6, 6, 6, 6...
## $ trans        <chr> "auto(l5)", "manual(m5)", "manual(m6)", "auto(av)...
## $ drv          <chr> "f", "f", "f", "f", "f", "f", "f", "4", "4", "4",...
## $ cty          <int> 18, 21, 20, 21, 16, 18, 18, 18, 16, 20, 19, 15, 1...
## $ hwy          <int> 29, 29, 31, 30, 26, 26, 27, 26, 25, 28, 27, 25, 2...
## $ fl           <chr> "p", "p", "p", "p", "p", "p", "p", "p", "p", "p",...
## $ class        <chr> "compact", "compact", "compact", "compact", "comp...

以下、縦横縦横無尽に図表を作成して慣れてみる。

p <- ggplot(mpg, aes(displ, hwy)) + geom_point() #まずは図表フレームを作成

では、pという土台に様々に散布してみよう

p + facet_wrap(vars(class)) #「class」変数を指定して縦に並べる

p + facet_wrap(~class) #同上。省略

p + facet_wrap(vars(class), nrow = 4) #縦の図表を４枚に指定。

さらに、複数の変数によってもファセットできる。

ggplot(mpg, aes(displ, hwy)) +
  geom_point() +
  facet_wrap(vars(cyl, drv))

ただし、それぞれの図の識別（変数*変数）がわからなくなる。そこで、ラベルを自動で貼り付けよう。

ggplot(mpg, aes(displ, hwy)) +
  geom_point() +
  facet_wrap(c("cyl", "drv"), labeller = "label_both")

facet_grid でも同様に試行。

pp <- ggplot(mpg, aes(displ, cty))+geom_point()

pp + facet_grid(rows = vars(drv))

pp + facet_grid(cols = vars(cyl))

pp + facet_grid(vars(drv), vars(cyl))

pp + facet_grid(. ~ cyl)

pp + facet_grid(drv ~ .)

pp + facet_grid(drv ~ cyl)

ちなみに、今まで、衆院選のデータの図を作るときには、慣れるためにフルセンテンスのコマンドを書いていた。様々に試すには、上のように、同一内容をオブジェクトで格納して、それに様々なオプションを試すのが効率的である。

step5： 相関関係を分析しよう

with(HR2, cor.test(expm, voteshare))
## 
##  Pearson's product-moment correlation
## 
## data:  expm and voteshare
## t = 26.294, df = 872, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.6263056 0.7004257
## sample estimates:
##       cor 
## 0.6649999

ここで、ピアソンの相関係数を分析した。その結果は、872の観察数に分析し、p値は2.2e-16、つまり、2.2かける10の(-16)乗なので、とても小さい。
ということで、相関がないとする帰無仮説を棄却し、この相関関係は偶然ではない、ということ。
この結果は、まぁ、単回帰なのでどうでもよい。一喜一憂するものではない。
この辺りも、「分析」という名前は付くが、実質的には感触を確かめている感じである。
大事なのは、データの取得・整形が終わってからから目星を付けて、すぐさま実行するということ。