• このセクションで使う R パッケージ一覧
library(tidyverse)
library(stargazer)

1. 平均への回帰

平均への回帰(Regression towards the mean) の定義：

  • 一回目に平均から離れた値が得られると、二回目にはその平均に近い値が得られる傾向があるという現象

1.1 事例①: 両親と息子の身長 (Galton, 1886)

  • イギリスの学者である Sir Francis Galton が主張
  • 「両親の平均身長」と「成人後の子供の平均身長」を比較
  • 特別に高身長の両親でも、特別に低身長の両親でも、息子たちの身長は両親たちの身長より平均に近くなる

  • もし両親と子供の身長が全く同じなら
    →　図の（比例する場合）のように 45度線が引かれる
  • しかし、現実には緑色のような関係
    →　背の低い両親には、背の低い子供が生まれる傾向があり
    →　背の高い両親には、背の高い子供が生まれる傾向がある

1.2 事例②: 前期試験結果と後期試験結果

  • 前期試験で特別に高得点だった学生は、後期試験でも得点が高いはず
  • しかし、一般に前期試験で特別に高得点だった学生は、期末試験では中間試験の時よりも平均に近い（＝平均からの偏差がより小さい）結果になる
  • 前期試験で特別に悪い成績だった学生は、後期試験でも得点が悪いはず
  • しかし、一般に前期試験で特別に悪い成績だった学生は、期末試験では中間試験の時よりも平均に近い（＝平均からの偏差がより小さい）結果になる
  • その理由
    →中間試験で働いた「幸運」（偶然）や「不運」（偶然）が、期末試験では必ずしも起こらなかったから
  • この傾向は、偶然のみによって説明できる

2. 衆院選データで「平均への回帰」を確認

  • Q: 2014年の総選挙で苦戦した候補者は、2017年で善戦する？

  • Q: 2014年の総選挙で善戦した候補者は、2017年の選挙で苦戦する？

  • ここでは議論をわかりやすくするため、同一の候補者が（2014年総選挙と比較して） 2017年総選挙でより高い得票率を得た場合を「善戦」、そうでない場合を「苦戦」と定義

  • 2014年と 2017年の総選挙のデータを使う

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

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

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

download.file(url = "http://www.ner.takushoku-u.ac.jp/masano/class_material/waseda/keiryo/Data/hr96-21.csv",
              destfile = "data/hr96-21.csv")
  • dataフォルダ内から read_csv で読み取る
df <- read.csv("data/hr96-21.csv", # 欠損処理をしているので read.csv であることに注意
               na = ".")           # 欠損処理をしなければ read_csv

(2) 選挙データの読み取り方法 (2)
- hr96-21.csv をダウンロードして RProject フォルダ 内の data フォルダに入れる
- dataフォルダ内から read_csv で読み取る

df <- read.csv("data/hr96-21.csv", # 欠損処理をしているので read.csv であることに注意
               na = ".")　         # 欠損処理をしなければ read_csv

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

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

names(df)
 [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"
  • df には 24 個の変数が入っている
変数名 詳細
year 選挙年 (1996-2021)
pref 都道府県名
ku 小選挙区名
kun 小選挙区
mag 選挙区定数（小選挙区では全て 1）
rank 当選順位
nocand 立候補者数
seito 候補者の所属政党
j_name 候補者の氏名（日本語）
name 候補者の氏名（ローマ字）
previous 当選回数
gender 立候補者の性別: “male”, “female”
age 立候補者の年齢
wl 選挙の当落: 1 = 小選挙区当選、2 = 復活当選、0 = 落選
wlsmd 選挙の当落: 1 = 当選（小選挙区）、0 = 落選（小選挙区）
exp 立候補者が使った選挙費用（総務省届け出）
status 候補者のステータス: 0 = 非現職、1 現職、2 = 元職
vote 得票数
voteshare 得票率 (%)
eligible 小選挙区の有権者数
turnout 小選挙区の投票率 (%)
castvote 小選挙区で投じられた総票数
seshu_dummy 世襲候補者ダミー: 1 = 世襲、0 = 非世襲（地盤世襲 or 非世襲）
jiban_seshu 地盤の受け継ぎ元の政治家の氏名と関係
nojiban_seshu 世襲元の政治家の氏名と関係
  • 分析に必要な変数だけに絞る
df1 <- df %>%　
  dplyr::filter(year == 2014 | year == 2017) %>%　# 2014年と2017年のデータだけを選ぶ
  dplyr::select(year, seito, j_name, voteshare) # 4 つの変数だけを選ぶ
  • df1 に含まれる変数を確認する
names(df1)
[1] "year"      "seito"     "j_name"    "voteshare"
  • 2014年と2017年総選挙データをそれぞれ抜き出す
df14 <- df1 %>% 
  filter(year == 2014)

df17 <- df1 %>% 
  filter(year == 2017)
  • データの記述統計を示す
library(stargazer)
stargazer(as.data.frame(df14), 
          type = "html")
Statistic N Mean St. Dev. Min Max
year 959 2,014.000 0.000 2,014 2,014
voteshare 959 30.767 18.908 0.500 83.300 
stargazer(as.data.frame(df17), 
          type = "html")
Statistic N Mean St. Dev. Min Max
year 936 2,017.000 0.000 2,017 2,017
voteshare 936 30.876 19.046 0.450 85.720
  • 2014年衆院選データの観測数は 959、 2017年衆院選データの観測数は 936

2.2 データのマージと標準化

データのマージ

  • 共通の変数 “name” と “seito” を手がかりに df14 と df17 を merge する
df2 <- merge(df14, df17,
            by = c("j_name", "seito")) # j_name と seito が同じ人のデータを統合
  • 統合したデータの初めを表示
head(df2)　　#マージしたデータの初めの6行
      j_name seito year.x voteshare.x year.y voteshare.y
1   一色一正  共産   2014         6.5   2017        8.22
2 三ツ林裕巳  自民   2014        47.6   2017       47.53
3 三ツ矢憲生  自民   2014        54.4   2017       54.04
4   三原朝彦  自民   2014        47.2   2017       45.71
5   上川陽子  自民   2014        44.9   2017       46.88
6 上杉謙太郎  自民   2014        31.2   2017       36.56

  • df14 と df17 の両方に共通した名前の変数 voteshare が消え、voteshare.x と voteshare.y の 2 つの新たな変数が作成

  • voteshare.xが 2014年総選挙の得票率、voteshare.y が2017年の得票率

  • 統合したデータのサマリーを表示

stargazer(df2,
          type = "html")
Statistic N Mean St. Dev. Min Max
year.x 357 2,014.000 0.000 2,014 2,014
voteshare.x 357 42.273 19.167 3.000 83.300
year.y 357 2,017.000 0.000 2,017 2,017
voteshare.y 357 41.620 18.309 4.110 85.720

「標準化得票率」の作成

  • 2014年総選挙において候補者が得た得票率（標準化得票率ではない）のヒストグラムを描いてみる
hist(df2$voteshare.x)

  • 記述統計量は次のとおりである
summary(df2$voteshare.x)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   3.00   29.60   45.70   42.27   53.80   83.30
  • ここでは選挙での候補者のパフォーマンスをより正確に測定するため、2 つの総選挙において候補者が得た得票率 (voteshare.x と voteshare.y)を標準化した z-score を計算する
  • 2014年と2017年総選挙それぞれで候補者が得た得票率の z 得点 (z-score) を計算し標準化を行う
    標準化の計算方法： それぞれの総選挙において立候補者が得た得票率から総選挙ごとの得票率の平均を引いた値を得票率の標準偏差で割る
    標準化することの利点：
    →　2 つの異なる総選挙における得票結果を、選挙ごとの平均的な結果と比較して測定できる
  • 標準化は scale() 関数を使ってできる
df2$vs14.z <- scale(df2$voteshare.x)  # 変数名を変更
df2$vs17.z <- scale(df2$voteshare.y)　# 変数名を変更
names(df2)
[1] "j_name"      "seito"       "year.x"      "voteshare.x" "year.y"     
[6] "voteshare.y" "vs14.z"      "vs17.z"
  • vs14.z と vs17.z という 2 つの変数（標準化得票率）が新たに追加された
変数名 詳細 範囲
vs14.z : 候補者の 2014年衆院選での「善戦度」を表す -4 ~ 4
vs17.z : 候補者の 2017年衆院選での「善戦度」を表す -4 ~ 4
  • 必要な変数だけに絞り込む
df2 <- df2 %>% 
  select(j_name, vs14.z, vs17.z)
DT::datatable(df2)

  • これで分析に必要なデータフレーム (df2) がそろった

  • ここで作成したデータを使って、2014年と2017年の総選挙において平均への回帰が実際に見られるかどうか調べる

  • 2014年総選挙の標準化得票率の記述統計量とヒストグラムを表示させる

summary(df2$vs14.z)
       V1         
 Min.   :-2.0490  
 1st Qu.:-0.6612  
 Median : 0.1788  
 Mean   : 0.0000  
 3rd Qu.: 0.6014  
 Max.   : 2.1405  
hist(df2$vs14.z)

  • 標準化得票率の平均値が０で、左右に分布していることがわかる
  • 必要な変数だけを残し、変数名を変更

2.3 得票率の分布（2014年 & 2017年総選挙）

df2_long <- df2 %>% 
  tidyr::pivot_longer("vs14.z":"vs17.z",      # 変換したい変数の範囲を指定  
                      names_to = "year",      #ワイドの「変数名」を year の中に入れる
                      values_to = "vs.z") %>% #ワイドの「変数の値」を vs.z の中に入れる
  drop_na()                                   # 欠損値 (na) を省く  
df2_long$year <- as.factor(df2_long$year)
DT::datatable(df2_long)
df2_long %>%
  dplyr::filter(!is.na(vs.z)) %>%                 # 欠損処理 
  ggplot(aes(x = vs.z, 　　　　　　　　　  # x は voteshare と指定
             y = ..density..)) +                # y は密度 (..density..)と指定
  geom_histogram(aes(fill = year),              # fill で新たな次元を指定
                 color = "white",               # 棒の枠線の色を指定 
                 alpha = 0.5,                   # 棒の透明度を指定 
                 position = "identity",         # 縦軸のラベルを「密度」に変更
                 boundary = 0) +                # 棒がデータの範囲を超えない設定
  geom_density(aes(color = year),               # 衆院選挙の実施年別に異なる色を付ける
               size = 1,               　　　   #  線の太さは 1
               show.legend = FALSE) +           # 凡例には表示させない  
  labs(x = "標準化得票率", 
       y = "候補者数（密度）", fill = "衆院選の年") +
  ggtitle("標準化得票率の分布（2014年 & 2017年総選挙）") +
  theme_bw(base_family = "HiraKakuProN-W3")

  • 2014年と2017年総選挙における標準化得票率の分布を可視化してみると、両者ともさほど大きな違いはない

2.4 「平均の回帰」をチェック

2014年総選挙で「善戦度」下位25パーセンタイルと上位25パーセンタイルの候補者が、2017年総選挙で善戦したか苦戦したかを確かめる

仮説 もし平均への回帰が存在するのなら、2014年総選挙において上位25パーセンタイルの候補者よりも下位25パーセンタイルの候補者の方が、2017年総選挙で善戦している割合が大きいはず

  • 2014年総選挙での標準化得票率を x 軸、2017年総選挙での標準化得票率を y 軸とした散布図を描く
df2 %>% 
  ggplot(aes(vs14.z, vs17.z)) + 
  geom_point() +
  stat_smooth(method = lm, 
              se = FALSE) +
  labs(x = "標準化得票率（2014年総選挙）", y = "標準化得票率（2017年総選挙）")+
  theme_bw(base_family = "HiraKakuProN-W3")

  • 予想どおり、両者の間には強い正の線形関係が認められる

  • 2014年総選挙でより多くの票を得た候補者は、2017年総選挙でもより多くの票を得ている

  • 2017年総選挙における標準化得票率を、2014年総選挙における標準化得票率で 回帰する

fit1 <- lm(vs17.z ~ vs14.z, data = df2)
fit1

Call:
lm(formula = vs17.z ~ vs14.z, data = df2)

Coefficients:
(Intercept)       vs14.z  
  2.921e-16    9.434e-01

注意： ここでは結果変数 (2017年総選挙における標準化得票率を)と予測変数（2014年総選挙における標準化得票率を）の両方を標準化しているので、切片が 0 になっている
→　Intercept の値は 3.958e-17（実質的にゼロ）

  • 2017年の総選挙において、2014年総選挙の時よりも高い標準化得票率を得た立候補者の割合を計算してみる

  • 2014年総選挙で下位25パーセンタイルの得票率だった人々が、2017年総選挙で2014年総選挙の時より高い標準化得票率をとった候補者の割合

mean((df2$vs17.z > df2$vs14.z)
     [df2$vs14.z <= quantile(df2$vs14.z, 0.25)])
[1] 0.5111111
  • 2014年に苦戦した候補者（「善戦度」下位25％）の 約 51% が2017年に善戦した
    →　2014年総選挙で得票率が 25%以下の候補者の中で、2014年より2017年総選挙で高い得票率の候補者が約 50% いた
  • 2014年総選挙で上位25パーセンタイルの得票率だった人々が、2017年総選挙で2014年総選挙の時より低い標準化得票率をとった候補者の割合
    • mean((df2$vs17.z > df2$vs14.z)
     [df2$vs14.z >= quantile(df2$vs14.z, 0.75)])
    [1] 0.3846154
    • 2014年に善戦した候補者（「善戦度」上位25％）の 約 39% が2017年に善戦した
      →　2014年総選挙で得票率が 75パーセンタイル以上の候補者の中で、2014年より2017年総選挙で高い得票率の候補者が約 39% いた

    結果 ・2014年と2017年総選挙のデータを使った分析では、明らかに平均への回帰を裏付けている
    ・2014年総選挙において得票率の下位25パーセンタイルに含まれる立候補者の約 51% が2017年の総選挙では2014年の総選挙より優勢
    ・他方、候補者が優勢だった上位25パーセンタイルの候補者の約 39% しか、前回の総選挙を上回る得票率は得ていない

    2.5 Excercise

    • 2009年と 2012年に実施された二つの「政権交代選挙」データを使って「平均への回帰」現象を確認したい

    • 問題関心は次のとおり
      ①2009年の選挙で苦戦した候補者は、2012年で善戦するのか？
      ②2009年の選挙で善戦した候補者は、2012年の選挙で苦戦するのか？

    • 分析で使うデータセット: hr96-21.csv

    変数名 詳細
    j_name 候補者の氏名
    seito 候補者の所属政党
    voteshare 候補者が得た得票率 (%)

    Question 1: 共通の変数 j_name と seito を手がかりに二つの dataframe を merge し、統合したデータの最初の 6 行を表示しなさい
    Question 2: 選挙での候補者のパフォーマンスをより正確に測定するため、voteshare を標準化し、作成したデータの最初の 6 行を表示しなさい
    Question 3: 2009年の総選挙で「善戦度」（標準得票率）の密度を表すヒストグラムを描きなさい
    Question 4: 次の条件で回帰分析した分析結果（傾きと切片）を示しなさい
    　　　応答変数 ：候補者の 2012年衆院選での標準化得票率 (-4 ~ 4)
    　　　説明変数 ：候補者の 2009年衆院選での標準化得票率 (-4 ~ 4)
    Question 5: 上記の回帰分析の散布図を描きなさい 回帰直線も含めること
    Question 6: 2009年と 2012年に実施された「政権交代選挙」データを使った分析では、平均への回帰が確認されるか？

    参考文献