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")
正しく読み込めたかどうか確認する。
## 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> "新進党", "自民党", "民主党", "共産党", "その他", "国民党", "無所属", "新...
2012年衆院選の民主党候補だけを抜き出してデータフレームを作る。
得票率 voteshare、当選回数 previous 、年齢 age の関係を、次の線形モデルで表す(\(\epsilon_i\)は誤差項)。 \[ 得票率_i = \beta_0 + \beta_1 当選回数_i + \beta_2 年齢_i + \epsilon_i. \]
母数について、以下の2組の仮説を立てる。
回帰分析で、このモデルの母数である \(\beta_0\)、\(\beta_1\)、\(\beta_2\) を推定する。
##
## Call:
## lm(formula = voteshare ~ previous + age, data = DPJ2012)
##
## Residuals:
## Min 1Q Median 3Q Max
## -21.9214 -5.7090 -0.8234 5.5614 24.3452
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 29.44365 2.52823 11.646 < 2e-16
## previous 3.29999 0.26279 12.558 < 2e-16
## age -0.23518 0.05485 -4.287 2.55e-05
##
## Residual standard error: 8.282 on 261 degrees of freedom
## Multiple R-squared: 0.3857, Adjusted R-squared: 0.381
## F-statistic: 81.93 on 2 and 261 DF, p-value: < 2.2e-16
包括的な仮説から検定しよう。上で示された結果のうち、最後の行にある\(F\)統計量の\(p値\) を見ると、2.2e-16$ = 2.2 10^{-16} 0\(未満であり、\)p$値が\(0.05\)より小さいので、有意水準5%で帰無仮説を棄却する。すなわち、\(\beta_1\)と\(\beta_2\)のうち、少なくとも一方は0ではない。言い換えると、(上で想定したモデルが正しいなら)当選回数と年齢のうち少なくとも一方は得票率に影響を与える。
次に、係数を個別に検定しよう。まず、過去の当選回数 (previous) の係数の\(p\)値は、2e-16 \(= 2\cdot10^{-16} \approx 0\)未満であり、\(p\)値が\(0.05\)より小さいので、有意水準5%で帰無仮説を棄却する。すなわち、過去の当選回数は、得票率に影響を与える。\(\beta_1\)の推定値は約\(3.3\)だから、年齢を一定に保つと、過去の当選回数が1回増えるごとに、得票率は平均すると\(3.3\)パーセントポイントずつ上昇すると考えられる。過去の当選回数が3回異なると、\(9.9\)パーセントポイント得票率に差が出るということなので、この効果は実質的にも意味がある(つまり、選挙結果を左右し得る)効果であると考えられる。
同様に、年齢 (age) の係数の\(p\)値は、2.55e-05 \(= 2.55 \cdot 10^{-5} \approx 0 < 0.05\)だから、有意水準5%で帰無仮説を棄却する。すなわち、年齢は得票率に影響を与える。\(\beta_2\)の推定値は約\(-0.24\)だから、過去の当選回数を一定に保つと、年齢が1歳上がるごとに得票率が\(-0.24\)パーセントポイントずつ上がる、つまり、\(0.24\)パーセントポイントずつ下がることが予測される。 一回り年齢が違うと、\(2.82\)パーセントポイントだけ得票率に差が出るということなので、無視できるほど小さい差ではないが、実質的に大きな効果があると言い切ることは難しい。30歳の候補と60歳の候補を比べると、\(7.06\)パーセントポイントの差になるので、年齢差が大きければ実質的に意味がある違いが出ることがわかる(2012年の民主党候補のうち、最年少候補は25歳、最年長候補は74歳である)。
最後に、分析結果を図にまとめる。
coefs_q11 <- coefplot(
model = fit_q11, # 図示するモデルを指定
intercept = FALSE, # 切片を表示しない
pointSize = 4, # 点の大きさを4に
## 内側の線を50%信頼区間にする。既定値は1(「点推定値±1標準誤差」)
innerCI = qt(df = summary(fit_q11)$df[2],
p = 0.25, lower.tail = FALSE),
lwdInner = 2.5, # 内側の線の太さを2.5に
## 外側の線を95%信頼区間にする。既定値は2(「点推定値±2標準誤差」)
outerCI = qt(df = summary(fit_q11)$df[2],
p = 0.025, lower.tail = FALSE),
lwdOuter = 0.5, # 外側の線の太さを0.5に
## 説明変数を日本語で表示する
newNames = list(previous = "過去の当選回数", age = "年齢"),
xlab = "係数の推定値",
ylab = "説明変数",
title = "2012年衆院選における民主党候補の得票率 (%)を予測するモデル"
)
print(coefs_q11)
この図が推定結果をまとめている。縦軸にはモデルに含まれる説明変数が並んでいる。横軸は、係数の推定値の大きさを表している。図中の点は、各説明変数の係数の点推定値である。また、水平に引かれた線は、内側の太い線が50パーセント信頼区間、外側の細い線が95パーセント信頼区間である。いずれの変数についても、95パーセント信頼区間がゼロを跨いでいないので、5%の有意水準で、推定された効果は統計的に有意であることがわかる。この分析の標本サイズは264、自由度調整済み決定係数は0.38である。
得票率 voteshare を応答変数、選挙費用 expm(100万円)を説明変数と想定して散布図を描き、回帰直線とその95%信頼区間を示す。