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> "新進党", "自民党", "民主党", "共産党", "その他", "国民党", "無所属", "新...
1996年の衆院選だけを抜き出してデータフレームを作る。
得票率 voteshare と 選挙費用 (expm) の散布図を描き、回帰直線を上書きする。
p_q10 <- ggplot(HR1996, aes(x = expm, y = voteshare)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "選挙費用(100万円)", y = "得票率 (%)")
print(p_q10)
直線が右上がりになっており、選挙費用が大きいほど得票率が高いという関係がありそうに見える。
得票率 voteshare を年齢 age と選挙費用 expm (単位は100万円) に回帰する。
##
## Call:
## lm(formula = voteshare ~ age + expm, data = HR1996)
##
## Residuals:
## Min 1Q Median 3Q Max
## -35.560 -8.139 -1.628 6.292 61.596
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.80750 1.71810 0.470 0.638
## age 0.13894 0.03320 4.185 3.07e-05
## expm 1.83391 0.06131 29.912 < 2e-16
##
## Residual standard error: 12.54 on 1195 degrees of freedom
## (63 observations deleted due to missingness)
## Multiple R-squared: 0.451, Adjusted R-squared: 0.4501
## F-statistic: 490.9 on 2 and 1195 DF, p-value: < 2.2e-16
この結果から、応答変数である得票率と説明変数である年齢と選挙費用の関係は、以下の式で表せる。
\[\widehat{得票率} = 0.81 + 0.14 \cdot 年齢 + 1.83 \cdot 選挙費用.\]
まず、切片は約0.81である。これは、すべての説明変数の値が0のときの応答変数の予測値である。すなわち、選挙費用が0円で0歳の候補者の予測得票率は、0.81%である。(もちろん、そんな候補者は存在しない。)
次に、年齢の係数は、約0.14 である。これは、他の条件が等しいとき、年齢が1単位増えるごとに、応答変数の予測値は平均すると0.14単位ずつ上昇することを示している。応答変数である得票率の測定単位はパーセント、年齢の測定単位は1歳である。よって、選挙費用が一定なら、年齢が1歳上昇するごとに、得票率の予測値は平均すると0.14パーセントポイントずつ上昇する。
最後に、選挙費用の係数は約1.83である。これは、他の条件が等しいとき、選挙費用が1単位増えるごとに、応答変数の予測値は平均すると1.83単位ずつ上昇することを示している。選挙費用の測定単位は100万円である。よって、年齢が一定なら、選挙費用が100万円増えるごとに、得票率の予測値は平均すると1.83パーセントポイントずつ上昇する。