パッケージの読み込み

library(tidyverse)
if (capabilities("aqua")) { # Macかどうか判定し、Macの場合のみ実行
  theme_set(theme_gray(base_size = 10, base_family = "HiraginoSans-W3"))
}

Q10-1

Rds形式の衆院選データ (hr-data.Rds) を読み込む。 手元にない場合はまずダウンロードする。

# dir.create("data") # dataディレクトリがない場合は作る
#download.file(url = "https://git.io/fp00p",
#              destfile = "data/hr-data.Rds")
HR <- read_rds("data/hr-data.Rds")
## Rdsファイルの読み込みがうまくいかない場合は以下を実行してCSVファイルを使う
#download.file(url = "https://git.io/fxhQU",
#              destfile = "data/hr-data.csv")
#HR <- read_csv("data/hr-data.csv")

正しく読み込めたかどうか確認する。

glimpse(HR)
## Rows: 8,803
## Columns: 22
## $ year       <dbl> 1996, 1996, 1996, 1996, 1996, 1996, 1996, 1996, 1996, 1996,…
## $ ku         <chr> "aichi", "aichi", "aichi", "aichi", "aichi", "aichi", "aich…
## $ kun        <dbl> 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3,…
## $ status     <fct> 現職, 元職, 現職, 新人, 新人, 新人, 新人, 現職, 元職, 新人, 新人, 新人, 新人, 新人, 新人,…
## $ name       <chr> "KAWAMURA, TAKASHI", "IMAEDA, NORIO", "SATO, TAISUKE", "IWA…
## $ party      <chr> "NFP", "LDP", "DPJ", "JCP", "others", "kokuminto", "indepen…
## $ party_code <dbl> 8, 1, 3, 2, 100, 22, 99, 8, 1, 3, 2, 10, 100, 99, 22, 8, 1,…
## $ previous   <dbl> 2, 3, 2, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 3, 1, 0, 0,…
## $ wl         <fct> 当選, 落選, 落選, 落選, 落選, 落選, 落選, 当選, 落選, 復活当選, 落選, 落選, 落選, 落選, 落…
## $ voteshare  <dbl> 40.0, 25.7, 20.1, 13.3, 0.4, 0.3, 0.2, 32.9, 26.4, 25.7, 12…
## $ age        <dbl> 47, 72, 53, 43, 51, 51, 45, 51, 71, 30, 31, 44, 61, 47, 43,…
## $ nocand     <dbl> 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 7, 7, 7, 7, 7,…
## $ rank       <dbl> 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5,…
## $ vote       <dbl> 66876, 42969, 33503, 22209, 616, 566, 312, 56101, 44938, 43…
## $ eligible   <dbl> 346774, 346774, 346774, 346774, 346774, 346774, 346774, 338…
## $ turnout    <dbl> 49.2, 49.2, 49.2, 49.2, 49.2, 49.2, 49.2, 51.8, 51.8, 51.8,…
## $ exp        <dbl> 9828097, 9311555, 9231284, 2177203, NA, NA, NA, 12940178, 1…
## $ expm       <dbl> 9.828097, 9.311555, 9.231284, 2.177203, NA, NA, NA, 12.9401…
## $ vs         <dbl> 0.400, 0.257, 0.201, 0.133, 0.004, 0.003, 0.002, 0.329, 0.2…
## $ exppv      <dbl> 28.341505, 26.851941, 26.620462, 6.278449, NA, NA, NA, 38.2…
## $ smd        <fct> 当選, 落選, 落選, 落選, 落選, 落選, 落選, 当選, 落選, 落選, 落選, 落選, 落選, 落選, 落選,…
## $ party_jpn  <chr> "新進党", "自民党", "民主党", "共産党", "その他", "国民党", "無所属", "新進党", "自民…

1996年の衆院選の自民党候補だけを抜き出してデータフレームを作る。

LDP1996 <- filter(HR, year == 1996, party_jpn == "自民党")

Q10-1-1

得票率 voteshare と 選挙費用 (expm) の散布図を描き、回帰直線を上書きする。

p_q10 <- ggplot(LDP1996, aes(x = expm, y = voteshare)) +
  geom_point() +
  geom_smooth(method = "lm", se = FALSE) +
  labs(x = "選挙費用（100万円）", y = "得票率 (%)")
print(p_q10)

直線がやや右上がりになっており、選挙費用が大きいほど得票率が高いという弱い関係がありそうに見える。

Q10-1-2

得票率 voteshare を年齢 age と選挙費用 expm （単位は100万円） に回帰する。

fit_q10 <- lm(voteshare ~ age + expm, data = LDP1996)
summary(fit_q10)
## 
## Call:
## lm(formula = voteshare ~ age + expm, data = LDP1996)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -28.098  -9.968  -1.943   8.736  47.932 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)
## (Intercept) 26.10491    4.79072   5.449 1.11e-07
## age          0.18784    0.07585   2.477   0.0139
## expm         0.31823    0.19230   1.655   0.0991
## 
## Residual standard error: 14.05 on 280 degrees of freedom
##   (5 observations deleted due to missingness)
## Multiple R-squared:  0.03405,    Adjusted R-squared:  0.02715 
## F-statistic: 4.935 on 2 and 280 DF,  p-value: 0.00783

この結果から、応答変数である得票率と説明変数である年齢と選挙費用の関係は、以下の式で表せる。

\[\widehat{得票率} = 26.1 + 0.19 \cdot 年齢 + 0.32 \cdot 選挙費用.\]

Q10-1-3

まず、切片は約26.1である。これは、すべての説明変数の値が0のときの応答変数の予測値である。すなわち、選挙費用が0円で0歳の候補者の予測得票率は、26.1%である。（もちろん、そんな候補者は存在しない。）

次に、年齢の係数は、約0.19 である。これは、他の条件が等しいとき、年齢が1単位増えるごとに、応答変数の予測値は平均すると0.19単位ずつ上昇することを示している。応答変数である得票率の測定単位はパーセント、年齢の測定単位は1歳である。よって、選挙費用が一定なら、年齢が1歳上昇するごとに、得票率の予測値は平均すると0.19パーセントポイントずつ上昇する。

最後に、選挙費用の係数は約0.32である。これは、他の条件が等しいとき、選挙費用が1単位増えるごとに、応答変数の予測値は平均すると0.32単位ずつ上昇することを示している。選挙費用の測定単位は100万円である。よって、年齢が一定なら、選挙費用が100万円増えるごとに、得票率の予測値は平均すると0.32パーセントポイントずつ上昇する。