このセクションで使う R パッケージ一覧

library(DT)
library(gapminder)
library(gghighlight)
library(ragg)
library(stargazer)
library(tidyverse)

折れ線グラフ

  • 折れ線グラフはある連続変数の時系列的な変化を示す際に使われる
  • 株価の変動であれば、横軸は日付（＝順序変数）、縦軸は株価（＝連続変数）
  • 横軸は順序付きであれば、年月日のような「離散変数」でも「連続変数」でも OK

横軸のデータに関する注意点：

  • 横軸上の値はグループ内において 1 回だけ登場する
  • 例）総選挙が実施された年・・・「1996」はデータでは 1 回だけしか登場しない

1. 折れ線グラフ

  • 折れ線グラフで注目すべきなのは「線」でなくて「点」
  • 「点」が表すのは「線の傾きが変化していること」だから　　
  • 折れ線グラフとは「線の傾きが変わり得る点を線で繋いだグラフ」

1.1 データの準備

  • ここでは ggplot() を使って国ごとの平均寿命の推移を描いてみる
  • そのためにデータを準備する

gapminder

・gapminder とは R に組み込まれているデータセット
・gapminder に含まれる変数は次のとおり：

(1) year : 1952-2007 (every 5 years)
(2) lifeExp : 平均寿命
(3) country : 国名
(4) continent : 大陸名
(5) pop : 人口
(6) gdpPercap : 一人当たりGDP
  • gapminder をロードする
library(gapminder)
  • DT::datatable()関数を使って、データの様子を確かめる
DT::datatable(gapminder)

・gapminder の記述統計を表示させる

stargazer(as.data.frame(gapminder),
          type = "html")
Statistic N Mean St. Dev. Min Max
year 1,704 1,979.500 17.265 1,952 2,007
lifeExp 1,704 59.474 12.917 23.599 82.603
pop 1,704 29,601,212.000 106,157,897.000 60,011 1,318,683,096
gdpPercap 1,704 7,215.327 9,857.455 241.166 113,523.100

1.2 平均寿命の折れ線グラフ（日本人）

  • 折れ線グラフを描くために使う幾何オブジェクトは ggplot() と geom_point()
幾何オブジェクト 意味
ggplot() 図を描くキャンバスを用意する
geom_line() 折れ線グラフを描く

・このグラフを描くために必要な変数は次の 3 つ

(1) year : 1952-2007 (every 5 years)
(2) lifeExp : 平均寿命
(3) country : 国名
  • gapminer には複数の国が含まれている
  • filter(country == "Japan") と指定して日本のみを抽出　→　ggplot() 関数に渡す
  • 幾何オブジェクトは geom_line()、マッピングは x と y に対して行う
Japan <- gapminder %>% 
  dplyr::filter(country == "Japan") %>% 
  dplyr::select(year, lifeExp) %>% # year と lifeExp だけを抜き出す
  ggplot() +
   geom_line(aes(x = year, 
                 y = lifeExp)) +
   labs(x = "西暦", y = "平均寿命") +
  ggtitle("平均寿命の推移（日本）") +
  theme_bw(base_family = "HiraKakuProN-W3")

Japan

1.3 平均寿命の折れ線グラフ（日本・韓国・北朝鮮）

  • 次に、グラフに線を 2 以上表示させてみよう

  • aes() の中に group 引数を追加する

  • 一本一本の線が国を意味するので、ここでは group = country を加える

  • ここでは日本に限定せず、gapminder が含む全ての国かの中から韓国と韓国を折れ線グラフに表示させてみる

  • まず、gapminder の変数 country を日本語にリコーディングする
    →　要素の順番は日本、韓国、韓国とする

  • gapminder から日本、韓国、韓国のデータだけを抜き出し df1 と名前を付ける

df1 <- gapminder %>% 
  filter(country == "Japan" | country == "Korea, Rep."| country == "Korea, Dem. Rep.")
df1 <- df1 %>%
   mutate(country = case_when(country == "Japan" ~ "日本",
                              country == "Korea, Rep." ~ "韓国",
                              TRUE               ~ "北朝鮮"),
          country = factor(country, levels = c("日本", "韓国", "北朝鮮")))
DT::datatable(df1)
df1 %>%
   ggplot() +
   geom_line(aes(x = year, 
                 y = lifeExp, 
                 group = country)) +
   labs(x = "西暦", y = "平均寿命") +
  ggtitle("平均寿命の推移（日本・韓国・北朝鮮）") +
  theme_bw(base_family = "HiraKakuProN-W3")

  • 3 本の折れ線グラフは描けたが、どの線が日本、韓国、韓国なのか不明
  • 国ごとに「線の色」を分けてみる
  • aes() の中にcolor を追加する
df1 %>%
   ggplot() +
   geom_line(aes(x = year, 
                 y = lifeExp, 
                 group = country, 
                 color = country), 
             size = 1) +
   labs(x = "西暦", y = "平均寿命") +
  ggtitle("平均寿命の推移（日本・韓国・北朝鮮）") +
  theme_bw(base_family = "HiraKakuProN-W3")

  • 国ごとに「線の種類」で分けてみる
  • aes() の中にlinetype を追加する
df1 %>%
   ggplot() +
   geom_line(aes(x = year, 
                 y = lifeExp, 
                 group = country, 
                 linetype = country), 
             size = 1) +
   labs(x = "西暦", y = "平均寿命") +
  ggtitle("平均寿命の推移（日本・韓国・北朝鮮）") +
  theme_bw(base_family = "HiraKakuProN-W3")

  • 韓国と韓国の線はどちらも似ていて区別しにくい
    →　韓国は破線、韓国は黒い点線に変更してみる
  • 線のタイプを指定したい場合
  • scale_linetype_manual() レイヤーを追加
    →　values 引数にそれぞれの線のタイプを指定
df1 %>%
   ggplot() +
   geom_line(aes(x = year, 
                 y = lifeExp, 
                 group = country, 
                 linetype = country), 
             size = 1) +
   labs(x = "西暦", y = "平均寿命") +
  ggtitle("平均寿命の推移（日本・韓国・北朝鮮）") +
  theme_bw(base_family = "HiraKakuProN-W3") +
  scale_linetype_manual(values = c("日本" = "solid",
                                   "韓国" = "dotted",
                                   "北朝鮮" = "dashed"))

  • linetype で指定可能な線のタイプは 6 種類

  • 表示させる国の数が 4 過酷以上の場合はファセット分割してみる
df1 %>%
   ggplot() +
   geom_line(aes(x = year, 
                 y = lifeExp, 
                 group = country, 
                 linetype = country), 
             size = 1) +
   labs(x = "西暦", y = "平均寿命") +
  ggtitle("平均寿命の推移（日本・韓国・北朝鮮）") +
  theme_bw(base_family = "HiraKakuProN-W3") +
  scale_linetype_manual(values = c("日本" = "solid",
                                   "韓国" = "dotted",
                                   "北朝鮮" = "dashed")) +
  theme(legend.position = "none") +     # レジェンドを非表示にする
  facet_wrap(~country)

  • ここではそれほどでもないが、表示する国の y 軸の変化に極端な差がある場合
  • ファセットごとに「縦軸のスケール」を別々にすることもできる
    →　注目すべき変化を拡大して確認できる
  • facet_wrap() 内の scales 引数
  • 縦軸のスケールをファセットごとに付ける場合
    →　scales = "free_y" を追加
df1 %>%
   ggplot() +
   geom_line(aes(x = year, 
                 y = lifeExp, 
                 group = country, 
                 linetype = country), 
             size = 1) +
   labs(x = "西暦", y = "平均寿命") +
  ggtitle("平均寿命の推移（日本・韓国・北朝鮮）") +
  theme_bw(base_family = "HiraKakuProN-W3") +
  scale_linetype_manual(values = c("日本" = "solid",
                                   "韓国" = "dotted",
                                   "北朝鮮" = "dashed")) +
  theme(legend.position = "none") +     # レジェンドを非表示にする
  facet_wrap(~country, scales = "free_y")

  • スケール変更した場合の図の解釈では、過大評価しないよう注意が必要　→　縦の目盛りに注意

1.4 折れ線グラフ + 散布図

  • 折れ線グラフに散布図を追加することも可能
  • 線の傾きが変化する（可能性がある）点に散布図をオーバラップさせる
  • 点の形を国ごとに異なるように設定する
  • geom_point() と geom_line() を重ねる必要がある
  • 後に書いたレイヤーが前面に表示される
  • 折れ線グラフ geom_line() は国ごとに色分けをする
    →　x, y, groupcolor に対してマッピングを行う
  • 散布図 geom_point() は国ごとに色分け・形分けをする
    →　x, y, color, shape に対してマッピング
df1 %>%
   ggplot(aes()) +
   geom_line(aes(x = year,         # 共通するマッピング
                 y = lifeExp,  　  # 共通するマッピング
                 color = country,  # 共通するマッピング
                 group = country),    
             size = 1) +
             　　　　　　        　  # ⇅ ggplot(aes()) に 1 回だけ入力すればよい
  
   geom_point(aes(x = year,         # 共通するマッピング
                  y = lifeExp,      # 共通するマッピング
                  color = country,  # 共通するマッピング
                  shape = country), 
              size = 3) +
  labs(x = "西暦", 
       y = "平均寿命",
       color = "国",
       shape = "国") +
  ggtitle("平均寿命の推移（日本・韓国・北朝鮮）") +
  scale_color_manual(values = c("日本" = "orangered",
                                 "韓国" = "limegreen",
                                 "北朝鮮" = "deeppink")) +
  theme_bw(base_family = "HiraKakuProN-W3")

  • 上のコードを見ると、2 つの幾何オブジェクト (geom_line と geom_point) は x, y, color が同じ変数にマッピングされている
  • 「全ての幾何オブジェクトに共通するマッピング」は ggplot() 内で行うことができる
    →　コマンドを簡素化できる
df1 %>%
   ggplot(aes(x = year,            # 共通するマッピング
              y = lifeExp,         # 共通するマッピング
              color = country)) +  # 共通するマッピング
   geom_line(aes(group = country), 
             size = 1) +
   geom_point(aes(shape = country), 
              size = 3) +
  labs(x = "西暦", 
       y = "平均寿命",
       color = "国",
       shape = "国") +
  ggtitle("平均寿命の推移（日本・韓国・北朝鮮）") +
  scale_color_manual(values = c("日本" = "orangered",
                                 "韓国" = "limegreen",
                                 "北朝鮮" = "deeppink")) +
  theme_bw(base_family = "HiraKakuProN-W3")

2. 当選者年齢の折れ線グラフ（自民・民主）

2.1 データ (hr96-21.csv)

  • 1996年から 2021年まで実施された衆議院選挙データセット ( hr96-21.csv) をダウンロードする
  • R プロジェクトフォルダ内に data という名前を付けたフォルダーを作成し、その中にダウンロードした csv ファイルを入れる
  • csvファイルを読み込むために必要な readr パッケージをロードする（tidyverse パッケージをロードすると、自動的に readr パッケージもロードされる）
library(tidyverse)
  • データを読み込み hr と名前をつける
hr <- read_csv("data/hr96-21.csv", 
               na = ".")

・データフレーム 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"

・次の 4 つの変数を使って、1996年から2021年までの衆議院選挙の小選挙区当選者の年齢（中央値）の推移に関して、自民党と民主党それぞれの時系列グラフを描いてみる

(1) year : 選挙が実施された年 (1996-2021)
(2) age : 立候補者の年齢
(3) wl : 0 = 小選挙区落選、1 = 小選挙区当選、2 = 復活当選
(4) seito : 立候補者が所属する政党

  • 衆議院選挙の小選挙区当選者の年齢（中央値）の推移を表す上のようなグラフを描くためには、age の代わりに 「当選者年齢の中央値（選挙ごと）」が必要
(1) year : 選挙が実施された年 (1996-2021)
(2) age_median : 選挙ごと (1996〜2021) における当選者年齢の中央値
(3) wl : 0 = 小選挙区落選、1 = 小選挙区当選、2 = 復活当選
(4) seito : 立候補者が所属する政党
  • age_median はデータフレーム (hr) に含まれていない
    => 新たに作る必要がある
  • 選挙ごと、政党ごとに計算する
  • 必要なデータフレームはこんな感じ
# year age_median seito
1 1996 数値 自民
・ ・ ・ ・
・ ・ ・ ・
7 2021 数値 自民
8 1996 数値 民主
・ ・ ・ ・
・ ・ ・ ・
14 2014 数値 民主

・　注：2021年の総選挙直前に民主党は解党

2.2 新たな変数 (age_median) を作る

  • 選挙ごと (1996〜2021) における当選者年齢の中央値を表す変数（変数名は自由に付ける）

dplyr パッケージを使った age_median の計算

・計算する前に age の様子を確認する

summary(hr$age)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
  25.00   43.00   52.00   51.22   59.00   94.00       4

・age に欠損値 (NA's) が 4 つあることを確認

library(tidyverse)
seito_median <- hr %>%                                # seito_medianとして保存
  filter(seito == "自民" | seito == "民主") %>%        # 自民党と民主党だけを残す
  filter(wl == 1) %>% 　　　　　　　　　　        　   　# 当選者 (wl = 1) だけを残す
  drop_na(age) %>%                                    # ageの4つの欠損値をドロップ
  group_by(year, seito) %>%                           # year毎、seito毎に計算する  
  summarise(age_median = median(age))   # ageの中央値の平均を age_maeian として保存

・datatable()関数を使ってをインターアクティブなデータを表示させる

DT::datatable(seito_median)

・これで線グラフを描くために必要なデータが揃った

2.3 折れ線グラフを描く

  • seito_median の変数 seito を日本語にリコーディング
  • 要素の順番は自民、民主の順にする
seito_median <- seito_median %>%
  mutate(seito = case_when(seito == "自民" ~ "自民",
                           TRUE            ~ "民主"),
         seito = factor(seito, levels = c("自民", "民主")))

seito_median %>% 
   ggplot(aes(x = year,               # 共通するマッピング
              y = age_median,         # 共通するマッピング
              color = seito)) +       # 共通するマッピング
   geom_line(aes(group = seito), 
             size = 1) +
   geom_point(aes(shape = seito), 
              size = 3) +
  labs(x = "西暦", 
       y = "平均年齢",
       color = "政党",
       shape = "政党") +
  ggtitle("政党別当選者年齢の中央値: 1996-2021") +
  scale_color_manual(values = c("自民" = "orangered",
                                 "民主" = "darkcyan")) +
  theme_bw(base_family = "HiraKakuProN-W3")

結論 ・ 1996年から2021の間に衆院選当選者の平均年齢は自民党の方が 8 歳高い
・ 自民党の当選者平均年齢は55歳近辺でさほど変化はないが、民主党の当選者の平均年齢は年々高まっている
・ 2012年にその差が 2 歳にまで狭まった
・ 自民、民主、両党の当選者平均年齢は下降傾向にはない

3. 米国下院の政治的二極化（経済的次元)

3.1 データ (congress.csv)

  • 第80回 (1947-1948) 〜第112回 (2011-2012)
  • 米国下院における法案に関する全ての議員の理想点を描く

DW-NOMINATE score

dwnom1 : 経済問題 ・・・　-1（リベラル） 〜 1（保守的）
dwnom2 : 人種問題 ・・・　-1（リベラル） 〜 1（保守的）
  • Sample size: 14552

Source: Nolan McCarty, Keith T. Poole, and Howard Rosenthal (2006) Polarized America:The Dance of Ideology and Unequal Riches. MIT Press.

経済的次元データ (dwnom1）を使って議会期別の中央値を政党別にプロット

3.2 新たな変数 (econ_median) を作る

  • 米国下院における法案に関する全ての議員の理想点（中央値）の推移を表す上のようなグラフを描くためには、dwnom1 の代わりに 「議員の理想点（中央値）（議会のセッションごと）」が必要
(1) congress : 議会のセッション番号 (80-112)
(2) econ_median : 米国下院における経済法案に関する全ての議員の理想点の中央値
(3) party : 下院議員の所属政党
  • econ_median はオリジナルのデータフレームに含まれていない
    => 新たに作る必要がある
  • 下院議会のセッションごと、政党ごとに計算する
  • 必要なデータフレームはこんな感じ
  • このような線グラフを描くためには次のようなデータセットが必要

econ_median という新たな変数

  • 米国下院議会のセッション番号 (88-112) ごと に経済法案に関する全ての議員の理想点の中央値を表す変数（ここでは econ_median と付けたが、変数名は自由に付ける）

  • 米国下院における経済法案に関する全ての議員の理想点
    ・DW-NOMINATE score のデータセット ( congress.csv ) をダウンロードする

  • R プロジェクトフォルダ内に data という名前を付けたフォルダーを作成し、その中にダウンロードした csv ファイルを入れる

  • csvファイルを読み込むために必要な readr パッケージをロードする（tidyverse パッケージをロードすると、自動的に readr パッケージもロードされる）

library(tidyverse)
  • サーベイデータを読み込み US と名前をつける
US <- read_csv("data/congress.csv")
  • 計算する前に US の欠測値（欠損値）を確認する
summary(US$congress)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  80.00   88.00   96.00   96.01  104.00  112.00
  • 欠損値はない
US <- US %>%                                                    　# US として保存
  filter(party == "Republican" | party == "Democrat") %>%         # Rep と Dem だけを残す
  group_by(congress, party) %>%                                   # congress毎、party毎に計算する  
  summarise(econ_median = median(dwnom1))  # dwnom1 の中央値の平均を econ_maeian として保存

・datatable()関数を使ってをインターアクティブなデータを表示させる

DT::datatable(US)

折れ線グラフを描く

US %>% 
  ggplot(aes(x = congress, 
             y = econ_median, 
             color = party)) +
  geom_point() +
  geom_line() +
  theme_bw()　+                     # 背景色を白にしたい場合 
  ggtitle("Political Polarization: ECON Dimention(US Congress:1947-2012)") +
  labs(x = "Congress",　　　      　# x 軸のラベルを指定
       y = "DW-NOMINATE score (economic dimention)")　# y 軸のラベルを指定

結論 ・ DW-NOMINATE score（経済次元） が時系列的にどのように変化しているかわかる
・ 政治的二極化 (political ploarization)が認められる
・ 民主党議員と共和党議員の経済問題に関するイデオロギーの中心は第95回議会あたりから分岐している
・ 近年、民主党はよりリベラル（−）になり、共和党はより保守化（＋）している

4. COVID-19 の新規感染者数データ

4.1 データ (COVID19_Worldwide.csv)

  • ここでは関西大学の Jaehyun SONG（宋財泫）先生がインターネットなどで独自に集めたデータ COVID19_Worldwide.csv を使う 【ソン先生に感謝！】
  • 宋先生のサイトはこちら
変数名 詳細
ID ID
Country 国名
Date 年月日
Confirmed_Day COVID-19 新規感染者数（人）/ 一日あたり
Confirmed_Total COVID-19 累積感染者数（人）総合
Death_Day COVID-19 新規死亡者数（人） 一日あたり
Death_Total COVID-19 累積死亡者数（人）総合
Test_Day COVID-19 新規検査数（人） 一日あたり
Test_Total COVID-19 累積検査数（人）総合 
COVID19_df <- read_csv("data/COVID19_Worldwide.csv", 
                       guess_max = 10000)　
                      # 最初の10000行を読んでからデータ型を判断するよう設定
  • データの型を確かめる
str(COVID19_df)
spec_tbl_df [31,806 × 9] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
 $ ID             : num [1:31806] 1 2 3 4 5 6 7 8 9 10 ...
 $ Country        : chr [1:31806] "Afghanistan" "Afghanistan" "Afghanistan" "Afghanistan" ...
 $ Date           : chr [1:31806] "2020/1/22" "2020/1/23" "2020/1/24" "2020/1/25" ...
 $ Confirmed_Day  : num [1:31806] 0 0 0 0 0 0 0 0 0 0 ...
 $ Confirmed_Total: num [1:31806] 0 0 0 0 0 0 0 0 0 0 ...
 $ Death_Day      : num [1:31806] 0 0 0 0 0 0 0 0 0 0 ...
 $ Death_Total    : num [1:31806] 0 0 0 0 0 0 0 0 0 0 ...
 $ Test_Day       : num [1:31806] NA NA NA NA NA NA NA NA NA NA ...
 $ Test_Total     : num [1:31806] NA NA NA NA NA NA NA NA NA NA ...
 - attr(*, "spec")=
  .. cols(
  ..   ID = col_double(),
  ..   Country = col_character(),
  ..   Date = col_character(),
  ..   Confirmed_Day = col_double(),
  ..   Confirmed_Total = col_double(),
  ..   Death_Day = col_double(),
  ..   Death_Total = col_double(),
  ..   Test_Day = col_double(),
  ..   Test_Total = col_double()
  .. )
 - attr(*, "problems")=<externalptr>
  • 年月日データ (Data) のデータ型が文字列 (chr) なので Date 型に変更する
COVID19_df <- COVID19_df %>%
  mutate(Date = as.Date(Date))
  • データの記述統計を示す
  • データ (COVID19_df) の変数の記述統計を表示させる
library(stargazer)
  • チャンクオプションで {r, results = "asis"} と指定する
stargazer(as.data.frame(COVID19_df), 
          type ="html",
          digits = 2)
Statistic N Mean St. Dev. Min Max
ID 31,806 16,124.51 9,379.38 1 32,413
Confirmed_Day 31,806 392.96 2,430.30 -10,034 66,627
Confirmed_Total 31,806 18,250.14 115,471.60 0 3,184,582
Death_Day 31,806 17.61 112.88 -1,918 2,614
Death_Total 31,806 1,039.01 6,565.51 0 134,094
Test_Day 8,281 14,332.71 61,911.94 -3,743 2,022,722
Test_Total 8,686 559,831.30 2,146,252.00 1 39,011,749
  • データの様子がわかるように DT パッケージを使って表示する
DT::datatable(COVID19_df)

4.2 折れ線グラフを描いてみる

  • 生データをそのままプロットする 　　

  • 横軸 (x)・・・日付（Date)

  • 縦軸 (y)・・・累積感志望者数（Death_Total）
    →　縦軸のスケールを底10の対数をとる
    その理由：グラフを見やすくするため
    →　例えば、累積死亡者数が 13万人のアメリカと、千人弱の日本を同じグラフに描くと非常に見にくい

COVID19_df %>%
  ggplot() +
  geom_line(aes(x = Date,                # x 軸に指定
                y = Death_Total)) +　# y 軸に指定
  scale_y_continuous(breaks = c(10, 100, 1000, 10000, 100000, 1000000),
                     labels = c("10", "100", "1000", "10000", 
                                "100000", "1000000"),
                     trans = "log10") + # 縦軸のスケールを底10の対数をとる設定
  labs(x = "月", y = "累積死亡者数 (人)") +
  theme_minimal(base_family = "HiraKakuProN-W3")

  • 本来、横軸の値 (Date) はデータ内に 1 回のみ登場すべき
  • しかし、COVID19_df の場合、特定の一日につき国の数だけある
    → 国 (Country) ごとに線を分けるように指定する必要あり
    →　マッピング要素として group を指定
    →　group で指定した変数の値ごとに異なる折れ線グラフを出力する
  • 国の数が多いので、自分が知りたい特定の国を指定してみる
  • unique() 関数を使って Country の中身を表示させてみる
unique(COVID19_df$Country)
  [1] "Afghanistan"                      "Albania"                         
  [3] "Algeria"                          "Andorra"                         
  [5] "Angola"                           "Antigua and Barbuda"             
  [7] "Argentina"                        "Armenia"                         
  [9] "Australia"                        "Austria"                         
 [11] "Azerbaijan"                       "Bahamas"                         
 [13] "Bahrain"                          "Bangladesh"                      
 [15] "Barbados"                         "Belarus"                         
 [17] "Belgium"                          "Belize"                          
 [19] "Benin"                            "Bhutan"                          
 [21] "Bolivia"                          "Bosnia and Herzegovina"          
 [23] "Botswana"                         "Brazil"                          
 [25] "Brunei"                           "Bulgaria"                        
 [27] "Burkina Faso"                     "Burma"                           
 [29] "Burundi"                          "Cabo Verde"                      
 [31] "Cambodia"                         "Cameroon"                        
 [33] "Canada"                           "Central African Republic"        
 [35] "Chad"                             "Chile"                           
 [37] "China"                            "Colombia"                        
 [39] "Comoros"                          "Congo (Brazzaville)"             
 [41] "Congo (Kinshasa)"                 "Costa Rica"                      
 [43] "Cote d'Ivoire"                    "Croatia"                         
 [45] "Cuba"                             "Cyprus"                          
 [47] "Czechia"                          "Denmark"                         
 [49] "Djibouti"                         "Dominica"                        
 [51] "Dominican Republic"               "Ecuador"                         
 [53] "Egypt"                            "El Salvador"                     
 [55] "Equatorial Guinea"                "Eritrea"                         
 [57] "Estonia"                          "Eswatini"                        
 [59] "Ethiopia"                         "Fiji"                            
 [61] "Finland"                          "France"                          
 [63] "Gabon"                            "Gambia"                          
 [65] "Georgia"                          "Germany"                         
 [67] "Ghana"                            "Greece"                          
 [69] "Grenada"                          "Guatemala"                       
 [71] "Guinea"                           "Guinea-Bissau"                   
 [73] "Guyana"                           "Haiti"                           
 [75] "Holy See"                         "Honduras"                        
 [77] "Hungary"                          "Iceland"                         
 [79] "India"                            "Indonesia"                       
 [81] "Iran"                             "Iraq"                            
 [83] "Ireland"                          "Israel"                          
 [85] "Italy"                            "Jamaica"                         
 [87] "Japan"                            "Jordan"                          
 [89] "Kazakhstan"                       "Kenya"                           
 [91] "South Korea"                      "Kosovo"                          
 [93] "Kuwait"                           "Kyrgyzstan"                      
 [95] "Laos"                             "Latvia"                          
 [97] "Lebanon"                          "Lesotho"                         
 [99] "Liberia"                          "Libya"                           
[101] "Liechtenstein"                    "Lithuania"                       
[103] "Luxembourg"                       "Madagascar"                      
[105] "Malawi"                           "Malaysia"                        
[107] "Maldives"                         "Mali"                            
[109] "Malta"                            "Mauritania"                      
[111] "Mauritius"                        "Mexico"                          
[113] "Moldova"                          "Monaco"                          
[115] "Mongolia"                         "Montenegro"                      
[117] "Morocco"                          "Mozambique"                      
[119] "Namibia"                          "Nepal"                           
[121] "Netherlands"                      "New Zealand"                     
[123] "Nicaragua"                        "Niger"                           
[125] "Nigeria"                          "North Macedonia"                 
[127] "Norway"                           "Oman"                            
[129] "Pakistan"                         "Panama"                          
[131] "Papua New Guinea"                 "Paraguay"                        
[133] "Peru"                             "Philippines"                     
[135] "Poland"                           "Portugal"                        
[137] "Qatar"                            "Romania"                         
[139] "Russia"                           "Rwanda"                          
[141] "Saint Kitts and Nevis"            "Saint Lucia"                     
[143] "Saint Vincent and the Grenadines" "San Marino"                      
[145] "Sao Tome and Principe"            "Saudi Arabia"                    
[147] "Senegal"                          "Serbia"                          
[149] "Seychelles"                       "Sierra Leone"                    
[151] "Singapore"                        "Slovakia"                        
[153] "Slovenia"                         "Somalia"                         
[155] "South Africa"                     "South Sudan"                     
[157] "Spain"                            "Sri Lanka"                       
[159] "Sudan"                            "Suriname"                        
[161] "Sweden"                           "Switzerland"                     
[163] "Syria"                            "Taiwan"                          
[165] "Tajikistan"                       "Tanzania"                        
[167] "Thailand"                         "Timor-Leste"                     
[169] "Togo"                             "Trinidad and Tobago"             
[171] "Tunisia"                          "Turkey"                          
[173] "Uganda"                           "Ukraine"                         
[175] "United Arab Emirates"             "United Kingdom"                  
[177] "United States"                    "Uruguay"                         
[179] "Uzbekistan"                       "Venezuela"                       
[181] "Vietnam"                          "West Bank and Gaza"              
[183] "Western Sahara"                   "Yemen"                           
[185] "Zambia"                           "Zimbabwe"

4.3 特定の国々だけをプロットする

  • 上の国のリストから、カナダ、フランス、ドイツ、イタリア、日本、イギリス、アメリカのいわゆる G7 を選んで表示させてみる
G7 <- c("Cananda", "France", "Germany", "Italy", "Japan", 
        "United Kingdom", "United States")

COVID19_df %>%
  filter(Country %in% G7) %>%
  ggplot() +
  geom_line(aes(x = Date, 
                y = Death_Total, 
                color = Country)) +
  scale_y_continuous(breaks = c(10, 100, 1000, 10000, 100000, 1000000),
                     labels = c("10", "100", "1000", "10000", 
                                "100000", "1000000"),
                     trans = "log10") +
  labs(x = "月", y = "累積死亡者数 (人)", color = "国") +
  theme_minimal(base_family = "HiraKakuProN-W3")

  • G7 の国々だけを選んで表示できた
  • 累積死亡者数と凡例の上位国が一致しないので、見にくい

グラフと凡例のずれの修正: fct_reorder2() 関数

  • グラフの右端の時点（つまり7月10日の時点）で最も累積志望者数が多い国はアメリカなのに、凡例では凡例では最下位に表示されている
  • この凡例の表示順番を fct_reorder2() 関数を使って並べ替える
  • データの最終日付 (Date) は 2020-07-10 で、この時点で累積志望者数 (Death_Total) が最多のアメリカを凡例の最上位に表示したい

→　Date を現在に近い順でソートする
→　累積志望者数 (Death_Total) の高い順（＝降順 ↓ ）で表示させる

COVID19_df %>%
  filter(Country %in% G7) %>%
  mutate(Country = fct_reorder2(Country,     # 凡例に表示する変数名
                                Date,        # Date を現在に近い順にソート
                                Death_Total, # 死亡者数の降順（↓）で表示  
                                last2)) %>%
  ggplot() +
  geom_line(aes(x = Date, 
                y = Death_Total, 
                color = Country)) +
  scale_y_continuous(breaks = c(10, 100, 1000, 10000, 100000, 1000000),
                     labels = c("10", "100", "1000", "10000", 
                                "100000", "1000000"),
                     trans = "log10") +
  labs(x = "月", y = "累積死亡者数 (人)", color = "国") +
  theme_minimal(base_family = "HiraKakuProN-W3")

4.4 特定の国だけを際立たせる

  • データ全体と比較しながら、興味ある特定の国の線の色だけを際立たせることができる
  • gglighlight パッケージを使って表示させる
library(gghighlight)
COVID19_df %>%
  ggplot() +
  geom_line(aes(x = Date, 
                y = Death_Total, 
                color = Country)) +
  gghighlight(Country %in% c("Japan", "China", "South Korea",
                             "United States", "Taiwan")) +
  scale_y_continuous(breaks = c(10, 100, 1000, 10000, 100000, 1000000),
                     labels = c("10", "100", "1000", "10000", 
                                "100000", "1000000"),
                     trans = "log10") +
  labs(x = "月", y = "累積死亡者数 (人)") +
  theme_minimal(base_family = "HiraKakuProN-W3")

5. 大臣に任命された議員の「選挙の強さ」

Research Question:

  • 大臣に任命された代議士は選挙に強いのか？

分析対象:

  • 2022年8月10日の第二次岸田改造内閣で閣僚に任命された代議士17名
  • 2 名の参議院議員（野村哲郎氏と岡田直樹氏）と1名の公明党議員（斉籐哲夫氏）は分析に含めていない

分析方法:

  • 1996年から2021年までの総選挙に出馬して当選した自民党議員の得票率と対比しつつ分析する
  • 「選挙の強さ」を「小選挙区で得た得票率」と「小選挙区でのマージン」の二つの方法で分析してみる

5.1 「選挙の強さ」= 得票率の場合

5.1.1 データの準備（得票率）

データ（得票率の平均値）の準備

  • データを読み込み hr と名前をつける
hr <- read_csv("data/hr96-21.csv", 
               na = ".")
  • 分析で使う変数だけに絞り、 df1 とデータフレーム名を付ける
df1 <- hr |> 
  select(year, wl, seito, j_name, voteshare)
DT::datatable(df1)

任命された代議士一覧 M16

  • j_name をファクター化し、得票率の高い順に表示順番を指定
df1 <- df1 |> 
  mutate(M16 = factor(j_name,
                      levels = c("林芳正",
                                 "加藤勝信",
                                 "寺田稔",
                                 "河野太郎",
                                 "浜田靖一",
                                 "西村康稔",
                                 "鈴木俊一",
                                 "西村明宏",
                                 "葉梨康弘",
                                 "高市早苗", 
                                 "谷公一",
                                 "松野博一",
                                 "秋葉賢也",
                                 "山際大志郎",
                                 "小倉将信",
                                 "永岡桂子")))
  • 大臣に任命された代議士16人それぞれの平均得票率を計算し、結果を df_vs_M16 という名前を付けて保存する
df_vs_M16 <- df1 |> 
  select(M16, voteshare) |> 
  group_by(M16) |> 
  summarise(ave_vs = mean(voteshare))
  • df_vs_M16 の計算結果を表示させる
DT::datatable(df_vs_M16)

自民党の立候補者の得票率の平均値

  • 1996年〜2021年総選挙において自民党の立候補者が獲得した得票率の平均値を計算してみる　
df1 |> 
  filter(seito == "自民") |> 
  group_by(n()) |> 
  summarise(vs_average = mean(voteshare)) |> 
  DT::datatable()
  • 約 47% だと分かった

5.1.2 大臣と自民党候補者の得票率

  • 自民党立候補者の総選挙ごとの得票率を grey で表示
  • 大臣に任命された代議士 16人 の得票率に色を付けて表示
  • 自民党立候補者の得票率平均 (47%) を黒い点線で表示させる
df1 %>%
  filter(seito == "自民") |> # 自民党候補者だけを選ぶ
  ggplot(aes(x = year, 
             y = voteshare, 
             color = j_name)) +
  geom_line() +
  geom_point() +
  geom_hline(yintercept = 47, # 自民党立候補者の得票率平均を黒の点線で表示  
             linetype="dotted", 
             color = "black") + 
  theme_bw(base_family = "HiraKakuProN-W3") + 
  labs(x = "総選挙", 
       y = "得票率") +
  ggtitle("第2次岸田改造内閣大臣の総選挙結果（平均得票率）") +
  scale_x_continuous(breaks = c(1996, 2000, 2003, 2005, 2009, 2012, 2014, 2017, 2021),
                     labels = c("1996", "2000", "2003", "2005", "2009", "2012", "2014", "2017", "2021")) +
  theme(axis.text.x = element_text(angle = 60, # 選挙年を60度回転
                                   vjust = 1,
                                   hjust = 1),
        panel.grid.major.x = element_blank())  + # 縦線グリッドを削除
  theme(legend.position = "none") +
  gghighlight(j_name %in% M16,  # 大臣に任命された代議士リスト M16  
              use_direct_label = FALSE) # 図の中にラベルは付けない

  • 上の図だと大臣を特定できないので、大臣ごとの得票率をファセットで取り出し表示

5.1.3 大臣と自民党候補者の得票率（ファセット）

  • 得票率の高い順に表示する大臣の順番を指定している
plot_1 <- df1  |> 
  mutate(M16 = factor(M16,　# 得票率の高い順に表示する順番を指定
                          levels = c("林芳正",
                                     "加藤勝信",
                                     "河野太郎",
                                     "西村康稔",
                                     "寺田稔",
                                     "浜田靖一",
                                     "高市早苗", 
                                     "葉梨康弘",
                                     "松野博一",
                                     "西村明宏",
                                     "鈴木俊一",
                                     "谷公一",
                                     "小倉将信",
                                     "山際大志郎",
                                     "秋葉賢也",
                                     "永岡桂子")),
         j_name = fct_reorder(j_name,　　　　　# j_name を numeric に変換  　　
                              as.numeric(M16))) |>
  filter(seito == "自民") |> 
  
  ggplot(aes(x = year, 
                y = voteshare, 
                color = j_name)) +
  geom_line(color = "orangered") +
  geom_point(color = "orangered") +
  geom_hline(yintercept= 47, 
             linetype="dotted", 
             color = "black") + # 当選者の得票率平均に黒い点線  
  gghighlight(j_name %in% M16,
              use_direct_label = FALSE) +
  theme_bw(base_family = "HiraKakuProN-W3") + 
  facet_wrap(~j_name) +
  labs(x = "総選挙", 
       y = "得票率") +
  ggtitle("第2次岸田内閣大臣の総選挙結果（得票率）") +
  scale_x_continuous(breaks = c(1996, 2000, 2003, 2005, 2009, 2012, 2014, 2017, 2021),
                     labels = c("1996", "2000", "2003", "2005", "2009", "2012", "2014", "2017", "2021")) +
  theme(axis.text.x = element_text(angle = 70, # 70度回転
                                   vjust = 1,
                                   hjust = 1),
        panel.grid.major.x = element_blank())  + # 縦線グリッドを削除
  theme(legend.position = "none")

plot_1

  • これでも十分使えるが、図を保存する際に縦横のサイズを指定することで調整できる

作成した図の保存方法：

  • 作成した図を保存したいときには R Project フォルダ内に、graphs_tables などのような名前を付けたファイルをあらかじめ作成し、その中に保存するのが良い
  • 例えば、次のように指定して保存する
ggsave(filename = "graphs_tables/plot_1.png", # 保存先とファイル名
       plot     = plot_1,               　　  # 保存する図のオブジェクト名
       width    = 6,                　　　　  # 図の幅 (インチ)
       height   = 8,                　　　　  # 図の高さ (インチ)
       dpi      = 400,              　　　　  # 解像度
       device   = ragg::agg_png)     　　　　 # 文字化け防止・raggパッケージをインストールすること
  • ここで新たに保存した図 plot_1.png を表示してみる
  • 縦軸のスケールが広がり、かなり見やすくなった

  • 1 行目の大臣・・・かなり選挙に強い代議士（ほとんど平均値以上を得票）
  • 2 行目の大臣・・・選挙に強い代議士
  • 3 行目の大臣・・・そこそこ選挙に強い代議士
  • 4 行目の大臣・・・選挙に強いとはいえない代議士 （ほとんど平均値以下を得票）
    ・とりわけ、永岡桂子は2005, 2009, 2012, 2014, 2017年総選挙は比例で復活当選
    ・2021年総選挙で初めて小選挙区で当選

5.2 「選挙の強さ」= マージンの場合

5.2.1 データの準備（マージン）

データ（margin）の準備

  • 選挙の強さ: Margin（1996-2021）

  • 惜敗率でわかるのは、小選挙で落選した「当選者以外」の選挙での強さ

\[惜敗率 = \frac{次点者の票数}{当選者の票数}\]

  • 惜敗率は 0 と 1 の間の値

  • 小選挙区当選者の惜敗率は全員 1
    → 小選挙区当選者間の強さの違いはわからない

  • 当選者を含めた選挙の強さ (Margin)を知りたい場合
    →　ひと工夫必要

\[当選者のMargin = \frac{当選者の票数}{次点者の票数}\]

  • 当選者の Marginは 1 以上の値

  • 小選挙区の落選者の Margin は「惜敗率」を使う (0〜1)

  • 小選挙区の当選者の Margin は「当選者の Margin」を使う (1以上)
    → 小選挙区の当選者と落選者、両方の選挙の強さを比較できる

  • 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"
  • Margin を計算するために必要な変数は次のとおり
  1. year
  2. ku
  3. kun
  4. vote
  5. rank
  • 変数を絞る
hr_margin <- hr %>% 
  select(year, ku, kun, rank, j_name, vote, wl, seito)
  • ku の中身を確認する
unique(hr_margin$ku)
 [1] "aichi"     "ehime"     "ibaraki"   "okayama"   "okinawa"   "iwate"    
 [7] "gifu"      "miyazaki"  "miyagi"    "kumamoto"  "gunma"     "hiroshima"
[13] "kagawa"    "kochi"     "saga"      "saitama"   "mie"       "yamagata" 
[19] "yamaguchi" "yamanashi" "shiga"     "kagoshima" "akita"     "niigata"  
[25] "aomori"    "shizuoka"  "ishikawa"  "chiba"     "osaka"     "oita"     
[31] "nagasaki"  "nagano"    "tottori"   "shimane"   "tokyo"     "tokushima"
[37] "tochigi"   "nara"      "toyama"    "hyogo"     "hokkaido"  "wakayama" 
[43] "kanagawa"  "fukui"     "fukuoka"   "fukushima" "kyoto"     "shinane"
  • kun の中身を確認する
unique(hr_margin$kun)
 [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
  • kun = 25 は東京
  • 下の式に従って、変数 margin を計算する

\[当選者のMargin = \frac{当選者の票数}{次点者の票数}\]

calculate_margin <- function(data) {
  dat1 <- data %>% 
    arrange(rank) %>% 
    mutate(
      rank1_vote = if_else(rank == 1, 
                           vote, 
                           NA_real_),
      rank2_vote = if_else(rank == 2, 
                           vote, 
                           NA_real_)
    ) %>% 
    fill(rank1_vote, 
         rank2_vote, 
         .direction = "downup") %>% 
    mutate(
      divide_vote = if_else(rank == 1, 
                            rank2_vote, 
                            rank1_vote),
      margin = vote / divide_vote
    )
  return(dat1)
}
  • year と ku と kun を組み合わせて district という名前の変数をつくる
  • 例）year (1996) + ku (miyagi) + kun (6) => district (1996_miyagi_6)
hr_margin <- hr_margin %>% 
  mutate(
    district = str_c(year, ku, kun, sep = "_") # year を忘れずに  
  ) %>% 
  group_nest(district) %>% 
  mutate(
    margin_vote = map(data, calculate_margin)
  ) %>% 
  select(district, margin_vote) %>% 
  unnest(margin_vote)
  • 計算した結果から分析に必要な変数だけを引き出し df2 と名前をつける
df2 <- hr_margin |> 
  select(year, wl, seito, j_name, margin)
DT::datatable(df2)

任命された代議士一覧 M16

df2 <- df2 |> 
  mutate(M16 = factor(j_name,
                      levels = c("林芳正",
                                 "加藤勝信",
                                 "寺田稔",
                                 "河野太郎",
                                 "浜田靖一",
                                 "西村康稔",
                                 "鈴木俊一",
                                 "西村明宏",
                                 "葉梨康弘",
                                 "高市早苗", 
                                 "谷公一",
                                 "松野博一",
                                 "秋葉賢也",
                                 "山際大志郎",
                                 "小倉将信",
                                 "永岡桂子")))
  • df2 を使って、大臣に任命された代議士16人が出馬した総選挙でのマージンの平均値 ave_margin を計算し
    →　データフレーム df_mergin_M16 に付け加える
df_mergin_M16 <- df2 |> 
  select(M16, margin) |> 
  group_by(M16) |> 
  summarise(ave_margin = mean(margin))
  • データフレーム df_mergin_M16 の中身を確認する
DT::datatable(df_mergin_M16)
  • 林芳正のマージンが最も大きく (3.33)、永岡桂子が最も小さい (0.84) とわかる

自民党の立候補者のマージンの平均値

  • 1996年〜2021年総選挙において自民党立候補者のマージンの平均を計算してみる　
df2 |> 
  filter(seito == "自民") |> 
  group_by(n()) |> 
  summarise(vs_margin = mean(margin)) |> 
  DT::datatable()
  • 約 1.44 だと分かった

5.2.1 大臣と自民党候補者のマージン

  • 1996〜2021の総選挙に当選した自民党代議士のデータだけに絞る
  • 自民党代議士の総選挙ごとのマージンを grey で表示
  • 大臣に任命された代議士 16人 のマージンに色を付けて表示
  • 1996年〜2021年総選挙において自民党の当選者が獲得したマージンの平均 (1.44 %) に黒い点線を引く
df2 %>%
  filter(seito == "自民") |> # 自民党候補者だけを選ぶ
  ggplot(aes(x = year, 
                y = margin, 
                color = j_name)) +
  geom_line() +
  geom_point() +
  geom_hline(yintercept = 1.44, 
             linetype="dotted", 
             color = "black") + # 自民党当選者のマージン平均に黒い点線
  theme_minimal(base_family = "HiraKakuProN-W3") + 
  labs(x = "総選挙", 
       y = "マージン") +
  ggtitle("第2次岸田内閣大臣の総選挙結果(マージン）") +
  scale_x_continuous(breaks = c(1996, 2000, 2003, 2005, 2009, 2012, 2014, 2017, 2021),
                     labels = c("1996", "2000", "2003", "2005", "2009", "2012", "2014", "2017", "2021")) +
  theme(axis.text.x = element_text(angle = 60, # 選挙年を60度回転
                                   vjust = 1,
                                   hjust = 1),
        panel.grid.major.x = element_blank())  + # 縦線グリッドを削除
  theme(legend.position = "none") +
  gghighlight(j_name %in% M16,  # 大臣に任命された代議士リスト M16  
              use_direct_label = FALSE)  # 図の中にラベルは付けない

  • 上の図だと大臣を特定できないので、大臣ごとのマージンをファセットで取り出し表示

5.2.2 大臣と自民党候補者のマージン（ファセット）

  • マージンの高い順に表示する大臣の順番を指定している
plot_2 <- df2  |> 
  mutate(M16 = factor(M16,
                          levels = c("林芳正",
                                     "加藤勝信",
                                     "河野太郎",
                                     "西村康稔",
                                     "寺田稔",
                                     "浜田靖一",
                                     "高市早苗", 
                                     "葉梨康弘",
                                     "松野博一",
                                     "西村明宏",
                                     "鈴木俊一",
                                     "谷公一",
                                     "小倉将信",
                                     "山際大志郎",
                                     "秋葉賢也",
                                     "永岡桂子")),
         j_name = fct_reorder(j_name,　　　　　　　# マージンの高い順に表示する順番を指定
                              as.numeric(M16))) |> 
  filter(seito == "自民") |> 
  
  ggplot(aes(x = year, 
                y = margin, 
                color = j_name)) +
  geom_line(color = "blue") +
  geom_point(color = "blue") +
  geom_hline(yintercept = 1, 
             linetype="dotted", 
             color = "red") + # 自民党当選者のマージン平均に黒い点線
  gghighlight(j_name %in% M16,
              use_direct_label = FALSE) +
  theme_bw(base_family = "HiraKakuProN-W3") + 
  facet_wrap(~j_name) +
  ylim(0, 4.6) +  
  labs(x = "総選挙", 
       y = "マージン") +
  ggtitle("第2次岸田内閣大臣の総選挙結果（マージン）") +
  scale_x_continuous(breaks = c(1996, 2000, 2003, 2005, 2009, 2012, 2014, 2017, 2021),
                     labels = c("1996", "2000", "2003", "2005", "2009", "2012", "2014", "2017", "2021")) +
  theme(axis.text.x = element_text(angle = 70, # 70度回転
                                   vjust = 1,
                                   hjust = 1),
        panel.grid.major.x = element_blank())  + # 縦線グリッドを削除
  theme(legend.position = "none") 

plot_2

この図は width = 6, height = 8 と指定したものである

  • 例えば、マージン = 2 というのは、次点者が獲得した票の 2 倍獲得したという意味

  • 1 行目の大臣・・・かなり選挙に強い代議士

  • 2 行目の大臣・・・選挙に強い代議士

  • 3 行目の大臣・・・そこそこ選挙に強い代議士

  • 4 行目の大臣・・・選挙に強いとはいえない代議士
    ・とりわけ、永岡桂子は2005, 2009, 2012, 2014, 2017年総選挙は比例で復活当選
    ・2021年総選挙で初めて小選挙区で当選

作成した図の保存方法：

  • 作成した図を保存したいときには R Project フォルダ内に、graphs_tables などのような名前のファイルをあらかじめ作成し、その中に保存するのが良い
  • 保存の一例は次のとおり
ggsave(filename = "graphs_tables/plot_2.png", # 保存先とファイル名
       plot     = plot_2,               　　  # 保存する図のオブジェクト名
       width    = 6,                　　　　  # 図の幅 (インチ)
       height   = 8,                　　　　  # 図の高さ (インチ)
       dpi      = 400,              　　　　  # 解像度
       device   = ragg::agg_png)     　　　　 # 文字化け防止・raggパッケージをインストールすること

5.3 「選挙に強い」とは？

  • ここでは「大臣に任命されること」と「総選挙の強さ」を考えてみる
  • ある政治家が「大臣に任命されたか否か」ということは、明確に判断できる
  • しかし、ある政治家の「選挙の強さ」を明確に知ることはそれほど単純ではない
  • ここでは、代議士の選挙の強さに関して、次の 2 つのデータが得られた

・df_vs_M16・・・大臣に任命された 16 人の「平均得票率」
・df_mergin_M16・・・大臣に任命された 16 人の「平均マージン」

head(df_vs_M16, 16)
# A tibble: 16 × 2
   M16        ave_vs
   <fct>       <dbl>
 1 林芳正       76.9
 2 加藤勝信     68.6
 3 寺田稔       62.1
 4 河野太郎     61.6
 5 浜田靖一     60.7
 6 西村康稔     58.8
 7 鈴木俊一     55.1
 8 西村明宏     53.5
 9 葉梨康弘     50.7
10 高市早苗     49.8
11 谷公一       48.2
12 松野博一     47.7
13 秋葉賢也     46.2
14 山際大志郎   43.2
15 小倉将信     41.9
16 永岡桂子     37.3
head(df_mergin_M16, 16)
# A tibble: 16 × 2
   M16        ave_margin
   <fct>           <dbl>
 1 林芳正          3.34 
 2 加藤勝信        2.90 
 3 寺田稔          2.12 
 4 河野太郎        2.83 
 5 浜田靖一        2.06 
 6 西村康稔        2.38 
 7 鈴木俊一        1.48 
 8 西村明宏        1.48 
 9 葉梨康弘        1.68 
10 高市早苗        1.71 
11 谷公一          1.46 
12 松野博一        1.56 
13 秋葉賢也        1.30 
14 山際大志郎      1.34 
15 小倉将信        1.38 
16 永岡桂子        0.843
  • 2 つのデータフレームを inner_join() 関数を使ってジョイントしてみよう
df_3 <- inner_join(df_vs_M16,
           df_mergin_M16, 
           by = "M16")
DT::datatable(df_3)
  • ここでの問題は、これら 2 つの変数を使って「選挙の強さ」をどう判断するか、ということ
  • 例えば、林芳正の「平均得票率 ave_vs」は 76.94、 「平均マージン ave_margin」は 3.34 でいずれの変数でも最大値
    →　「最も選挙に強いのは林芳正である」と結論づけるのは早急
  • その理由は、林芳正は1995年参院選（山口県選挙区）で初当選して以来、連続 5 回当選している（つまり、27年間参議院議員であった）
  • 2021年総選挙に初めて出馬した選挙結果と、1996年から複数回出馬している他の大臣の選挙結果を、単純比較することはできない
  • また、衆議院と参議院で選挙制度が異なるため、参院と衆院での選挙結果を単純に比較して、どちらが選挙に強いか判断することは難しい
  • 「選挙の強さ」の指標である「平均得票率 ave_vs」も「平均マージン ave_margin」も、いずれも大臣の順位が同じ
    →　この順位で選挙に強いとはいえそう
    →　しかし、しっかり分析するためには「選挙の強さ」を定義して計量化する必要がある
大臣の任命と政治家の選挙の強さには次のような「因果推論」に関する問題がある　　

①　選挙に強い代議士だから、総理大臣が任命したのか？
②　総理大臣が大臣に任命したから、選挙に強くなったのか？

6. Exercise

・Q6.1:「4.4特定の国だけを際立たせる」を参考にして、あなたが興味ある国々を複数選び、累計死亡者数を国ごとにハイライトして際立たせた折れ線グラフを描きなさい

・Q6.2:「2. 当選者年齢の折れ線グラフ（自民・民主）」を参考にして、こたえなさい

  • 1996年から 2021年まで実施された衆議院選挙データセット ( hr96-21.csv) を読み込み、下の 4 つの変数を使って、1996年から2021年までの衆議院選挙の小選挙区当選者の得票率（中央値）の推移に関して、自民党と民主党それぞれの折れ線グラフを描きなさい
(1) year : 選挙が実施された年 (1996-2021)
(2) voteshare : 立候補者の得票率 (%)
(3) wl : 0 = 小選挙区落選、1 = 小選挙区当選、2 = 復活当選
(4) seito : 立候補者が所属する政党、自民 = 自民党、民主 = 民主党
参考文献