• 分析に必要なパッケージをロードする
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 選挙費用と自民党ダミーを掛け合わせた変数

交差項を説明変数に加えると、自民党候補者とそうでない候補者の間において、選挙費用が得票率に与える影響を捉えることができる(上の図の右側)

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()
  .. )
 - attr(*, "problems")=<externalptr> 
  • 数値は 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] "N党"                   "国民"                   "れい"                  

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 × 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 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の変数だけを選ぶ
  • df1に含まれる変数を確認する
names(df1)
 [1] "ku"        "kun"       "j_name"    "age"       "rank"      "previous" 
 [7] "voteshare" "eligible"  "exppv"     "nocand"    "ldp"      
  • ldp が作られていることを確認
  • データの最初の 6 行を表示させる
head(df1)
# 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
  • データの記述統計を示す
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
ldp 989 0.293 0.455 0 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 個の観測値が欠損のため削除されました )
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()を使って、見やすく表示できる
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.01

2.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 = 0ldp = 1)における限界効果を示す必要あり

  • データ解析において重要なこと:

  • 統計的有意性 (statistical significance) 限界効果を計算して図示する

  • 実質的有意性 (substantial significance)限界効果を計算して図示する

2.3 交差項を含むモデルで「限界効果」を求める理由

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

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

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

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

解説:

  • ここで想定している model_1 に含まれる説明変数は次の 3 つ:
  1. 選挙費用 (X)
  2. 自民党ダミー (Z)
  3. 選挙費用:自民党ダミー (XZ)
  • 知りたいこと・・・ 選挙費用 (X) 1 単位(= 1 円)の増加が、得票率に与える影響
  • 他の変数(すなわち ZXZ の値)を一定に保ったまま、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.04519911
  • delta 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 種類の候補者それぞれの場合において、exppvvoteshare に及ぼす限界効果の大きさ(=傾き)

  • [1, ] と slopes に囲まれた値 (0.79142440)
    → 非自民党候補者の場合、説明変数 (exppv) が応答変数 (voteshare) に与える限界効果(回帰線の傾き)

  • [2, ] と slopes に囲まれた値[(0.04519911){style=“color:blue”} → 自民党候補者の場合、説明変数 (exppv) が応答変数 (voteshare) に与える限界効果(回帰線の傾き)

  • upperlower は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.03267927
  • ldpx 軸、exppvvoteshare に与える影響力 (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 個の観測値が欠損のため削除されました )
Multiple R-squared:  0.7229,    Adjusted R-squared:  0.7218 
F-statistic: 639.2 on 4 and 980 DF,  p-value: < 2.2e-16

3.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.02082736
  • delta 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 種類の候補者それぞれの場合において、exppvvoteshare に及ぼす限界効果の大きさ(=傾き)

  • [1, ] と slopes に囲まれた値 (0.77014053)
    → 非自民党候補者の場合、説明変数 (exppv) が応答変数 (voteshare) に与える限界効果(回帰線の傾き)

  • [2, ] と slopes に囲まれた値 (0.02082736)
    → 自民党候補者の場合、説明変数 (exppv) が応答変数 (voteshare) に与える限界効果(回帰線の傾き)

  • upperlower は 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.05353247
  • ldpx 軸、exppvvoteshare に与える影響力 (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_1model_2 の限界効果結果を可視化すると
msm_1 + msm_2 + plot_layout(ncol = 2)

  • 基本的にどちらのモデルも同じような結果を得ているが、どちらのモデルを使うべきか?
  • 赤池情報量規準 (AIC: Akaike's Information Criterion) を使って統計モデルの良さを評価してみる
AIC(model_1)
[1] 7457.925
AIC(model_2)
[1] 7363.788
  • model_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 という変数はデータセット内には含まれていないので、expeligible 2 つの変数を使って各自作成すること

Q1: 上記3 つの変数に関する記述統計を表示させなさい
Q2: 選挙費用と得票率の散布図を表示し、簡単にコメントしなさい
Q3: 衆議院選挙において「選挙費用が得票率に与える影響は、民主党候補者とそれ以外の候補者で異なるかどうか」に関するあなたの仮説を述べなさい また、そう考える理由を簡単に述べなさい
Q4: 「選挙費用が得票率に与える影響は、民主党候補者とそれ以外の候補者で異なる」と言えるか? msm パッケージを使って、民主党候補者とそれ以外の候補者それぞれに関して、選挙費用が得票率に与える限界効果を可視化し、その結果をわかりやく説明しなさい

参考文献
  • 宋財泫 (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