library(interplot)
library(jtools)
library(margins)
library(msm)
library(patchwork)
library(stargazer)
library(tidyverse)
変数の種類 | 変数名 | 詳細 |
---|---|---|
応答変数 | voteshare |
候補者の得票率 (%) |
説明変数 | exppv |
候補者が有権者一人当たりに使う使う選挙費用(円) |
ダミー変数 | ldp |
自民党候補者か否か(ldp : 0 = 非自民党、1 =
自民党) |
ダミー変数を説明変数に加えると、ダミー変数の値によって回帰直線が平行移動するような変化(つまり、自民党候補者であるか否かという要因は候補者の得票率に影響したのかということ)を捉えることができる(下の図の左側)
変数の種類 | 変数名 | 詳細 |
---|---|---|
応答変数 | voteshare |
候補者の得票率 (%) |
説明変数 | exppv |
候補者が有権者一人当たりに使う使う選挙費用(円) |
調整変数(ダミー変数) | ldp |
自民党候補者か否か(0 = 非自民党、1 = 自民党) |
交差項 | exppv:ldp |
選挙費用と自民党ダミーを掛け合わせた変数 |
交差項を説明変数に加えると、自民党候補者とそうでない候補者の間において、選挙費用が得票率に与える影響を捉えることができる(上の図の右側)
hr96-21.csv
)RProject
フォルダ内に data
という名称のフォルダを作成するcsv
ファイルがパソコンにダウンロードされ、data
内に自動的に保存される注意:一度ダウンロードを完了すれば、このコマンドを実行する必要はありません
hr96-21.csv をクリックしてデータをパソコンにダウンロード
RProject
フォルダ内に data
という名称のフォルダを作成する
ダウンロードした hr96-21.csv
を手動でRProject
フォルダ内にある data
フォルダに入れる
hr96-21.csv
を読み取るna = "."
というコマンドは「欠損値をドットで置き換える」という意味numeric
)」型のデータが「」文字型
(character
)」として認識されるなど、エラーの原因になるため、読み取る時点で事前に対処するlocale()
関数を使って日本語エンコーディング
(cp932
) を指定するhr96_17.csv
は1996年に衆院選挙に小選挙区が導入されて以来実施された 9
回の衆議院選挙(1996, 2000, 2003, 2005, 2009, 2012, 2014, 2017,
2021)の結果のデータhr
に含まれる変数名を表示させる [1] "year" "pref" "ku" "kun"
[5] "wl" "rank" "nocand" "seito"
[9] "j_name" "gender" "name" "previous"
[13] "age" "exp" "status" "vote"
[17] "voteshare" "eligible" "turnout" "seshu_dummy"
[21] "jiban_seshu" "nojiban_seshu"
df1
には 22 個の変数が入っている変数名 | 詳細 |
---|---|
year | 選挙年 (1996-2021) |
pref | 都道府県名 |
ku | 小選挙区名 |
kun | 小選挙区 |
rank | 当選順位 |
wl | 選挙の当落: 1 = 小選挙区当選、2 = 復活当選、0 = 落選 |
nocand | 立候補者数 |
seito | 候補者の所属政党 |
j_name | 候補者の氏名(日本語) |
name | 候補者の氏名(ローマ字) |
previous | これまでの当選回数(当該総選挙結果は含まない) |
gender | 立候補者の性別: “male”, “female” |
age | 立候補者の年齢 |
exp | 立候補者が使った選挙費用(総務省届け出) |
status | 候補者のステータス: 0 = 非現職、1 現職、2 = 元職 |
vote | 得票数 |
voteshare | 得票率 (%) |
eligible | 小選挙区の有権者数 |
turnout | 小選挙区の投票率 (%) |
seshu_dummy | 世襲候補者ダミー: 1 = 世襲、0 = 非世襲(地盤世襲 or 非世襲) |
jiban_seshu | 地盤の受け継ぎ元の政治家の氏名と関係 |
nojiban_seshu | 世襲元の政治家の氏名と関係 |
spc_tbl_ [9,660 × 22] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
$ year : num [1:9660] 1996 1996 1996 1996 1996 ...
$ pref : chr [1:9660] "愛知" "愛知" "愛知" "愛知" ...
$ ku : chr [1:9660] "aichi" "aichi" "aichi" "aichi" ...
$ kun : num [1:9660] 1 1 1 1 1 1 1 2 2 2 ...
$ wl : num [1:9660] 1 0 0 0 0 0 0 1 0 2 ...
$ rank : num [1:9660] 1 2 3 4 5 6 7 1 2 3 ...
$ nocand : num [1:9660] 7 7 7 7 7 7 7 8 8 8 ...
$ seito : chr [1:9660] "新進" "自民" "民主" "共産" ...
$ j_name : chr [1:9660] "河村たかし" "今枝敬雄" "佐藤泰介" "岩中美保子" ...
$ gender : chr [1:9660] "male" "male" "male" "female" ...
$ name : chr [1:9660] "KAWAMURA, TAKASHI" "IMAEDA, NORIO" "SATO, TAISUKE" "IWANAKA, MIHOKO" ...
$ previous : num [1:9660] 2 2 2 0 0 0 0 2 0 0 ...
$ age : num [1:9660] 47 72 53 43 51 51 45 51 71 30 ...
$ exp : num [1:9660] 9828097 9311555 9231284 2177203 NA ...
$ status : num [1:9660] 1 2 1 0 0 0 0 1 2 0 ...
$ vote : num [1:9660] 66876 42969 33503 22209 616 ...
$ voteshare : num [1:9660] 40 25.7 20.1 13.3 0.4 0.3 0.2 32.9 26.4 25.7 ...
$ eligible : num [1:9660] 346774 346774 346774 346774 346774 ...
$ turnout : num [1:9660] 49.2 49.2 49.2 49.2 49.2 49.2 49.2 51.8 51.8 51.8 ...
$ seshu_dummy : num [1:9660] 0 0 0 0 0 0 0 0 1 0 ...
$ jiban_seshu : chr [1:9660] NA NA NA NA ...
$ nojiban_seshu: chr [1:9660] NA NA NA NA ...
- attr(*, "spec")=
.. cols(
.. year = col_double(),
.. pref = col_character(),
.. ku = col_character(),
.. kun = col_double(),
.. wl = col_double(),
.. rank = col_double(),
.. nocand = col_double(),
.. seito = col_character(),
.. j_name = col_character(),
.. gender = col_character(),
.. name = col_character(),
.. previous = col_double(),
.. age = col_double(),
.. exp = col_double(),
.. status = col_double(),
.. vote = col_double(),
.. voteshare = col_double(),
.. eligible = col_double(),
.. turnout = col_double(),
.. seshu_dummy = col_double(),
.. jiban_seshu = col_character(),
.. nojiban_seshu = col_character()
.. )
- attr(*, "problems")=<externalptr>
数値は numeric
文字は character
として認識されていることがわかる
データフレーム hr
の変数名を確認/
[1] "year" "pref" "ku" "kun"
[5] "wl" "rank" "nocand" "seito"
[9] "j_name" "gender" "name" "previous"
[13] "age" "exp" "status" "vote"
[17] "voteshare" "eligible" "turnout" "seshu_dummy"
[21] "jiban_seshu" "nojiban_seshu"
seito
に含まれる値を確かめる [1] "新進" "自民" "民主"
[4] "共産" "文化フォーラム" "国民党"
[7] "無所" "自由連合" "政事公団太平会"
[10] "新社会" "社民" "新党さきがけ"
[13] "沖縄社会大衆党" "市民新党にいがた" "緑の党"
[16] "さわやか神戸・市民の会" "民主改革連合" "青年自由"
[19] "日本新進" "公明" "諸派"
[22] "保守" "無所属の会" "自由"
[25] "改革クラブ" "保守新" "ニューディールの会"
[28] "新党尊命" "世界経済共同体党" "新党日本"
[31] "国民新党" "新党大地" "幸福"
[34] "みんな" "改革" "日本未来"
[37] "日本維新の会" "当たり前" "政治団体代表"
[40] "安楽死党" "アイヌ民族党" "次世"
[43] "維新" "生活" "立憲"
[46] "希望" "緒派" ""
[49] "N党" "国民" "れい"
seito = "自民
,
それ以外の政党を 0 にしたダミー変数を作り df1
と名前を付けるexppv
という名称で新たに変数を作り df1
に上書きするdf1 <- df1 %>%
dplyr::filter(year == 2005) %>% # 2005年のデータだけを選ぶ
dplyr::select(year, ku, kun, j_name, age, rank, previous, voteshare, eligible, exppv, nocand, ldp) # 11の変数だけを選ぶ
[1] "year" "ku" "kun" "j_name" "age" "rank"
[7] "previous" "voteshare" "eligible" "exppv" "nocand" "ldp"
ldp
が作られていることを確認# A tibble: 6 × 12
year ku kun j_name age rank previous voteshare eligible exppv nocand
<dbl> <chr> <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 2005 aichi 1 河村た… 56 1 4 50 360007 17.0 4
2 2005 aichi 1 篠田陽… 32 2 0 39.1 360007 40.0 4
3 2005 aichi 1 木村恵… 55 3 0 7.4 360007 6.05 4
4 2005 aichi 1 小林正… 56 4 0 3.6 360007 13.1 4
5 2005 aichi 2 古川元… 39 1 3 52 366121 30.2 3
6 2005 aichi 2 岡田裕… 27 2 0 39.1 366121 14.4 3
# ℹ 1 more variable: ldp <dbl>
stargazer()
関数を使うと結果を見やすく表示できるR-Markdown
で表示する際、type = "html"
を指定するときにはチャンクオプションで
```{r, results = "asis"}
と指定するStatistic | N | Mean | St. Dev. | Min | Max |
year | 989 | 2,005.000 | 0.000 | 2,005 | 2,005 |
kun | 989 | 5.563 | 4.916 | 1 | 25 |
age | 989 | 50.292 | 10.871 | 25 | 81 |
rank | 989 | 2.217 | 1.041 | 1 | 6 |
previous | 989 | 1.550 | 2.412 | 0 | 15 |
voteshare | 989 | 30.333 | 19.230 | 0.600 | 73.600 |
eligible | 989 | 344,654.300 | 63,898.230 | 214,235 | 465,181 |
exppv | 985 | 24.627 | 17.907 | 0.148 | 89.332 |
nocand | 989 | 3.435 | 0.740 | 2 | 6 |
ldp | 989 | 0.293 | 0.455 | 0 | 1 |
df1 <- df1 %>%
dplyr::filter(year == 2005) %>% # 2005年のデータだけを選ぶ
dplyr::select(ku, kun, j_name, age, rank, previous, voteshare, eligible, exppv, nocand, ldp) # 11の変数だけを選ぶ
[1] "ku" "kun" "j_name" "age" "rank" "previous"
[7] "voteshare" "eligible" "exppv" "nocand" "ldp"
# A tibble: 6 × 11
ku kun j_name age rank previous voteshare eligible exppv nocand ldp
<chr> <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 aichi 1 河村た… 56 1 4 50 360007 17.0 4 0
2 aichi 1 篠田陽… 32 2 0 39.1 360007 40.0 4 1
3 aichi 1 木村恵… 55 3 0 7.4 360007 6.05 4 0
4 aichi 1 小林正… 56 4 0 3.6 360007 13.1 4 0
5 aichi 2 古川元… 39 1 3 52 366121 30.2 3 0
6 aichi 2 岡田裕… 27 2 0 39.1 366121 14.4 3 1
Statistic | N | Mean | St. Dev. | Min | Max |
kun | 989 | 5.563 | 4.916 | 1 | 25 |
age | 989 | 50.292 | 10.871 | 25 | 81 |
rank | 989 | 2.217 | 1.041 | 1 | 6 |
previous | 989 | 1.550 | 2.412 | 0 | 15 |
voteshare | 989 | 30.333 | 19.230 | 0.600 | 73.600 |
eligible | 989 | 344,654.300 | 63,898.230 | 214,235 | 465,181 |
exppv | 985 | 24.627 | 17.907 | 0.148 | 89.332 |
nocand | 989 | 3.435 | 0.740 | 2 | 6 |
ldp | 989 | 0.293 | 0.455 | 0 | 1 |
model_1
)ldp:exppv
) ldp
のようなカテゴリカル変数とexppv
のような連続変数を掛け合わせて作るldp:exppv
という名称の交差項を作り、モデルに入れて回帰分析を行う「回帰分析
2(ダミー変数)」におけるmodel_3
の前提:
→ 2 つの回帰直線が平行(= 選挙費用が得票率に与える影響力は同一)
ここではこの制限を緩め、次の前提を置く
モデルの前提:
「自民党のある候補者とそうでない候補者の間で、選挙費用が得票率に与える影響は異なる」
このモデルではldp:exppv
という説明変数(= 交差項:
interaction term
)を追加する
ここでは次の重回帰式を推定する
\[\mathrm{{voteshare}\ = \alpha_0 + \alpha_1
exppv + \alpha_2 ldp + \alpha_3 ldp:exppv +
\varepsilon}\]
上記の式は次の様に書き換えることが出来る
\[\mathrm{{voteshare}\ = \alpha_0 + (\alpha_1 + \alpha_3 ldp) exppv + \alpha_2 ldp + \varepsilon}\]
\(\alpha_0\) | : 選挙費用が 0 (exppv = 0 )の非自民党候補者
(ldp = 0 ) の得票率 |
\((\alpha_1 + \alpha_3 \textrm{ldp})\) | : 得票率 (voteshare ) に対する選挙費用
(exppv ) の影響力 |
選挙費用が得票率に与える影響は、自民党候補者とそうでない候補者の間で異なるのか?
Marginal Effects
) を考慮する必要がある限界効果:説明変数が(特定の値において)応答変数に与える影響力の強さ
voteshare
(得票率:%)exppv
(有権者一人あたりに費やした選挙費用:円)ldp:exppv
(ldp
= 調整変数)(モデル内でexppv*ldp
と入力するとexppv:ldp
という交差項名が自動的に付されexppv
,
ldp
という2 つの変数も含まれる)
Call:
lm(formula = voteshare ~ exppv * ldp, data = df1)
Residuals:
Min 1Q Median 3Q Max
-35.124 -6.450 -1.968 6.936 46.340
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 7.51824 0.63727 11.80 <2e-16 ***
exppv 0.79142 0.02619 30.21 <2e-16 ***
ldp 40.16341 1.77282 22.66 <2e-16 ***
exppv:ldp -0.74623 0.04759 -15.68 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 10.63 on 981 degrees of freedom
(4 observations deleted due to missingness)
Multiple R-squared: 0.6945, Adjusted R-squared: 0.6936
F-statistic: 743.5 on 3 and 981 DF, p-value: < 2.2e-16
stargazer()
を使って、見やすく表示できるR-Markdown
で表示する際、type = "html"
を指定するときにはチャンクオプションで
```{r, results = "asis"}
と指定するDependent variable: | |
voteshare | |
exppv | 0.791*** |
(0.026) | |
ldp | 40.163*** |
(1.773) | |
exppv:ldp | -0.746*** |
(0.048) | |
Constant | 7.518*** |
(0.637) | |
Observations | 985 |
R2 | 0.695 |
Adjusted R2 | 0.694 |
Residual Std. Error | 10.631 (df = 981) |
F Statistic | 743.450*** (df = 3; 981) |
Note: | p<0.1; p<0.05; p<0.01 |
model_1
)model_0
)
と「含むモデル」(model_1
) の違いは重要model_0
) は次のとおりmodel_0
と model_1
の分析結果を並べて表示してみるDependent variable: | ||
voteshare | ||
(1) | (2) | |
exppv | 0.565*** | 0.791*** |
(0.024) | (0.026) | |
ldp | 15.852*** | 40.163*** |
(0.961) | (1.773) | |
exppv:ldp | -0.746*** | |
(0.048) | ||
Constant | 11.779*** | 7.518*** |
(0.644) | (0.637) | |
Observations | 985 | 985 |
R2 | 0.618 | 0.695 |
Adjusted R2 | 0.617 | 0.694 |
Residual Std. Error | 11.883 (df = 982) | 10.631 (df = 981) |
F Statistic | 794.203*** (df = 2; 982) | 743.450*** (df = 3; 981) |
Note: | p<0.1; p<0.05; p<0.01 |
model_0
の結果model_1
の結果model_0
の結果の解釈は 15. 回帰分析
2(ダミー変数)を参照model_1
の結果について解説するmodel_1
(右側の結果)は「非自民党候補者
(ldp = 0
) の結果」選挙費用 (exppv
)
の係数 0.791 と \(p値 = 2e-16\)
の意味
→ 「これは調整変数の値が 0 の時(つまり
ldp = 0
)の結果
→ 「非自民党候補者が選挙費用を 1 円費やした時に
0.791% ポイント得票率が高まり、それは統計的に有意」
→ 「自民党の候補者」が選挙費用を費やした時の結果はわからない
→ 「自民党の候補者」が選挙費用を費やした時の結果も調べる必要がある
交差項 (ldp:exppv
)
の係数 -0.74623 と \(p値 = 2e-16\)
の意味
→ 「選挙費用が得票率に与える影響の差は -0.74623
%ポイントで、統計的に有意」
候補者は自民党候補者 (ldp = 1
) もいる
→ 調整変数である自民党ダミー (ldp)
が 0 と 1
それぞれの値をとる場合に「選挙費用が得票率に与える影響力」を確認する必要あり
jtools
パッケージを使うと、以上の結果を視覚的に確認できる
しかし、交差項を含む重回帰分析結果だけを示すのはあまり有益とはいえない
その理由 → 調整変数(この場合、ldp = 0)
の結果しか示していないから
→ 調整変数の両方の値(ldp = 0
とldp = 1
)における限界効果を示す必要あり
データ解析において重要なこと:
統計的有意性 (statistical significance) →
限界効果を計算して図示する
実質的有意性 (substantial significance) → 限界効果を計算して図示する
★ 交差項を含まない重回帰分析の場合:
X
の係数 b
は、他の説明変数の値を一定に保ったとき、X
が 1 単位増加すると、応答変数 Y
の予測値が b
単位 だけ増えること示す★交差項を含む重回帰分析の場合:
解説:
model_1
に含まれる説明変数は次の 3
つ:X
)Z
)XZ
)X
) 1 単位(= 1
円)の増加が、得票率に与える影響Z
と XZ
の値)を一定に保ったまま、X
の値だけを変えることは不可能X
の値を変えると、XZ
の値も変わってしまうからZ = 0
(つまり候補者が非自民党候補者)のときだけmodel_1
)の結果として得られた選挙費用の係数
0.79142ldp = 0
)
の選挙費用が得票率に与える影響dp = 1)
の選挙費用が得票率に与える影響ではないldp
には平均値 (0.5)
という候補者は存在しないldp = 0.5
という実在しない候補者のデータを求めても意味がないldp
を中心化する意味はないので、中心化する必要はないまとめ ・交差項を含む重回帰分析の場合「他の変数の値を一定に保つ」ことができないため、調整変数の値(カテゴリカル変数の場合は 0, 1)の限界効果をそれぞれチェックする必要がある
非自民党候補者 (ldp = 0
) と自民党候補者
(ldp = 1
) を設定して影響力を可視化する
それぞれにおいて応答変数である得票率(voteshare
)に、説明変数であ
る有権者一人当たり選挙費用(exppv
)が与える影響の大きさを可視化する
model_1
の結果から次の回帰関数の回帰式が得られる
\[\widehat{voteshare}\ = 7.52 + 0.79exppv + 40.2ldp -0.75exppv:ldp\]
\[= 7.52 + (0.79 - 0.75ldp)exppv + 40.21ldp\]
voteshare
に対する exppv
の影響力の総合値
\((α_1 + α_3ldp)\)は、\[0.79 - 0.75ldp\]
exppv
の係数 0.79 - 0.75ldp =
候補者が有権者一人当たり選挙費用(exppv
)を 1
円費やすことで増える得票率(voteshare
)
→
選挙費用が得票率に与える影響は、候補者が自民党候補者によって異なることがわかる
この回帰式に、非自民党候補者(ldp = 0
)を代入すると、赤色の回帰式が得られる
\[\textrm{voteshare}= 7.52 + 0.791 \cdot \textrm{exppv} + \varepsilon\]
model_1
の回帰式に、自民党候補者(ldp = 1
)を代入すると、青色の回帰式が得られる\[\textrm{voteshare}= 47.7 + 0.045 \cdot \textrm{exppv} + \varepsilon\]
ggplot
で日本語を表示させるため、マックユーザーは以下の行を入力df1 %>%
ggplot(aes(x = exppv, y = voteshare, color = as.factor(ldp))) +
geom_point(pch = 16) +
geom_abline(intercept = 7.52, slope = 0.791, color = "tomato") +
geom_abline(intercept = 47.7, slope = 0.045, color = "blue") +
ylim(0, 80) +
labs(x = "選挙費用:円 (exppv)",
y = "得票率 (voteshare)",
title = "有権者一人あたりに費やす選挙費用と得票率:2005年総選挙") +
annotate("label",
label = "得票率 = 7.52 + 0.791選挙費用\n(非自民党候補者)",
x = 65, y = 79,
size = 3,
colour = "tomato",
family = "HiraginoSans-W3") +
annotate("label",
label = "得票率 = 47.7 + 0.045選挙費用\n(自民党候補者)",
x = 20, y = 79,
size = 3,
colour = "blue",
family = "HiraginoSans-W3") +
scale_color_discrete(name = "候補者の所属政党", labels = c("非自民党","自民党")) +
theme_bw(base_family = "HiraKakuProN-W3")
msm
パッケージによる限界効果の可視化Intercept
) と切片と 3
つの変数の偏回帰係数とを表示する(Intercept) exppv ldp exppv:ldp
7.5182367 0.7914244 40.1634100 -0.7462253
ldp
) の 最小値 (0) と最大値 (1)
それぞれの値における限界効果 (slope
)を表示exppv
と 4
番目の exppv:ldp
の 2 つat.ldp <- c(0, 1) # mini (0) - max (1) まで 1 間隔で区切る
slopes <- model_1$coef[2] + model_1$coef[4]*at.ldp
# exppv の傾きの限界効果 (slopes) を計算する
# [2] は2 つ目の係数、[4] は四つ目の係数という意味
slopes # 結果を表示する
[1] 0.79142440 0.04519911
delta method
を使ってこれらの 2 つの限界効果 (=
slopes
) と標準誤差
(standard error
)を推定delta method
コマンドを使うためにmsm
パッケージをロードするsloples
)
とその標準誤差を計算し、図で表すupper
, lower
) を表示estmean <- coef(model_1)
var <- vcov(model_1)
SEs <- rep(NA, length(at.ldp))
for (i in 1:length(at.ldp)){
j <- at.ldp[i]
SEs[i] <- deltamethod (~ (x2) + (x4)*j, estmean, var) # slopes の 標準誤差
}
upper <- slopes + 1.96*SEs
lower <- slopes - 1.96*SEs
cbind(at.ldp, slopes, upper, lower)
at.ldp slopes upper lower
[1,] 0 0.79142440 0.8427628 0.74008605
[2,] 1 0.04519911 0.1230775 -0.03267927
at.ldp
は非自民党候補者が 0, 自民党候補者が 1
を表す
slopes
は 2
種類の候補者それぞれの場合において、exppv
が
voteshare
に及ぼす限界効果の大きさ(=傾き)
[1, ] と slopes
に囲まれた値 (0.79142440)
→ 非自民党候補者の場合、説明変数 (exppv
) が応答変数
(voteshare
) に与える限界効果(回帰線の傾き)
[2, ] と slopes
に囲まれた値(0.04519911)
→ 自民党候補者の場合、説明変数 (exppv
) が応答変数
(voteshare
) に与える限界効果(回帰線の傾き)
upper
と lower
は95% 信頼区間
グラフを描くために上の行列をデータフレームに変換し msm_1 という名前を付ける
at.ldp slopes upper lower
1 0 0.79142440 0.8427628 0.74008605
2 1 0.04519911 0.1230775 -0.03267927
ldp
を x
軸、exppv
が
voteshare
に与える影響力 (slopes
) を
y
軸にグラフを描くmsm_1 <- msm_1 %>%
ggplot(aes(at.ldp, slopes, ymin = lower, ymax = upper)) +
geom_hline(yintercept = 0, linetype = 2, col = "red") +
geom_pointrange(size = 1) +
geom_errorbar(aes(x = at.ldp, ymin = lower, ymax = upper),
width = 0.1) +
labs(x = "候補者の所属政党", y = "選挙費用が得票率に与える影響 (限界効果 ME)") +
scale_x_continuous(breaks = c(1,0),
labels = c("自民党", "非自民党")) +
ggtitle("model 1の限界効果") +
theme(axis.text.x = element_text(size = 14),
axis.text.y = element_text(size = 14),
axis.title.y = element_text(size = 14),
plot.title = element_text(size = 18)) +
theme_bw(base_family = "HiraKakuProN-W3")
msm_1
分析結果の解釈 (1)
交差項 (
ldp:exppv)
が統計的に有意
(p 値: 2e-16
)
→「選挙費用が得票率に与える影響は、候補者が自民党候補か否かによって異なる」
(2)
非自民党議員の95%信頼区間が赤字の点線を踏んでない
= 選挙費用 (exppv)
の係数が統計的に有意
(p 値: 2e-16
)
非自民党議員 (ldp = 0
) の限界効果 (ME) = 0.79
→非自民党議員が選挙費用を 1 円使うと得票率が
0.79%ポイント増える
(3) 自民党議員の95%信頼区間が赤字の 0
ラインをクロスしている
→ 自民党議員が選挙費用を 1
円使って増える得票率が 0
であることは否定できない(統計的に有意ではない)
interplot
パッケージによる限界効果の可視化interplot::interplot()
を使って、上記をを確かめるinterplot_1 <- interplot(m = model_1,
var1 = "exppv", # 主要な説明変数
var2 = "ldp") + # 調整変数
labs(x = "候補者の所属政党 (ldp)",
y = "選挙費用が得票率に与える影響(限界効果 ME)") +
theme_bw(base_family = "HiraKakuProN-W3")
print(interplot_1)
voteshare
)ではない!」)margins
パッケージによる限界効果の可視化margins()
関数を使って、非自民党候補者 (ldp
= 0) と自民党候補者 (ldp
= 1)
それぞれの回帰式の傾き(限界効果:
marginal effect
)を計算できるmargins_1 <- summary(margins(model_1,
at = list(ldp = 0:1))) %>%
dplyr::filter(factor == "exppv") %>%
as.data.frame()
factor ldp AME SE z p lower
1 exppv 0 0.79142440 0.02619305 30.215050 1.502555e-200 0.74008696
2 exppv 1 0.04519911 0.03973382 1.137548 2.553094e-01 -0.03267774
upper
1 0.8427618
2 0.1230760
#日本語を表示させるため、マックユーザーは以下の二行を入力
ggplot(margins_1, aes(ldp, AME, ymin = lower, ymax = upper)) +
geom_hline(yintercept = 0, linetype = 2, col = "red") +
geom_pointrange(size = 1) +
geom_errorbar(aes(x = ldp, ymin = lower, ymax = upper),
width = 0.1) +
labs(x = "候補者の所属政党", y = "選挙費用が得票率に与える影響 (限界効果 AME)") +
scale_x_continuous(breaks = c(1,0),
labels = c("自民党", "非自民党")) +
theme(axis.text.x = element_text(size = 14),
axis.text.y = element_text(size = 14),
axis.title.y = element_text(size = 14),
plot.title = element_text(size = 18)) +
theme_bw(base_family = "HiraKakuProN-W3")
model_2
)ldp:exppv
)ldp
のようなカテゴリカル変数とexppv
のような連続変数を掛け合わせて作るldp:exppv
という名称の交差項とnocand
というコントロール変数(統制変数)をモデルに入れて回帰分析を行う「回帰分析
2(ダミー変数)」におけるmodel_3
の前提:
→2 つの回帰直線が平行(= 選挙費用が得票率に与える影響力は同一)
ここではこの制限を緩め、次の前提を置く
モデルの前提:
「自民党のある候補者とそうでない候補者の間で、選挙費用が得票率に与える影響は異なる」
このモデルではldp:exppv
という説明変数(= 交差項:
interaction term
)を追加する
ここでは次の重回帰式を推定する
\[\mathrm{{voteshare}\ = \alpha_0 + \alpha_1
exppv + \alpha_2 ldp + \alpha_3 ldp:exppv + \alpha_4 nocand +
\varepsilon}\]
上記の式は次の様に書き換えることが出来る
\[\mathrm{{voteshare}\ = \alpha_0 + (\alpha_1 + \alpha_3 ldp) exppv + \alpha_2 ldp + \alpha_4 nocand + \varepsilon}\]
\(\alpha_0\) | : 選挙費用が 0 (exppv = 0) の非自民党候補
(ldp = 0 ) の得票率 |
\((\alpha_1 + \alpha_3 \textrm{ldp})\) | : 得票率 (voteshare ) に対する選挙費用
(exppv ) の影響力 |
選挙費用が得票率に与える影響は、自民党候補者とそうでない候補者の間で異なるのか?
限界効果:説明変数が(特定の値において)応答変数に与える影響力の強さ
voteshare
, ldp
,
ldp:exppv
) を使って重回帰分析を行うvoteshare
exppv
ldp:exppv
(ldp
= 調整変数)nocand
(モデル内でexppv*ldp
と入力するとexppv:ldp
という交差項名が自動的に付されexppv
,
ldp
という 2 つの変数も含まれる)
Call:
lm(formula = voteshare ~ exppv * ldp + nocand, data = df1)
Residuals:
Min 1Q Median 3Q Max
-35.986 -6.721 -1.814 6.330 39.701
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 23.45864 1.70228 13.78 <2e-16 ***
exppv 0.77014 0.02505 30.75 <2e-16 ***
ldp 39.82975 1.68957 23.57 <2e-16 ***
nocand -4.45258 0.44421 -10.02 <2e-16 ***
exppv:ldp -0.74931 0.04535 -16.52 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 10.13 on 980 degrees of freedom
(4 observations deleted due to missingness)
Multiple R-squared: 0.7229, Adjusted R-squared: 0.7218
F-statistic: 639.2 on 4 and 980 DF, p-value: < 2.2e-16
model_2
)ldp = 0
) の結果」選挙費用 (exppv
)
の係数 0.77014 と \(p値 = 2e-16\)
の意味
→ 「非自民党候補者が選挙費用を 1 円費やした時に
0.77014% ポイント得票率が高まり、それは統計的に有意」
→ 「自民党の候補者」が選挙費用を費やした時の結果はわからない
→ 「自民党の候補者」が選挙費用を費やした時の結果も調べる必要がある
交差項 (ldp:exppv
)
の係数 -0.74931 と \(p値 = 2e-16\)
の意味
→
「選挙費用が得票率に与える影響は、候補者が自民党候補か否かによって違いがあり(その差は
–0.74931 %ポイント)、それは統計的に有意」
ldp = 1
) もいる自民党ダミー (ldp)
が 0 と 1
それぞれの値をとる場合に「選挙費用が得票率に与える影響力」を確認する必要あり非自民党候補者 (ldp = 0) と自民党候補者 (ldp = 1
)
を設定して影響力を可視化する
それぞれにおいて応答変数である得票率(voteshare
)に、説明変数であ
る有権者一人当たり選挙費用(exppv
)が与える影響の大きさを可視化する
model_2
の結果から次の回帰関数の回帰式が得られる
\[\widehat{voteshare}\ = 23.46 + 0.77exppv -0.75ldp:exppv - 4.45nocand\]
\[= 23.46 + (0.77 - 0.75ldp)exppv - 4.45nocand\]
voteshare
に対する exppv
の影響力の総合値
\((α_1 + α_3ldp)\) は、\[{0.77 - 0.75ldp}\]
exppv
の係数 0.77 -
0.75ldp ・・・
候補者が有権者一人当たり選挙費用(exppv
)を 1
円費やすことで増える得票率(voteshare
)
→
選挙費用が得票率に与える影響は、候補者が自民党候補者によって異なることがわかる
この回帰式に、非自民党候補者(ldp = 0
)を代入すると、赤色の回帰式が得られる
\[\textrm{voteshare}= 23.46 + 0.77 \cdot \textrm{exppv} - 4.45 \cdot \textrm{nocand} + \varepsilon\]
model_2
の回帰式に、自民党候補者(ldp
=
1)を代入すると、青色の回帰式が得られる\[\textrm{voteshare}= 63.29 + 0.02 \cdot \textrm{exppv} - 4.45 \cdot \textrm{nocand} + \varepsilon\]
非自民党候補者の散布図も右上がりの回帰直線
→ 有権者一人当たりの選挙費用が増えると、得票率が上がる傾向
自民党候補者の散布図はほぼ水平
2 つの回帰直線の傾きの大きさが異なる
→ 選挙費用が得票率に与える影響の大きさは自民党候補者と非自民党候補者に応じて変わる
自民党候補者が有権者一人あたり 1
円選挙費用を増やすと得票率が0.02%ポイント増え
非自民党候補者が有権者一人あたり 1 円選挙費用を増やすと得票率が0.7%ポイント増え
上の散布図は次のようにしても描くことができる
F2 <- ggplot(df1, aes(x = exppv, y = voteshare)) +
geom_point(pch = 16) +
geom_abline(intercept = 23.46, slope = 0.77, linetype = "dashed", color = "red") +
geom_abline(intercept = 63.29, slope = 0.002, color = "blue") +
ylim(0, 100) +
labs(x = "選挙費用(有権者一人当たり:円)", y = "得票率 (%)") +
geom_text(label = "得票率 = 23.46 + 0.77- 選挙費用- 4.47候補者数\n(非自民党候補者)",
x = 60, y = 95, family = "HiraginoSans-W3", color = "red") +
geom_text(label = "得票率 = 63.29 + 0.002- 選挙費用 - 4.47候補者数\n(自民党候補者)",
x = 25, y = 80, family = "HiraginoSans-W3", color = "blue") +
theme_bw(base_family = "HiraKakuProN-W3")
F2
msm
パッケージによる限界効果の可視化Intercept
) と切片と 4
つの変数の偏回帰係数とを表示する(Intercept) exppv ldp nocand exppv:ldp
23.4586397 0.7701405 39.8297455 -4.4525774 -0.7493132
moderator 変数
(ldp
) の 最小値 (0)
と最大値 (1) それぞれの値における限界効果 (slope
)
を表示exppv
と 5
番目の exppv:eligible
の 2 つat.ldp <- c(0, 1) # mini (0) - max (1) まで 1 間隔で区切る
slopes <- model_2$coef[2] + model_2$coef[5]*at.ldp
# exppv の傾きの限界効果 (slopes) を計算する
# [2] は2 つ目の係数、[5] は五つ目の係数という意味
slopes # 結果を表示する
[1] 0.77014053 0.02082736
delta method
を使ってこれらの 2 つの限界効果 (=
slopes
) と標準誤差
(standard error
)を推定delta method
コマンドを使うために msm
パッケージをロードするldp
の規模ごとに得られた 2 つの限界効果
(sloples
) とその標準誤差を計算し、図で表すupper
, lower
) を表示estmean <- coef(model_2)
var <- vcov(model_2)
SEs <- rep(NA, length(at.ldp))
for (i in 1:length(at.ldp)){
j <- at.ldp[i]
SEs[i] <- deltamethod (~ (x2) + (x5)*j, estmean, var) # slopes の 標準誤差
}
upper <- slopes + 1.96*SEs
lower <- slopes - 1.96*SEs
cbind(at.ldp, slopes, upper, lower)
at.ldp slopes upper lower
[1,] 0 0.77014053 0.81923536 0.72104569
[2,] 1 0.02082736 0.09518719 -0.05353247
at.ldp
は非自民党候補者が 0, 自民党候補者が 1
を表す
slopes
は 2
種類の候補者それぞれの場合において、exppv
が
voteshare
に及ぼす限界効果の大きさ(=傾き)
[1, ] と slopes
に囲まれた値 (0.77014053)
→ 非自民党候補者の場合、説明変数 (exppv
) が応答変数
(voteshare
) に与える限界効果(回帰線の傾き)
[2, ] と slopes
に囲まれた値 (0.02082736)
→ 自民党候補者の場合、説明変数 (exppv
) が応答変数
(voteshare
) に与える限界効果(回帰線の傾き)
upper
と lower
は 95% 信頼区間
グラフを描くために上の行列をデータフレームに変換し msm_2 という名前を付ける
at.ldp slopes upper lower
1 0 0.77014053 0.81923536 0.72104569
2 1 0.02082736 0.09518719 -0.05353247
ldp
を x
軸、exppv
が
voteshare
に与える影響力 (slopes
) を
y
軸にグラフを描くmsm_2 <- msm_2 %>%
ggplot(aes(at.ldp, slopes, ymin = lower, ymax = upper)) +
geom_hline(yintercept = 0, linetype = 2, col = "red") +
geom_pointrange(size = 1) +
geom_errorbar(aes(x = at.ldp, ymin = lower, ymax = upper),
width = 0.1) +
labs(x = "候補者の所属政党", y = "選挙費用が得票率に与える影響 (限界効果 ME)") +
scale_x_continuous(breaks = c(1,0),
labels = c("自民党", "非自民党")) +
ggtitle("model 2の限界効果") +
theme(axis.text.x = element_text(size = 14),
axis.text.y = element_text(size = 14),
axis.title.y = element_text(size = 14),
plot.title = element_text(size = 18)) +
theme_bw(base_family = "HiraKakuProN-W3")
msm_2
分析結果の解釈 (1)
交差項 (ldp:exppv)
が統計的に有意 (p 値:
2e-16)
→「選挙費用が得票率に与える影響は、候補者が自民党候補か否かによって異なる」
(2)
非自民党議員の95%信頼区間が赤字の点線を踏んでない
= 選挙費用 (exppv)
の係数が統計的に有意 (p 値: 2e-16)
非自民党議員 (ldp
= 0) の限界効果 (ME) = 0.77
→非自民党議員が選挙費用を 1 円使うと得票率が
0.77%ポイント増える
(3) 自民党議員の95%信頼区間が赤字の 0
ラインをクロスしている
→自民党議員が選挙費用を 1 円使って増える得票率が
0 であることは否定できない(統計的に有意ではない)
model_1
と model_2
の限界効果結果を可視化するとAIC: Akaike's Information Criterion
)
を使って統計モデルの良さを評価してみる[1] 7457.925
[1] 7363.788
model_2
の方がAIC値が小さいので、モデルとしては
model_1
より、立候補者数 (nocand
)
を統制変数に含めた model_2
を選ぶのが好ましいといえる
従って、ここで得られた最終的な結論は次のとおり
model 2
の分析結果:
最終的な分析結果 (1)
交差項 (ldp:exppv)
が統計的に有意 (p 値:
2e-16)
→「選挙費用が得票率に与える影響は、候補者が自民党候補か否かによって違いがある」
(2)
非自民党議員の95%信頼区間が赤字の点線を踏んでない
= 選挙費用 (exppv)
の係数が統計的に有意 (p 値: 2e-16)
非自民党議員 (ldp
= 0) の限界効果 (ME) = 0.77
→非自民党議員が選挙費用を 1 円使うと得票率が
0.77%ポイント増える
(3) 自民党議員の95%信頼区間が赤字の 0
ラインをクロスしている
→自民党議員が選挙費用を 1 円使って増える得票率が
0 であることは否定できない(統計的に有意ではない)
「選挙費用が得票率に与える影響は、民主党候補者とそれ以外の候補者で異なるかどうか」を調べたい
ここで使うデータは1996年から2021年に実施された総選挙結果
データはここからダウンロード
このデータセットには次の 23 個の変数が入っている
変数名 | 詳細 |
---|---|
1. year | 選挙年 (1996-2021) |
2. pref | 都道府県名 |
3. ku | 小選挙区名 |
4. kun | 小選挙区 |
5. rank | 当選順位 |
6. nocand | 立候補者数 |
7. seito | 候補者の所属政党 |
8. j_name | 候補者の氏名(日本語) |
9. name | 候補者の氏名(ローマ字) |
10. previous | 当選回数 |
11. gender | 立候補者の性別: “male”, “female” |
12. age | 立候補者の年齢 |
13. wl | 選挙の当落: 1 = 小選挙区当選、2 = 復活当選、0 = 落選 |
14. wlsmd | 選挙の当落: 1 = 当選(小選挙区)、0 = 落選(小選挙区) |
15. exp | 立候補者が使った選挙費用(総務省届け出) |
16. status | 候補者のステータス: 0 = 非現職、1 現職、2 = 元職 |
17. vote | 得票数 |
18. voteshare | 得票率 (%) |
19. eligible | 小選挙区の有権者数 |
20. turnout | 小選挙区の投票率 (%) |
21. seshu_dummy | 世襲候補者ダミー: 1 = 世襲、0 = 非世襲(地盤世襲 or 非世襲) |
22. jiban_seshu | 地盤の受け継ぎ元の政治家の氏名と関係 |
23. nojiban_seshu | 世襲元の政治家の氏名と関係 |
変数名 | 詳細 |
---|---|
voteshare | 得票率 (%) |
exppv | 有権者一人当たりに候補者が費やした選挙費用 (yen) |
dpj | 民主党ダミー(民主党候補者 = 1、それ以外の候補者 = 0) |
previous | 候補者の当選回数 |
age | 候補者の年齢 |
nocand | 立候補者数 |
注意1:dpj
という変数はデータセット内には含まれていないので、seito
もしくは party
変数を使って各自作成すること
注意2:exppv
という変数はデータセット内には含まれていないので、exp
と
eligible
2 つの変数を使って各自作成すること
Q1: 上記3
つの変数に関する記述統計を表示させなさい
Q2:
選挙費用と得票率の散布図を表示し、簡単にコメントしなさい
Q3:
衆議院選挙において「選挙費用が得票率に与える影響は、民主党候補者とそれ以外の候補者で異なるかどうか」に関するあなたの仮説を述べなさい
また、そう考える理由を簡単に述べなさい
Q4:
「選挙費用が得票率に与える影響は、民主党候補者とそれ以外の候補者で異なる」と言えるか?
msm
パッケージを使って、民主党候補者とそれ以外の候補者それぞれに関して、選挙費用が得票率に与える限界効果を可視化し、その結果をわかりやく説明しなさい