20. 重回帰分析 3（交差項 1）
Masahiko Asano
2021-11-08
- 分析に必要なパッケージをロードする
library(tidyverse)
library(stargazer)
library(margins)
library(interplot)
library(msm)
library(patchwork)
library(jtools)ダミー変数と交差項でわかること
| 変数の種類 | 変数名 | 詳細 |
|---|---|---|
| 応答変数 | voteshare |
候補者の得票率 (%) |
| 説明変数 | exppv |
候補者が有権者一人当たりに使う使う選挙費用（円） |
| ダミー変数 | ldp |
自民党候補者か否か(ldp: 0 = 非自民党、1 = 自民党) |
ダミー変数を説明変数に加えると、ダミー変数の値によって回帰直線が平行移動するような変化（つまり、自民党候補者であるか否かという要因は候補者の得票率に影響したのかということ）を捉えることができる（下の図の左側）
| 変数の種類 | 変数名 | 詳細 |
|---|---|---|
| 応答変数 | voteshare |
候補者の得票率 (%) |
| 説明変数 | exppv |
候補者が有権者一人当たりに使う使う選挙費用（円） |
| 調整変数（ダミー変数） | ldp |
自民党候補者か否か（0 = 非自民党、1 = 自民党） |
| 交差項 | exppv:ldp |
選挙費用と自民党ダミーを掛け合わせた変数 |
交差項を説明変数に加えると、自民党候補者とそうでない候補者の間において、選挙費用が得票率に与える影響を捉えることができる（上の図の右側）
1. 交差項を使った回帰分析モデル
1.1 データの準備 (hr96-21.csv)
1.1.1 データのダウンロード方法
予めダウンロード先を指定する方法
RProjectフォルダ内に data という名称のフォルダを作成する
- 下のコマンドを実行すると、
csvファイルがパソコンにダウンロードされ、data 内に自動的に保存される
download.file(url = "http://www.ner.takushoku-u.ac.jp/masano/class_material/waseda/keiryo/Data/hr96-21.csv",
destfile = "data/hr96-21.csv")注意：一度ダウンロードを完了すれば、このコマンドを実行する必要はありません
ダウンロード先を指定しない方法
hr96-21.csv をクリックしてデータをパソコンにダウンロード
RProjectフォルダ内に data という名称のフォルダを作成する
ダウンロードした
hr96-21.csvを手動でRProjectフォルダ内にある data フォルダに入れる
1.1.2 選挙データの読み取り方法
- 次のいずれかの方法で
hr96-21.csvを読み取る
読み取り方法 1
na = "."というコマンドは「欠損値をドットで置き換える」という意味
- 欠損値を空欄のまま残すと、本来「数値 (
numeric)」型のデータが「」文字型 (character)」として認識されるなど、エラーの原因になるため、読み取る時点で事前に対処する
hr <- read_csv("data/hr96-21.csv",
na = ".") 読み取り方法 2
- 読み取った値の日本語が文字化けする場合
locale()関数を使って日本語エンコーディング (cp932) を指定する
hr <- read_csv("data/hr96-21.csv",
na = ".",
locale = locale(encoding = "cp932"))読み取り方法 3
hr <- read.csv("data/hr96-21.csv",
na = ".") 1.1.3 読み取った選挙データを確認
hr96_17.csvは1996年に衆院選挙に小選挙区が導入されて以来実施された 9 回の衆議院選挙（1996, 2000, 2003, 2005, 2009, 2012, 2014, 2017, 2021）の結果のデータ
hrに含まれる変数名を表示させる
names(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 | 世襲元の政治家の氏名と関係 |
- データの型をチェック
str(hr)spec_tbl_df [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()
.. )数値は
numeric文字はcharacterとして認識されていることがわかるhr96_17.csvは1996年に衆院選挙に小選挙区が導入されて以来実施された 9 回の衆議院選挙（1996, 2000, 2003, 2005, 2009, 2012, 2014, 2017, 2021）の結果のデータデータフレーム
hrの変数名を確認/
names(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に含まれる値を確かめる
unique(hr$seito) [1] "新進" "自民" "民主"
[4] "共産" "文化フォーラム" "国民党"
[7] "無所" "自由連合" "政事公団太平会"
[10] "新社会" "社民" "新党さきがけ"
[13] "沖縄社会大衆党" "市民新党にいがた" "緑の党"
[16] "さわやか神戸・市民の会" "民主改革連合" "青年自由"
[19] "日本新進" "公明" "諸派"
[22] "保守" "無所属の会" "自由"
[25] "改革クラブ" "保守新" "ニューディールの会"
[28] "新党尊命" "世界経済共同体党" "新党日本"
[31] "国民新党" "新党大地" "幸福"
[34] "みんな" "改革" "日本未来"
[37] "日本維新の会" "当たり前" "政治団体代表"
[40] "安楽死党" "アイヌ民族党" "次世"
[43] "維新" "生活" "立憲"
[46] "希望" "緒派" "Ｎ党"
[49] "国民" "れい" 1.1.4 必要な変数の作成
- 分析には自民党ダミーが必要なので、
seito = "自民, それ以外の政党を 0 にしたダミー変数を作りdf1と名前を付ける
df1 <- hr %>%
mutate(ldp = ifelse(seito == "自民", 1, 0))- 分析には候補者が有権者一人あたりに費やした選挙費用データが必要
- しかし、この変数がないので
exppvという名称で新たに変数を作りdf1に上書きする
df1 <- mutate(df1, exppv = exp / eligible)- 分析に必要な変数だけに絞る
df1 <- df1 %>%
dplyr::filter(year == 2005) %>% # 2005年のデータだけを選ぶ
dplyr::select(year, ku, kun, j_name, age, rank, previous, voteshare, eligible, exppv, nocand, ldp) # 11の変数だけを選ぶ- df1に含まれる変数を確認する
names(df1) [1] "year" "ku" "kun" "j_name" "age" "rank"
[7] "previous" "voteshare" "eligible" "exppv" "nocand" "ldp" ldpが作られていることを確認
- データの最初の 6 行を表示させる
head(df1)# A tibble: 6 x 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
# … with 1 more variable: ldp <dbl>1.2 データの記述統計
library(stargazer)stargazer(as.data.frame(df1),
type = "html")| Statistic | N | Mean | St. Dev. | Min | Pctl(25) | Pctl(75) | Max |
| year | 989 | 2,005.000 | 0.000 | 2,005 | 2,005 | 2,005 | 2,005 |
| kun | 989 | 5.563 | 4.916 | 1 | 2 | 8 | 25 |
| age | 989 | 50.292 | 10.871 | 25 | 42 | 58 | 81 |
| rank | 989 | 2.217 | 1.041 | 1 | 1 | 3 | 6 |
| previous | 989 | 1.550 | 2.412 | 0 | 0 | 2 | 15 |
| voteshare | 989 | 30.333 | 19.230 | 1 | 8.8 | 46.6 | 74 |
| eligible | 989 | 344,654.300 | 63,898.230 | 214,235 | 297,385 | 397,210 | 465,181 |
| exppv | 985 | 24.627 | 17.907 | 0.148 | 8.352 | 35.269 | 89.332 |
| nocand | 989 | 3.435 | 0.740 | 2 | 3 | 4 | 6 |
| ldp | 989 | 0.293 | 0.455 | 0 | 0 | 1 | 1 |
- 分析に必要な変数だけに絞る
df1 <- df1 %>%
dplyr::filter(year == 2005) %>% # 2005年のデータだけを選ぶ
dplyr::select(ku, kun, j_name, age, rank, previous, voteshare, eligible, exppv, nocand, ldp) # 11の変数だけを選ぶ- df1に含まれる変数を確認する
names(df1) [1] "ku" "kun" "j_name" "age" "rank" "previous"
[7] "voteshare" "eligible" "exppv" "nocand" "ldp" - ldp が作られていることを確認
- データの最初の 6 行を表示させる
head(df1)# A tibble: 6 x 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- データの記述統計を示す
library(stargazer)stargazer(as.data.frame(df1),
type = "html")| Statistic | N | Mean | St. Dev. | Min | Pctl(25) | Pctl(75) | Max |
| kun | 989 | 5.563 | 4.916 | 1 | 2 | 8 | 25 |
| age | 989 | 50.292 | 10.871 | 25 | 42 | 58 | 81 |
| rank | 989 | 2.217 | 1.041 | 1 | 1 | 3 | 6 |
| previous | 989 | 1.550 | 2.412 | 0 | 0 | 2 | 15 |
| voteshare | 989 | 30.333 | 19.230 | 1 | 8.8 | 46.6 | 74 |
| eligible | 989 | 344,654.300 | 63,898.230 | 214,235 | 297,385 | 397,210 | 465,181 |
| exppv | 985 | 24.627 | 17.907 | 0.148 | 8.352 | 35.269 | 89.332 |
| nocand | 989 | 3.435 | 0.740 | 2 | 3 | 4 | 6 |
| ldp | 989 | 0.293 | 0.455 | 0 | 0 | 1 | 1 |
2. 統制変数を含まないモデル (model_1)
2.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) を考慮する必要がある
限界効果：説明変数が（特定の値において）応答変数に与える影響力の強さ
- ここでは次の 3 つの変数を使って重回帰分析を行う
- 応答変数 ・・・voteshare（得票率：%）
- 説明変数 ・・・exppv（有権者一人あたりに候補者が費やした選挙費用:円）
- 交差項 ・・・ldp:exppv(ldp= 調整変数)
（モデル内でexppv*ldpと入力するとexppv:ldpという交差項名が自動的に付されexppv, ldpという2 つの変数も含まれる）
model_1 <- lm(voteshare ~ exppv*ldp,
data = df1)
summary(model_1)
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-16stargazer()を使って、見やすく表示できる
stargazer(model_1, type = "text", single.row=TRUE,
ci = TRUE) # print 95% CIs
===============================================
Dependent variable:
---------------------------
voteshare
-----------------------------------------------
exppv 0.791*** (0.740, 0.843)
ldp 40.163*** (36.689, 43.638)
exppv:ldp -0.746*** (-0.840, -0.653)
Constant 7.518*** (6.269, 8.767)
-----------------------------------------------
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.012.2 公差項の係数の解釈 (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パッケージを使うと、以上の結果を視覚的に確認できる
library("jtools")
plot_summs(model_1)
しかし、交差項を含む重回帰分析結果だけを示すのはあまり有益とはいえない
その理由 → 調整変数(この場合、
ldp = 0)の結果しか示していないから
→ 調整変数の両方の値（ldp = 0とldp = 1）における限界効果を示す必要ありデータ解析において重要なこと:
統計的有意性 (statistical significance) → 限界効果を計算して図示する
実質的有意性 (substantial significance) → 限界効果を計算して図示する
2.3 交差項を含むモデルで「限界効果」を求める理由
★ 交差項を含まない重回帰分析の場合:
- 特定の説明変数
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.79142
- これは非自民党候補者 (
ldp = 0) の選挙費用が得票率に与える影響
→ 自民党候補者 (ldp = 1)の選挙費用が得票率に与える影響ではない
→ 調整変数であるldpには平均値 (0.5) という候補者は存在しない
→ 知りたいのは自民党候補者と非自民党候補者それぞれの選挙費用が得票に影響しているかどうか
→ldp = 0.5という実在しない候補者のデータを求めても意味がない
→ldpを中心化する意味はないので、中心化する必要はない
まとめ ・交差項を含む重回帰分析の場合「他の変数の値を一定に保つ」ことができないため、調整変数の値（カテゴリカル変数の場合は 0, 1）の限界効果をそれぞれチェックする必要がある
2.4 限界効果の可視化
2.4.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\]
- この結果を図示すると、次のようになる
- 点線は自民党候補者、実線は非自民党候補者の結果をそれぞれ示している
- 点線（自民党候補者）よりも実線（非自民党候補者）の方が傾きが大きい
→ 選挙費用が得票率に与える影響力は、自民党候補者よりも非自民党候補者の方が大きい
- 上で求めた 2 つの回帰式を散布図に描く
ggplotで日本語を表示させるため、マックユーザーは以下の行を入力
theme_bw(base_family = "HiraKakuProN-W3")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.57 + 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")
- どちらの散布図も右上がりの回帰直線
→ 有権者一人当たりの選挙費用が増えると、得票率が上がる傾向
- 2 つの回帰直線の傾きの大きさが異なる
→ 選挙費用が得票率に与える影響の大きさは有権者数に応じて変わる
- 自民党候補者が有権者一人あたり 1 円選挙費用を増やすと得票率が 0.045% ポイント増える
- 非自民党候補者が有権者一人あたり 1 円選挙費用を増やすと得票率が 0.79% ポイント増える
2.4.2 msmパッケージによる限界効果の可視化
- 交差項の効果は偶然得られたものではない（統計的に有意な）のか？
- 2 本の回帰直線の傾きの違いは、統計的にも意味のある違いなのだろうか？
- model_1 で得られた切片 (
Intercept) と切片と 3 つの変数の偏回帰係数とを表示する
model_1$coef(Intercept) exppv ldp exppv:ldp
7.5182367 0.7914244 40.1634100 -0.7462253 - moderator 変数 (
ldp) の 最小値 (0) と最大値 (1) それぞれの値における限界効果 (slope)を表示
- 限界効果を計算するに必要な係数は 2 番目の
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.04519911delta methodを使ってこれらの 2 つの限界効果 (=slopes) と標準誤差 (standard error)を推定
delta methodコマンドを使うためにmsmパッケージをロードする
library(msm)- 候補者の所属政党ごとに得られた 2 つの限界効果 (
sloples) とその標準誤差を計算し、図で表す
- 95% 信頼区間 (
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){style=“color:blue”} → 自民党候補者の場合、説明変数 (exppv) が応答変数 (voteshare) に与える限界効果（回帰線の傾き）
upperとlowerは95% 信頼区間グラフを描くために上の行列をデータフレームに変換し msm_1 という名前を付ける
msm_1 <- cbind(at.ldp, slopes, upper, lower) %>%
as.data.frame()
msm_1 at.ldp slopes upper lower
1 0 0.79142440 0.8427628 0.74008605
2 1 0.04519911 0.1230775 -0.03267927ldpを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 であることは否定できない（統計的に有意ではない）
2.4.3 interplotパッケージによる限界効果の可視化
interplot::interplot()を使って、上記をを確かめる
library("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)ではない!」)
2.4.4 marginsパッケージによる限界効果の可視化
margins()関数を使って、非自民党候補者 (ldp= 0) と自民党候補者 (ldp= 1) それぞれの回帰式の傾き（限界効果:marginal effect）を計算できる
library(margins)margins_1 <- summary(margins(model_1,
at = list(ldp = 0:1))) %>%
dplyr::filter(factor == "exppv") %>%
as.data.frame()margins_1 factor ldp AME SE z p lower upper
1 exppv 0 0.79142440 0.02619304 30.21507 1.501655e-200 0.74008700 0.8427618
2 exppv 1 0.04519911 0.03973372 1.13755 2.553083e-01 -0.03267755 0.1230758- この結果を ggplot を使って可視化する/
#日本語を表示させるため、マックユーザーは以下の二行を入力
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")
3. 統制変数を含むモデル (model_2)
3.1 公差項 (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) の影響力 |
選挙費用が得票率に与える影響は、自民党候補者とそうでない候補者の間で異なるのか？
- 交差項を含めたモデルを推定する場合、限界効果 (Marginal Effects) を考慮する必要がある
限界効果：説明変数が（特定の値において）応答変数に与える影響力の強さ
- ここでは次の 3 つの変数 (
voteshare,ldp,ldp:exppv) を使って重回帰分析を行う
- 応答変数・・・
voteshare
- 説明変数・・・
exppv
- 交差項・・・
ldp:exppv(ldp= 調整変数)
- 統制変数・・・
nocand
（モデル内でexppv*ldpと入力するとexppv:ldpという交差項名が自動的に付されexppv, ldpという 2 つの変数も含まれる）
model_2 <- lm(voteshare ~ exppv*ldp + nocand,
data = df1)
summary(model_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-163.2 公差項の係数の解釈 (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 それぞれの値をとる場合に「選挙費用が得票率に与える影響力」を確認する必要あり
3.4 限界効果の可視化
3.4.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.47 \cdot \textrm{nocand} + \varepsilon\]
非自民党候補者の散布図も右上がりの回帰直線
→ 有権者一人当たりの選挙費用が増えると、得票率が上がる傾向
自民党候補者の散布図はほぼ水平
2 つの回帰直線の傾きの大きさが異なる
→ 選挙費用が得票率に与える影響の大きさは自民党候補者と非自民党候補者に応じて変わる
自民党候補者が有権者一人あたり 1 円選挙費用を増やすと得票率が0.002%ポイント増え
非自民党候補者が有権者一人あたり 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
3.4.2 msm パッケージによる限界効果の可視化
- 交差項の効果は偶然得られたものではない（統計的に有意な）のか？
- 2 本の回帰直線の傾きの違いは、統計的にも意味のある違いなのだろうか？
- model_2 で得られた切片 (
Intercept) と切片と 4 つの変数の偏回帰係数とを表示する
model_2$coef(Intercept) exppv ldp nocand exppv:ldp
23.4586397 0.7701405 39.8297455 -4.4525774 -0.7493132 moderator 変数(ldp) の 最小値 (0) と最大値 (1) それぞれの値における限界効果 (slope) を表示
- 限界効果を計算するに必要な係数は 2 番目の
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.02082736delta methodを使ってこれらの 2 つの限界効果 (=slopes) と標準誤差 (standard error)を推定
delta methodコマンドを使うためにmsmパッケージをロードする
library(msm)ldpの規模ごとに得られた 2 つの限界効果 (sloples) とその標準誤差を計算し、図で表す
- 95% 信頼区間 (
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 という名前を付ける
msm_2 <- cbind(at.ldp, slopes, upper, lower) %>%
as.data.frame()
msm_2 at.ldp slopes upper lower
1 0 0.77014053 0.81923536 0.72104569
2 1 0.02082736 0.09518719 -0.05353247ldpを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 であることは否定できない（統計的に有意ではない）
4. 結論
- ここでは次の 2 つのモデルを分析した
model_1とmodel_2の限界効果結果を可視化すると
msm_1 + msm_2 + plot_layout(ncol = 2)
- 基本的にどちらのモデルも同じような結果を得ているが、どちらのモデルを使うべきか？
- 赤池情報量規準 (
AIC: Akaike's Information Criterion) を使って統計モデルの良さを評価してみる
AIC(model_1)[1] 7457.925AIC(model_2)[1] 7363.788model_2の方がAIC値が小さいので、モデルとしてはmodel_1より、立候補者数 (nocand) を統制変数に含めたmodel_2を選ぶのが好ましいといえる
従って、ここで得られた最終的な結論は次のとおり
model 2の分析結果:
F2
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 であることは否定できない（統計的に有意ではない）
5. Excercise
「選挙費用が得票率に与える影響は、民主党候補者とそれ以外の候補者で異なるかどうか」を調べたい
ここで使うデータはは1996年から2021年に実施された総選挙結果: hr96-21.csv
このデータセットには次の 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 | 世襲元の政治家の氏名と関係 |
- ここから 2009年のデータと次の 6 つの変数を抜き出して分析しなさい
| 変数名 | 詳細 |
|---|---|
| voteshare | 得票率 (%) |
| exppv | 有権者一人当たりに候補者が費やした選挙費用 (yen) |
| dpj | 民主党ダミー(民主党候補者 = 1、それ以外の候補者 = 0) |
| previous | 候補者の当選回数 |
| age | 候補者の年齢 |
| nocand | 立候補者数 |
注意1：dpj という変数はデータセット内には含まれていないので、seito もしくは party 変数を使って各自作成すること
注意2：exppv という変数はデータセット内には含まれていないので、exp と eligible 2 つの変数を使って各自作成すること
Q1: 上記3 つの変数に関する記述統計を表示させなさい
Q2: 選挙費用と得票率の散布図を表示し、簡単にコメントしなさい
Q3: 衆議院選挙において「選挙費用が得票率に与える影響は、民主党候補者とそれ以外の候補者で異なるかどうか」に関するあなたの仮説を述べなさい また、そう考える理由を簡単に述べなさい
Q4: 「選挙費用が得票率に与える影響は、民主党候補者とそれ以外の候補者で異なる」と言えるか？ msm パッケージを使って、民主党候補者とそれ以外の候補者それぞれに関して、選挙費用が得票率に与える限界効果を可視化し、その結果をわかりやく説明しなさい