18. 重回帰分析 4（交差項 2）

• 分析に必要なパッケージをロードする

library(broom)
library(ggstance)
library(interplot)
library(margins)
library(msm)
library(patchwork)
library(stargazer)
library(tidyverse)

調整変数はカテゴリカル変数か連続変数か？

• 調整変数がカテゴリカル変数なのか連続変数なのか？
  →　それぞれ限界効果の可視化方法が異なる

例）

• 候補者の所属政党ごと、選挙費用が得票率に与える影響（カテゴリカル変数：左の図）
  
• 有権者数の規模ごと、選挙費用が得票率に与える影響（連続変数：右の図） 　　

1. 1. 交差項を使った回帰分析モデル

ここで知りたいこと

• 「選挙費用が得票率に与える影響は、有権者数によって変わるのか？」

1.1 データの準備 (hr96-21.csv)

• 次のいずれかの方法で csv ファイルを取り込む

選挙データの読み取り方法 (1)

• RProject フォルダ内に data と名前を付けたフォルダを作成する
• 次のコードを Rmd ファイルのチャンクの中に打ち込み knit する

download.file(url = "https://asanoucla.github.io/hr96-21.csv",
              destfile = "data/hr96-21.csv")

• ダウンロードが自動的にRProject フォルダ内の data フォルダにダウンロードされるはず
• ダウンロードが完了したら、上のコマンドは削除する
  
• dataフォルダ内から read_csv で読み取る

df1 <- read_csv("data/hr96-21.csv", na = ".")            

選挙データの読み取り方法 (2)

• hr96-21.csv をダウンロードして RProject フォルダ 内の data フォルダに入れる

• dataフォルダ内から read_csv で読み取る

df1 <- read_csv("data/hr96-21.csv", na = ".")　          

読み込んだデータの内容を確認する

• hr96_21.csv は1996年に衆院選挙に小選挙区が導入されて以来実施された 9 回の衆議院選挙（1996, 2000, 2003, 2005, 2009, 2012, 2014, 2017, 2021）の結果のデータ

• データフレーム df1 の変数名を確認/

names(df1)

 [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"

• 分析には候補者が有権者一人あたりに費やした選挙費用データが必要
  
• しかし、この変数がないので 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) # 10の変数だけを選ぶ

• df1に含まれる変数を確認する

names(df1)

 [1] "year"      "ku"        "kun"       "j_name"    "age"       "rank"     
 [7] "previous"  "voteshare" "eligible"  "exppv"     "nocand"   

• データの最初の 6 行を表示させる

head(df1)

# A tibble: 6 × 11
   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.2 データの記述統計

library(stargazer)

stargazer(as.data.frame(df1), 
          type = "html")

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

• 分析に必要な変数だけに絞る

df1 <- df1 %>%　
  dplyr::filter(year == 2005) %>%　  　# 2005年のデータだけを選ぶ
  dplyr::select(ku, kun, j_name, age, rank, previous, voteshare, eligible, exppv, nocand) # 10の変数だけを選ぶ

• df1に含まれる変数を確認する

names(df1)

 [1] "ku"        "kun"       "j_name"    "age"       "rank"      "previous" 
 [7] "voteshare" "eligible"  "exppv"     "nocand"   

• データの最初の 6 行を表示させる

head(df1)

# A tibble: 6 × 10
  ku      kun j_name       age  rank previous voteshare eligible exppv nocand
  <chr> <dbl> <chr>      <dbl> <dbl>    <dbl>     <dbl>    <dbl> <dbl>  <dbl>
1 aichi     1 河村たかし    56     1        4      50     360007 17.0       4
2 aichi     1 篠田陽介      32     2        0      39.1   360007 40.0       4
3 aichi     1 木村恵美      55     3        0       7.4   360007  6.05      4
4 aichi     1 小林正和      56     4        0       3.6   360007 13.1       4
5 aichi     2 古川元久      39     1        3      52     366121 30.2       3
6 aichi     2 岡田裕二      27     2        0      39.1   366121 14.4       3

• データの記述統計を示す

library(stargazer)

stargazer(as.data.frame(df1), 
          type = "html")

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

1.2 変数間の散布図を確認

ここで知りたいこと

• 「選挙費用が得票率に与える影響は、有権者数によって変わるのかどうか」

• 2 つの散布図を確認
  

• 選挙費用（説明変数）と得票率（応答変数）- - - F1
  

• 有権者数（調整変数）と得票率（応答変数）- - - F2

• ggplot で日本語を表示させるため、マックユーザーは以下のいずれかのコマンドを入力

theme_set(theme_bw(base_size = 10,
                     base_family = "HiraginoSans-W3"))

theme_bw(base_family = "HiraKakuProN-W3")

F1 <- ggplot(df1, aes(exppv, voteshare)) +
  geom_point() +
  labs(x = "選挙費用（円：有権者一人あたり）", y = "得票率 (%)",
         title = "選挙費用と得票率") + 
  stat_smooth(method = lm, se = FALSE) +
  theme_bw(base_family = "HiraKakuProN-W3")

F2 <- ggplot(df1, aes(eligible, voteshare)) +
  geom_point() +
  labs(x = "有権者数", y = "得票率 (%)",
         title = "有権者数と得票率") + 
  stat_smooth(method = lm, se = FALSE) +
  theme_bw(base_family = "HiraKakuProN-W3")

F1 + F2 + plot_layout(ncol = 2)

• 選挙費用と得票率は正の相関
  
• 有権者数と得票率の間には強い相関が認められない（ゆるい負の相関）

2. 交差項を含まない・含むモデルの比較

• ここでは交差項を含まないモデル (model_1) と含むモデル (model_2) を比較しながら、交差項の働きを理解する

2.1 交差項を含まないモデル (model_1)

• 応答変数（得票率）、主要な説明変数（選挙費用）に加えて、4 つのコントロール変数としたモデル

• ここで使う変数は次の通り

変数の種類	変数名	詳細
応答変数	voteshare	候補者の得票率 (%)
説明変数	exppv	候補者が有権者一人当たりに使う使う選挙費用（円）
コントロール変数1	eligible	有権者数
コントロール変数2	age	候補者の年齢
コントロール変数3	nocand	選挙区から立候補者数
コントロール変数4	previous	立候補者の当選回数

• model_1 では次の重回帰式を推定する

\[voteshare = α_1 + α_2 exppv + α_3 eligible + α_4 age + α_5 nocand + α_6 previous + ε \]

model_1 の分析結果

model_1 <- lm(voteshare ~ exppv + 
                eligible + 
                age +
                nocand +
                previous, 
              data = df1)

stargazer(model_1,
          type = "html")

	Dependent variable:
	voteshare
exppv	0.614***
	(0.024)
eligible	0.00005***
	(0.00001)
age	-0.279***
	(0.036)
nocand	-4.909***
	(0.478)
previous	3.130***
	(0.184)
Constant	25.169***
	(3.235)
Observations	985
R2	0.681
Adjusted R2	0.679
Residual Std. Error	10.882 (df = 979)
F Statistic	417.161*** (df = 5; 979)
Note:	p<0.1; p<0.05; p<0.01

model 1 の分析結果 ・選挙費用 (exppv)の係数 (0.614) が統計的に有意
→　選挙費用が 1 円増えると得票率が 0.614%ポイント増える

2.2 交差項を含むモデル (model_2)

• 実際の重回帰分析では、交差項を構成している主要な説明変数（ここでは exppv）と調整変数（ここでは eligible）以外に、コントロール変数をモデルに含むことが多い
  
• ここでは、応答変数（得票率）、主要な説明変数（選挙費用）、調整変数（有権者数）に加えて、3 つのコントロール変数としたモデルを考える

変数の種類	変数名	詳細
応答変数	voteshare	候補者の得票率 (%)
説明変数	exppv	候補者が有権者一人当たりに使う使う選挙費用（円）
調整変数	eligible	有権者数
交差項	exppv:eligible	選挙費用と有権者数を掛けあわせた変数
コントロール変数1	age	候補者の年齢
コントロール変数2	nocand	選挙区から立候補者数
コントロール変数3	previous	立候補者の当選回数

• ここでは次の重回帰式を推定する
  \[voteshare = α_7 + α_8 exppv + α_9 eligible + α_{10} eligible:exppv +\\ α_{11} age + α_{12} nocand + α_{13} previous + ε \]

• 上記の式は次の様に書き換えることが出来る

\[voteshare = α_7 + (α_8 + α_{10} eligible) exppv + α_9 eligible\\ + α_{11}age + α_{12} nocand + α_{13} previous +ε\]

係数の意味

\(\alpha_{10}\)	: 有権者数が 0 (eligible= 0) の時の回帰直線の傾き = 限界効果
	= 得票率 (voteshare) に対する選挙費用 (exppv) の影響力
\((\alpha_8 + \alpha_{10} \textrm{eligible})\)	: 有権者数 (eligible) ごとの回帰直線の傾き = 限界効果
	= 得票率 (voteshare) に対する選挙費用 (exppv) の影響力

• 知りたいのは「選挙費用が得票率に与える影響は、有権者数によって変わるのかどうか」

model_2 の分析結果

• モデル内でexppv*eligibleと入力するとexppv:eligibleという交差項名が自動的に表示され exppv, eligibleという 2 つの変数も自動的に含まれる　　

model_2 <- lm(voteshare ~ exppv*eligible + 
                age +
                nocand +
                previous, 
              data = df1)

• ここでは公差項を含まない model_1 と含むモデル model_2 を比較しつつ、交差項の係数の意味を解説する

stargazer(model_1, model_2, type = "html")

	Dependent variable:
	voteshare
	(1)	(2)
exppv	0.614***	0.068
	(0.024)	(0.097)
eligible	0.00005***	0.00001
	(0.00001)	(0.00001)
age	-0.279***	-0.277***
	(0.036)	(0.035)
nocand	-4.909***	-4.881***
	(0.478)	(0.470)
previous	3.130***	2.960***
	(0.184)	(0.184)
exppv:eligible		0.00000***
		(0.00000)
Constant	25.169***	38.680***
	(3.235)	(3.949)
Observations	985	985
R2	0.681	0.691
Adjusted R2	0.679	0.689
Residual Std. Error	10.882 (df = 979)	10.706 (df = 978)
F Statistic	417.161*** (df = 5; 979)	364.721*** (df = 6; 978)
Note:	p<0.1; p<0.05; p<0.01

• model_2 の係数が小さすぎて表示されないので tidy()関数を使って係数値の詳細を表示させる

tidy(model_2)

# A tibble: 7 × 5
  term              estimate   std.error statistic  p.value
  <chr>                <dbl>       <dbl>     <dbl>    <dbl>
1 (Intercept)    38.7        3.95            9.80  1.12e-21
2 exppv           0.0682     0.0972          0.702 4.83e- 1
3 eligible        0.00000536 0.00000914      0.586 5.58e- 1
4 age            -0.277      0.0355         -7.81  1.50e-14
5 nocand         -4.88       0.470         -10.4   4.86e-24
6 previous        2.96       0.184          16.1   5.28e-52
7 exppv:eligible  0.00000175 0.000000302     5.78  9.93e- 9

model 2 の分析結果 ・交差項 (exppv:eligible)が統計的に有意 (係数: 0.00000175, p 値: 9.93e- 9)
・「選挙費用が得票率に与える影響は、有権者数によって異なる」
→　具体的には「有権者数が 0 人(eligible = 0) と 1 人 (eligible = 1) の候補者では
0.00000175%ポイントの違いがある」
・係数がプラス
・有権者数が 1 人 (eligible = 1) の候補者の方が影響力が大きい

・選挙費用 (exppv)の係数が統計的に有意ではない (係数: 0.0682, p 値: 0.483)
・これは有権者数（eligible）が 0 の時の結果
・しかし、実際の選挙において、有権者がゼロというのはあり得ない
→　現実的な有権者数の時の結果を示す必要がある

３つの解決策:

(1) 調整変数である有権者数 (eligible)が現実的な複数の値（「少ない有権者」と「多い有権者」）をとる場合に選挙費用が得票率に与える影響力を確認する
限界効果を可視化する　→　「2.3.1 特定の 2 つの調整変数値による可視化」参照

(2) 調整変数である有権者数 (eligible)が現実的な複数の値（最小値〜最大値まで一定間隔の値）をとる場合に選挙費用が得票率に与える影響力を確認する
限界効果を可視化する　→　「2.3.2 msm パッケージによる可視化」参照・・・ 推奨
限界効果を可視化する　→　「2.3.4 interplot パッケージによる可視化」参照]・・・ 推奨
限界効果を可視化する　→　「2.3.5 margins パッケージによる可視化」参照]・・・ 推奨

(3) 調整変数である有権者数 (eligible) が現実的な値（平均値）をとる場合に選挙費用が得票率に与える影響力を確認する
説明変数を中心化する　→　「3. 説明変数を中心化したモデル (model_3)」参照

2.3 限界効果の可視化 (model_2)

2.3.1 特定の 2 つの調整変数値による可視化

• ここでは調整変数である有権者数（eligible）を 2 つの異なる値に設定
  
• それぞれの値において応答変数である得票率（voteshare）に、説明変数である有権者一人当たり選挙費用（exppv）が与える影響の大きさを可視化する
  
• 特定の 2 つの値：有権者数が多い場合と少ない場合 - 有権者数（eligible）の平均値（mean）と標準偏差（sd）を求める

mean(df1$eligible)

[1] 344654.3

sd(df1$eligible)

[1] 63898.23

• 有権者数の平均値は344,654人、標準偏差は63,898人であることがわかる
  
• ここでは有権者数に応じて、選挙費用が得票率に与える影響力を可視化するグラフを作成したい
  
• 有権者が「多い」選挙区と「少ない」選挙区を次のように定義する

● 有権者が少ない場合（有権者数の平均値 - 1 標準偏差）≈ 280,802人
● 有権者数が多い場合（有権者数の平均値 + 1 標準偏差）≈ 408,598人

• 有権者が少ない場合と多い場合、それぞれにおいて選挙費用が得票率に与える影響力を可視化する
  
• 選挙費用が得票率に与える影響力を可視化するためには、有権者数が 280,802 人の 時と 408,598 人の時それぞれの回帰式を求める必要がある
  
• ここで使っている回帰関数の回帰式

\[\widehat{voteshare} = 38.7 + (0.068 + 0.00000175*eligible) exppv - 0.00000536*eligible\]

\[-0.28age - 4.9nocand + 3previous\]

有権者が少ない場合

• eligible = 280,802 を代入する

\[\widehat{voteshare}\ = 38.7 + (0.068 + 0.00000175*280802)exppv - 0.00000536*280802\\ - 0.28age - 4.9nocand + 3previous\\ = 37.2 + 0.56exppv - 0.28age - 4.9nocand + 3previous\]

• 有権者数が平均より標準偏差一つ分少ない場合の回帰式が求められた

有権者が多い場合

• eligible = 408,598 を代入する

\[\widehat{voteshare}\ = 38.7 + (0.068 + 0.00000175*408598) exppv - 0.00000536*408598\\ - 0.28age - 4.9nocand + 3previous \\ = 36.5 + 0.78exppv - 0.32age - 4.75nocand + 3.1previous\]

• 有権者数が平均より標準偏差一つ分少ない場合の回帰式が求められた
  
• 上で求めた 2 つの回帰式と回帰直線を散布図に描く

plot4_1 <- ggplot(df1, aes(x = exppv, y = voteshare)) +
  geom_point(pch = 16, color = "white") +
  geom_abline(intercept = 37.2, slope = 0.56, linetype = "dashed", color = "red") +
  geom_abline(intercept = 36.3, slope = 0.78, color = "darkgreen") +
  ylim(0, 100) +
  labs(x = "選挙費用（有権者一人当たり：円）", y = "得票率 (%)") +
  geom_text(label = "得票率 = 37.2 + 0.56選挙費用 - 0.28年齢 \n- 4.9候補者数 = 3当選回数\n(有権者数 = 280,802)",
            x = 68, y = 50, family = "HiraginoSans-W3", color = "red") +
  geom_text(label = "得票率 = 36.5 + 0.78選挙費用- 0.32年齢 \n- 4.75候補者数 + 3当選回数\n(有権者数 = 408,598)",
            x = 40, y = 90, family = "HiraginoSans-W3", color = "darkgreen") +
  theme_bw(base_family = "HiraKakuProN-W3")

plot4_1

• どちらの散布図も右上がりの回帰直線
  → 有権者一人当たりの選挙費用が増えると、得票率が上がる傾向
  
• 2 つの回帰直線の傾きの大きさが異なる
  → 選挙費用が得票率に与える影響の大きさは有権者数に応じて変わる
  
• 有権者数が少ない選挙区において候補者が有権者一人あたり 1 円選挙費用を増やすと得票率が 0.56 %ポイント増え
  
• 有権者数が多い選挙区において候補者が 1 円選挙費用を増やすと得票率が 0.78 %ポイント増える

2.3.2 msm パッケージによる可視化

• 前節では2つの有権者数それぞれの限界効果を示したが、統計的な有意性は不明
  
• 2 本の回帰直線の傾きの違いは、統計的にも意味のある違いなのだろうか？
  
• 交差項の効果は偶然得られたものではないのか（= 統計的に有意なのか）？
  
• model_2 で得られた切片 (Intercept) と切片と 6 つの変数の偏回帰係数とを表示する

model_2$coef

   (Intercept)          exppv       eligible            age         nocand 
  3.868030e+01   6.816809e-02   5.359147e-06  -2.767864e-01  -4.880537e+00 
      previous exppv:eligible 
  2.959739e+00   1.746856e-06 

• moderator 変数 (eligible) の最小値と最大値を確かめる

summary(df1$eligible)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
 214235  297385  347866  344654  397210  465181 

• moderator 変数 (eligible) の最小値 (214,235) と最大値 (465,181) の間に 50,000 間隔で 6 つの値を指定して、elibible それぞれの値における限界効果 (slope)を表示
  
• 限界効果を計算するに必要な係数 (2 番目の exppvと 7 番目の exppv:eligible)を指定する

at.eligible <- seq(214235, 465181, 50000) # mini - max まで 50000間隔で区切る
slopes <- model_2$coef[2] + model_2$coef[7]*at.eligible　
                    # exppv の傾きの限界効果 (slopes) を計算する  
                    # [2] は 2 番目の係数、[7] は 7 番目の係数という意味
slopes　            # 結果を表示する  

[1] 0.4424058 0.5297486 0.6170914 0.7044342 0.7917770 0.8791197

• delta method を使ってこれらの 6 つの限界効果 (= slopes) と標準誤差 (standard error)を推定
  
• delta method を使うためにmsmパッケージをロードする

library(msm)

• eligible の規模ごとに得られた 6 つの限界効果 (sloples) とその標準誤差を計算し、図で表す
  
• 95% 信頼区間 (upper, lower) を表示

estmean <- coef(model_2)
var <- vcov(model_2)

SEs <- rep(NA, length(at.eligible))

for (i in 1:length(at.eligible)){
    j <- at.eligible[i]
    SEs[i] <- deltamethod (~ (x2) + (x7)*j, estmean, var)　# slopes の 標準誤差
}                                                      

upper <- slopes + 1.96*SEs
lower <- slopes - 1.96*SEs

cbind(at.eligible, slopes, upper, lower) 

     at.eligible    slopes     upper     lower
[1,]      214235 0.4424058 0.5161656 0.3686459
[2,]      264235 0.5297486 0.5833989 0.4760982
[3,]      314235 0.6170914 0.6625833 0.5715994
[4,]      364235 0.7044342 0.7593341 0.6495342
[5,]      414235 0.7917770 0.8673534 0.7162005
[6,]      464235 0.8791197 0.9799311 0.7783084

• アウトプットの解説

• at.eligible は有権者数を mini (214,235人) から max (465,235人)まで 50,000人ずつ増やした場合の有権者数
  
• slopes は 6 つの有権者数それぞれの場合において、exppv が voteshare に及ぼす限界効果の大きさ（＝傾き）
  
• [2, ] と slopes に囲まれた値 (0.4855212)
  →　有権者数 (eligible) が 264,235人の時に、説明変数 (exppv) が応答変数 (voteshare) に与える限界効果（回帰線の傾き）
  
• [3, ] と slopes に囲まれた値 (0.5637078)
  →　有権者数 (eligible) が 314,235人の時に、説明変数 (exppv) が応答変数 (voteshare) に与える限界効果（回帰線の傾き）
  
• upper と lower は95% 信頼区間
  
• グラフを描くために上の行列をデータフレームに変換し msm_1 という名前を付ける

msm <- cbind(at.eligible, slopes, upper, lower) %>% 
  as.data.frame()

msm

  at.eligible    slopes     upper     lower
1      214235 0.4424058 0.5161656 0.3686459
2      264235 0.5297486 0.5833989 0.4760982
3      314235 0.6170914 0.6625833 0.5715994
4      364235 0.7044342 0.7593341 0.6495342
5      414235 0.7917770 0.8673534 0.7162005
6      464235 0.8791197 0.9799311 0.7783084

• eligible を x 軸、exppv が voteshare に与える影響力 (slopes) を y 軸にグラフを描く

msm <- msm %>% 
  ggplot(aes(x = at.eligible, 
             y = slopes,
             ymin = lower,
             ymax = upper)) +
  geom_hline(yintercept = 0, linetype = 2) +
  geom_ribbon(alpha = 0.5, fill = "gray") +
  geom_line() +
  labs(x = "有権者数", 
     y = "選挙費用が得票率に与える影響（限界効果）") +
  ggtitle('model 1 の限界効果') +
  ylim(0, 1.5) +
  theme_bw(base_family = "HiraKakuProN-W3")

msm

結論 有権者数が増えるにつれて、選挙費用が得票率に与える影響（＝限界効果）が大きくなる（統計的に有意）

✔ 「2.3.1 特定の 2 つの調整変数値による可視化」で求めた結果を上の図の中で確認してみる

• 有権者数が少ない場合 (280,802) の傾きが 0.56、有権者数が多い場合 (408,558) の傾きが 0.78であることを確認
  
• 有権者数が平均値の場合 (344,654)の傾きが 0.67 であることを確認（中心化したモデル 3 における expp_c の係数: 0.670）

plot4_1

2.3.3 限界効果：統計的有意性の判断基準

• 交差項を含まない重回帰分析の場合:
  → それぞれの変数の係数が限界効果

• 交差項を含む重回帰分析の場合:
  

• それぞれの有権者数における選挙費用の限界効果（marginal effect)

• 限界効果は、説明変数 1 単位の増加が応答変数を何単位増加させるかを示す

• 主な説明変数が応答変数に与える影響が統計的に有意かどうかの判断基準
  → 限界効果は調整変数の値によって変化する
  → 調整変数の値に応じた限界効果を示す必要がある
  

• 図中の95% 信頼区間を見ると、有権者数によって標準誤差（信頼区間）の幅が異なる
  ← 限界効果の標準誤差が、調整変数である有権者数の値に応じて変わるため
  → 調整変数の値によって標準誤差（信頼区間）が変化する様子も示す必要がある
  

• ここで取り上げた事例では、観察された有権者数の範囲で95%信頼区間の範囲が 0 の横軸（点線）より上にある
  → 選挙費用が得票率に与える影響は、有権者数にかかわらず統計的に有意
  (95%信頼区間の範囲が 0 の横軸（点線）より下にある時も統計的に有意)

msm

• 下図のように、主な説明変数が応答変数に与える影響（限界効果）の符号が、調整変数の値によってマイナスからプラスに変わりうる
  
• 調整変数の値が -1.5 くらいより小さければ限界効果の値はマイナス、それより大きければ限界効果の値はプラス

• 上図に示されているように、交差項を含む回帰分析では、主な説明変数の効果が調整変数の値によって変わるだけでなく、統計的に有意な範囲と有意でない範囲の両方をもつことがあり得る
  
• 調整変数の値が -2 より小さい、もしくは -1 より大きければ統計的に有意
  
• 調整変数の値が -2 と -1 の間では統計的に有意ではない
  
• 調整変数がどの範囲の値をとると限界効果が統計的に有意になるかどうかを、回帰分析の係数の推定値を見ただけで判断することは非常に難しい
  → 限界効果を図示してはじめて、限界効果がどの範囲でどのような符号をもつか、どの範囲で統計的に有意かが明らかになる
  → 交差項を使うときは、回帰分析結果の表を示すだけでは不十分であり、限界効果を信頼区間付きで図示することが必須である

2.3.4 interplot パッケージによる可視化

• interplot::interplot()関数を使う
  
• 交差項を含む回帰モデル（引数 m で指定）、交差項のうち主な説明変数（var1）、調整変数（var2）を指定

library("interplot")

interplot_1 <- interplot(m = model_2, 
          var1 = "exppv", 
          var2 = "eligible") +
labs(x = "有権者数", 
     y = "選挙費用が得票率に与える影響") +
  ggtitle('model 1 の限界効果') +
  geom_hline(yintercept = 0, linetype = 2) +
  ylim(0, 1.6) +
  theme_bw(base_family = "HiraKakuProN-W3")

interplot_1

2.3.5 marginsパッケージによる可視化

library("margins")

margins_1 <- cplot(model_2,         # 推定するモデルを指定
                   x = "eligible",  # 調整変数を指定
                   dx = "exppv", 　 # 主要な説明を指定
                   what = "effect", # 限界効果の計算を指定  
                   n = 6,           # eligible を分類する数を指定
                   draw = FALSE)    # グラフを表示しない指定
margins_1

       xvals  yvals  upper  lower factor
 214235.0000 0.4424 0.5162 0.3686  exppv
 264424.2000 0.5301 0.5837 0.4765  exppv
 314613.4000 0.6178 0.6632 0.5723  exppv
 364802.6000 0.7054 0.7605 0.6503  exppv
 414991.8000 0.7931 0.8690 0.7172  exppv
 465181.0000 0.8808 0.9821 0.7795  exppv

margins_1 <- margins_1  %>% 
  ggplot(aes(x = xvals, y = yvals, ymin = lower, ymax = upper)) +
  geom_hline(yintercept = 0, linetype = 2) +
  geom_ribbon(alpha = 0.5, fill = "gray") +
  geom_line() +
  labs(x = "有権者数", 
     y = "選挙費用が得票率に与える影響") +
  ggtitle('model 1 の限界効果') +
  ylim(0, 1.5) +
  theme_bw(base_family = "HiraKakuProN-W3")

margins_1  

3. 説明変数を中心化したモデル (model_3)

3.1 なぜ説明変数を中心化する必要があるのか？

★交差項を含まない重回帰分析の場合:

• 特定の説明変数 X の係数 b は、他の説明変数の値を一定に保ったとき、X が 1 単位増加すると、応答変数 Y の予測値が b 単位 だけ増えること示す

★交差項を含む重回帰分析の場合:

• この考え方をそのまま使うことはできない
  
• その理由 - - - 「他の変数の値を一定に保つ」ことができないから

解説：

• ここで想定している model_2 に含まれる説明変数は次の 4 つ：
  

1. 選挙費用 (X)
   
2. 自民党ダミー (Z)
   
3. 選挙費用:自民党ダミー (XZ)
   
4. 立候補者数 (Y)

• 知りたいこと - - - 選挙費用 (X) 1 単位（= 1 円）の増加が、得票率に与える影響
  
• 他の変数（すなわち Z と XZ の値）を一定に保ったまま、X の値だけを変えることは不可能
  → その理由：X の値を変えると、XZ の値も変わってしまうから
  
• それができるのは、Z = 0 （つまり候補者が非自民党候補者）のときだけ
  
• 回帰分析（model_2）の結果として得られた選挙費用の係数 0.072
  → 有権者数が 0 のときに選挙費用が得票率に与える影響
  しかし、そのような選挙区は存在しない
  → 回帰分析の結果として表示されている係数そのものにはまったく意味がない

解決策 → 説明変数を中心化する

3.2 中心化とデータの準備

• 中心化 (centering) は、各変数の値からその変数の平均値を引くことによって行う
  
• 平均値を引くというのは一次関数で表すことができる → 中心化は線形変換の一種
  
• 説明変数を中心化することでわかること:
  → 有権者数が平均値の時に、選挙費用が得票率に与える影響
  → 交差項を含むモデルで意味のある係数の値を得ることができる
  
• 前節で作った df1 の記述統計を確認する

library(stargazer)

stargazer(as.data.frame(df1), type = "html")

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

• 5 つの説明変数 (exppv, eligible, age, nocand, previous) を中心化して、5 つの新たな説明変数を作り、df2 というデータフレーム名をつける

変数名		中心化後の変数名
exppv	→	exppv_c
eligible	→	eligible_c
age	→	age_c
nocand	→	nocand_c
previous	→	previous_c

df2 <- df1 %>%
  mutate(exppv_c = exppv - mean(exppv, na.rm = TRUE),
         eligible_c = eligible - mean(eligible),
         age_c = age - mean(age),
         nocand_c = nocand - mean(nocand),
         previous_c = previous - mean(previous))

• 新たに加えた変数を確認する

stargazer(as.data.frame(df2),
          type = "html",
          digits = 2)

Statistic	N	Mean	St. Dev.	Min	Max
kun	989	5.56	4.92	1	25
age	989	50.29	10.87	25	81
rank	989	2.22	1.04	1	6
previous	989	1.55	2.41	0	15
voteshare	989	30.33	19.23	0.60	73.60
eligible	989	344,654.30	63,898.23	214,235	465,181
exppv	985	24.63	17.91	0.15	89.33
nocand	989	3.43	0.74	2	6
exppv_c	985	-0.00	17.91	-24.48	64.70
eligible_c	989	-0.00	63,898.23	-130,419.30	120,526.70
age_c	989	-0.00	10.87	-25.29	30.71
nocand_c	989	-0.00	0.74	-1.43	2.57
previous_c	989	0.00	2.41	-1.55	13.45

• 交差項exppv_c:eligible_c は 主要な説明変数(exppv_c) と調整変数 (eligible_c) を掛け合わせて作る
  
• モデル内でexppv_c*eligible_cと入力するとexppv_c:eligible_cという交差項名が作成されると同時にexppv_c, eligible_cという2 つの変数も自動的にモデルに含まれる
  
• 下図は説明変数に中心化を施した重回帰分析 (model 2) である

3.3 model_3 の分析結果

• モデル内でexppv_c*eligible_cと入力するとexppv_c:eligible_cという交差項名が自動的に付されexppv_c, eligible_cという2 つの変数も自動的に含まれる　　

model_3 <- lm(voteshare ~ exppv_c * eligible_c +
                age_c +
                nocand_c +
                previous_c,
              data = df2)
tidy(model_3)

# A tibble: 7 × 5
  term                  estimate   std.error statistic   p.value
  <chr>                    <dbl>       <dbl>     <dbl>     <dbl>
1 (Intercept)        30.9        0.357           86.7  0        
2 exppv_c             0.670      0.0252          26.6  7.22e-118
3 eligible_c          0.0000484  0.00000570       8.48 8.01e- 17
4 age_c              -0.277      0.0355          -7.81 1.50e- 14
5 nocand_c           -4.88       0.470          -10.4  4.86e- 24
6 previous_c          2.96       0.184           16.1  5.28e- 52
7 exppv_c:eligible_c  0.00000175 0.000000302      5.78 9.93e-  9

model 2 の分析結果の解釈 - 交差項 (exppv_c:eligible_c)が統計的に有意 (係数: 1.564e-06, p 値: 8.82e-08)
→「選挙費用が得票率に与える影響は、有権者数によって異なる」
- 選挙費用 (exppv_c)の係数が統計的に有意 (係数: 6.113e-01, p 値: 2e-16)
→選挙費用 (exppv_c)を一円費やすと、得票率が約 0.61%ポイント増える
→これは有権者数（eligible_c）が平均値の時の結果
注意：有権者数（eligible）= 0 の時の結果 (model 1)- - - 0.07233%ポイント増える

4. model_2 と model_3 の分析結果まとめ

• 説明変数を中心化する前の分析結果 (model_2) と中心化した後の分析結果 (model_3) の一部を可視化して比較すると次のようになる

• 説明変数を中心化する前の分析結果 (model_2)

tidy(model_2)

# A tibble: 7 × 5
  term              estimate   std.error statistic  p.value
  <chr>                <dbl>       <dbl>     <dbl>    <dbl>
1 (Intercept)    38.7        3.95            9.80  1.12e-21
2 exppv           0.0682     0.0972          0.702 4.83e- 1
3 eligible        0.00000536 0.00000914      0.586 5.58e- 1
4 age            -0.277      0.0355         -7.81  1.50e-14
5 nocand         -4.88       0.470         -10.4   4.86e-24
6 previous        2.96       0.184          16.1   5.28e-52
7 exppv:eligible  0.00000175 0.000000302     5.78  9.93e- 9

• 説明変数を中心化した後の分析結果 (model_3)

tidy(model_3)

# A tibble: 7 × 5
  term                  estimate   std.error statistic   p.value
  <chr>                    <dbl>       <dbl>     <dbl>     <dbl>
1 (Intercept)        30.9        0.357           86.7  0        
2 exppv_c             0.670      0.0252          26.6  7.22e-118
3 eligible_c          0.0000484  0.00000570       8.48 8.01e- 17
4 age_c              -0.277      0.0355          -7.81 1.50e- 14
5 nocand_c           -4.88       0.470          -10.4  4.86e- 24
6 previous_c          2.96       0.184           16.1  5.28e- 52
7 exppv_c:eligible_c  0.00000175 0.000000302      5.78 9.93e-  9

✔説明変数を中心化する前の分析結果 (model_2) は水色
✔説明変数を中心化した後の分析結果 (model_3) は赤色

• 交差項の効果は同じ:
  exppv:eligible の係数 = 0.00000175
exppv_c:eligible_c の係数 = 0.00000175
  

• 交差項はどちらも統計的に有意 (p 値 = 9.93e- 9)
  

• しかし exppv と exppv_c の係数の意味は異なる
  

• exppv の係数: 0.0682が意味すること
  → 有権者 = 0 の時に選挙費用が得票率に与える影響・・・ 統計的に有意ではない (p 値= 0.483)
  → 有権者 = 0 はあり得ないので当然の結果

• exppv_c の係数: 0.670が意味すること
  → 有権者数 = 平均値の時に選挙費用が得票率に与える影響・・・ 統計的に有意 (p値 = 7.22e-118)
  

• しかしこの結果は、有権者数が平均値の場合についてしかあてはまらない
  

• 有権者数が他の現実的な値をとる時に、選挙費用が得票率に与える影響力を確認する必要あり
  

• その方法　→ 限界効果 (marginal effect) を可視化して確かめる
  

  限界効果：説明変数が（特定の値において）応答変数に与える影響力の強さ

msm

結論 ・選挙費用が得票率に与える影響（＝限界効果）は、有権者数が増えるほど大きい
・例えば、有権者数が平均値 (344,654人) の場合、候補者が有権者一人あたりに選挙費用を 1 円費やすと、得票率が約0.670%ポイント増える
・上の結果はいずれも統計的に有意

5. Exercise

• 「選挙費用が得票率に与える影響は、当選回数の多寡と関係があるのかどうか」を調べたい
  
• ここで使うデータは1996年から2021年に実施された総選挙結果: hr96-21.csv
  
• このデータセットには次の 25 個の変数が入っている

変数名	詳細
1. year	選挙年 (1996-2017)
2. pref	都道府県名
3. ku	小選挙区名
4. kun	小選挙区
5. mag	選挙区定数（小選挙区では全て 1）
6. rank	当選順位
7. nocand	立候補者数
8. seito	候補者の所属政党
9. j_name	候補者の氏名（日本語）
10. name	候補者の氏名（ローマ字）
11. previous	当選回数
12. gender	立候補者の性別: “male”, “female”
13. age	立候補者の年齢
14. wl	選挙の当落: 1 = 小選挙区当選、2 = 復活当選、0 = 落選
15. wlsmd	選挙の当落: 1 = 当選（小選挙区）、0 = 落選（小選挙区）
16. exp	立候補者が使った選挙費用（総務省届け出）
17. status	候補者のステータス: 0 = 非現職、1 現職、2 = 元職
18. vote	得票数
19. voteshare	得票率 (%)
20. eligible	小選挙区の有権者数
21. turnout	小選挙区の投票率 (%)
22. castvote	小選挙区で投じられた総票数
23. seshu_dummy	世襲候補者ダミー: 1 = 世襲、0 = 非世襲（地盤世襲 or 非世襲）
24. jiban_seshu	地盤の受け継ぎ元の政治家の氏名と関係
25. nojiban_seshu	世襲元の政治家の氏名と関係

• のデータセットから 2012年のデータと次の 5 つの変数を抜き出して分析しなさい

変数名	詳細
voteshare	得票率 (%)
exppv	有権者一人当たりに候補者が費やした選挙費用 (yen)
previous	候補者の当選回数
age	候補者の年齢
nocand	立候補者数

注意：exppv という変数はデータセット内には含まれていないので、exp と eligible 2 つの変数を使って各自作成すること

Q1: 上記の変数に関する記述統計を表示させなさい
Q2 選挙費用と得票率の散布図を表示し、簡単にコメントしなさい
Q3 当選回数と得票率の散布図を表示し、簡単にコメントしなさい
Q4 衆議院選挙において「選挙費用が得票率に与える影響は、当選回数の多寡と関係があるのかどうか」に関するあなたの仮説を述べなさい。また、そう考える理由を簡単に述べなさい
Q5 次の2つの重回帰分析の結果を stargazer パッケージを使って表示しなさい。

model_5 <- lm(voteshare ~ exppv*previous + age + nocand,
              data = df3)

model_6 <- lm(voteshare ~ exppv + previous + age + nocand,
              data = df3)

Q6 interplot パッケージを使って選挙費用が得票率に与える影響力を明示し、結果をわかりやすいグラフで表示し、分析結果を述べなさい

参考文献

• 総選挙のマップ作成は遠藤勇哉氏（東北大学大学院情報科学研究科博士後期課程）の助言に基づいている
• 宋財泫 (Jaehyun Song)・矢内勇生 (Yuki Yanai)「私たちのR: ベストプラクティスの探究」
• 土井翔平（北海道大学公共政策大学院）「Rで計量政治学入門」
• 矢内勇生（高知工科大学）授業一覧
• 浅野正彦, 矢内勇生.『Rによる計量政治学』オーム社、2018年
• 浅野正彦, 中村公亮.『初めてのRStudio』オーム社、2018年
• Winston Chang, R Graphics Cookbook, O’Reilly Media, 2012.
• Kieran Healy, DATA VISUALIZATION, Princeton, 2019
• Kosuke Imai, Quantitative Social Science: An Introduction, Princeton University Press, 2017