• このセクションで使っている R packages
library(DT)
library(gapminder)
library(gghighlight)
library(ggrepel)
library(stargazer)
library(tidyverse)

1. 散布図とは

  • 散布図 (scatter plot) は 2 つの連続変数(=間隔尺度、比率尺度で測定された変数)間の関係を調べる代表的な可視化方法
  • 散布図は 2 次元平面上に複数の点を可視化したもの
  • ここで使う幾何オブジェクトは ggplot()geom_point()
幾何オブジェクト 意味
ggplot() 図を描くキャンバスを用意する
geom_point() 散布図を描く
  • 1996-2021年総選挙データから、2014年データを抜き出し「選挙費用」と「得票率」の散布図を描いてみる

  • 必要なデータは次の 2 つ:

  1. 選挙費用 (exp)
  2. 得票率 (voteshare)
  • データを読み込む
  • hr96-21.csv をダウンロード
df <- read_csv("data/hr96-21.csv",
               na = ".")  
  • 2009年データを抜き出し df09 と名前を付ける
df09 <- df %>%
  filter(year == 2009)

1.1 最もシンプルな散布図

  • 横軸上の位置は x に、縦軸上の位置は y にマッピングする
  • 2 つの変数の間に原因と結果の関係(因果関係)が考えられる2変数の場合
    ・原因と考えられる要因を x 軸に設定(ここでは「選挙費用 exp」)
    ・結果と考えられる要因を y 軸に設定(ここでは「得票率 voteshare」)
df09 %>%
  ggplot() +
  geom_point(aes(x = exp, 
                 y = voteshare)) 

  • 横軸と縦軸のタイトルが exp, votehsare
  • 図を見る人にはこれらが何を意味するか分からない

1.2 ラベルとドットの色をカスタマイズ

  • x 軸と y 軸にラベルを付ける
  • ggtitle() 関数を使ってメインタイトルを付ける
  • ドットの色を指定する
df09 %>%
   ggplot() +
   geom_point(aes(x = exp, 
                  y = voteshare), 
              color = "royalblue") +
   labs(x = "選挙費用", 
        y = "得票率") +
  ggtitle("選挙費用と得票率の散布図: 2009年総選挙") +
  theme_bw(base_family = "HiraKakuProN-W3")

1.3 ドットの形をカスタマイズ

  • shape = 番号 でドットの形を指定できる
  • ここでは三角() に指定してみる
df09 %>%
   ggplot() +
   geom_point(aes(x = exp, 
                  y = voteshare), 
              color = "royalblue",
              shape = 2) +
   labs(x = "選挙費用", 
        y = "得票率") +
  ggtitle("選挙費用と得票率の散布図: 2009年総選挙") +
  theme_bw(base_family = "HiraKakuProN-W3")

  • ドットの形は次の 25 種類から選べる  
  • ドットの形のデフォルトは 19 の「

  • 0 〜 14 の場合・・・中身が透明で枠線のみの形
  • 枠線の色を変えたい場合・・・color 引数で調整
  • 15 〜 20 の場合・・・中身が埋まり枠線のない形
  • 中身の色も color で調整可能
  • 15 〜 25 の場合・・・枠線は color、内側の色塗りは fill で調整
shape = 22 を使い「内側がバイオレット」で「枠線がアクアマリン」の「」を表示させてみる  
df09 %>%
   ggplot() +
   geom_point(aes(x = exp, 
                  y = voteshare), 
              color = "violet",    # 枠線の色を指定 
              fill = "aquamarine", # 内側の色塗り指定
              shape = 22) +     # ドットの形を指定  
   labs(x = "選挙費用", 
        y = "得票率") +
  ggtitle("選挙費用と得票率の散布図: 2009年総選挙") +
  theme_bw(base_family = "HiraKakuProN-W3")

2. 次元の追加

  • 前節で作った散布図はexpvotehsare という 2 つの情報 (= 2 次元) をもつ
  • 散布図は情報の数(=次元)を拡大できる
  • ここでは if_else() 関数を使って民主党ダミー dpj を作成し、散布図に次元を追加してみる
  • aes() 関数の内側に shape = dpj と指定してみる

2.1 ドットの「形」を変えて次元追加

  • aes() の内側に shape = dpj と指定
    → 民主党候補者か否かでドットの形を変えることができる
df09 %>%
  mutate(dpj = if_else(seito == "民主", "民主党", "非民主党")) %>%
   ggplot() +
   geom_point(aes(x = exp, 
                  y = voteshare,
                  shape = dpj)) + # dpj をドットの形で区別
   labs(x = "選挙費用", 
        y = "得票率") +
  ggtitle("選挙費用と得票率の散布図: 2009年総選挙") +
  theme_bw(base_family = "HiraKakuProN-W3")

  • shape = dpj と指定すると、Rが自動的に「」と「」を割り当てる
  • じっくり見れば、民主党候補者とそれ以外を区別できるが、全体に占める民主党候補者の傾向がわかりにくい
    → ドットの形を指定してみる
    ・民主党・・・「」(空っぽのマル)
    ・非民主党・・・「×
  • scale_shape_manual() を使う
df09 %>%
  mutate(dpj = if_else(seito == "民主", "民主党", "非民主党")) %>%
   ggplot() +
   geom_point(aes(x = exp, 
                  y = voteshare,
                  shape = dpj)) + # dpj をドットの形で区別
   labs(x = "選挙費用", 
        y = "得票率") +
  ggtitle("選挙費用と得票率の散布図: 2009年総選挙") +
  theme_bw(base_family = "HiraKakuProN-W3")  +
  theme(legend.position = "bottom") + # レジェンドの位置を下に
  scale_shape_manual(values = c("民主党" = 1,    # 「○」は 1  
                                "非民主党" = 4))  # 「×」は 4  

  • 」と「」よりずっと見やすくなった

2.2 ドットの色を変えて次元追加

  • 全体に占める民主党候補者の傾向をさらに見やすくするためには
    → 色分けして表示してみる
  • aes() 関数の内側に color = dpj と指定してみる
df09 %>%
  mutate(dpj = if_else(seito == "民主", "民主党", "非民主党")) %>%
   ggplot() +
   geom_point(aes(x = exp, 
                  y = voteshare,
                  color = dpj,    # dpj を色分け
                  alpha = 0.5)) + # 透明度を追加  
   labs(x = "選挙費用", 
        y = "得票率") +
  ggtitle("選挙費用と得票率の散布図: 2009年総選挙") +
  theme_bw(base_family = "HiraKakuProN-W3") +
  theme(legend.position = "bottom") # レジェンドの位置を下に

  • 自民党から民主党に政権交代が起こった 2009 年総選挙では、民主党候補者の方がより多く得票している傾向がよく分かる

2.3 ドットの色を指定する

  • ドットを好みの色に指定したい場合
  • scale_color_manual() レイヤーを追加
  • 引数は values
  • c("値1" = "色1", "値2" = "色2", ...) のように名前を付け
    → character 型ベクトルを指定
df09 %>%
  mutate(dpj = if_else(seito == "民主", "民主党", "非民主党")) %>%
   ggplot() +
   geom_point(aes(x = exp, 
                  y = voteshare,
                  color = dpj,    # dpj を色分け
                  alpha = 0.5)) + # 透明度を追加  
   labs(x = "選挙費用", 
        y = "得票率") +
  ggtitle("選挙費用と得票率の散布図: 2009年総選挙") +
  theme_bw(base_family = "HiraKakuProN-W3") +
  theme(legend.position = "bottom") + # レジェンドの位置を下に
  scale_color_manual(values = c("民主党" = "blue",
                                "非民主党" = "gold"))

  • 自民党から民主党に政権交代が起こった 2009 年総選挙では、民主党候補者の方がより多く得票している傾向がよく分かる

  • ggplot2 で使える色は 657 種類!

  • "red""skyblue""royalblue"のように文字で指定できる

  • Rで使用可能な色のリストはコンソール上で colors() と打ち込むと確認できる

  • ここでは最初の 6 色を示す

head(colors())
[1] "white"         "aliceblue"     "antiquewhite"  "antiquewhite1"
[5] "antiquewhite2" "antiquewhite3"
  • これ以外にも RGBカラー(HEmathコード; 16進数)で指定することもできる
  • たとえば赤なら "#FF0000"、ロイヤルブルーなら "#4169E1"と表記
  • HEmathコードを使う場合 → 非常に細かく色を指定可能
    → 16,777,216 種類!!! の色が使える  
  • 以下の例は R で使える色の一部

3. 回帰直線を加えた散布図 (1)

  • 2009年総選挙における「選挙費用」と「得票率」の散布図に回帰直線を加えてみる
  • 回帰直線を加えるためには geom_smooth(method = lm) を加える
  • ggplot() の内側に aes() 関数を指定し、そこに x 軸、y 軸、color の設定をする
plot_vs_09 <- df09 %>%
   ggplot(aes(x = exp,
              y = voteshare,
              color = seito,
              alpha = 0.5)) + # ドットの透明度を指定
   geom_point() +     
  geom_smooth(method = lm) +   # 回帰直線を引く
   labs(x = "選挙費用", 
        y = "得票率") +
  ggtitle("選挙費用と得票率の散布図: 2009年総選挙") +
  theme_bw(base_family = "HiraKakuProN-W3")

plot_vs_09

  • facet_wrap() 関数を使って、政党ごとに見やすく表示してみる
plot_vs_09 +
  facet_wrap(~seito)    # 政党ごとに facet する  

  • x 軸のラベルが長く、左右でオーバーラップしている
    → x 軸のラベルを 40度回転させてみる
  • theme() レイヤーを追加し、axis.text.x を指定
plot_vs_09 +
  facet_wrap(~seito)  +  # 政党ごとに facet する  
  theme(legend.position = "none") + # レジェンドを非表示
  theme(axis.text.x  = element_text(angle = 40, vjust = 1, hjust = 1)) # 35度回転

  • 2009年の総選挙は、自民党から民主党の政権交代した選挙
  • 自民党と民主党を比較したい
  • しかし、自民党と民主党の図は隣同士ではない
  • ggplot()に渡す前に seitofactor 化して、順番を変える
df09 %>%
   mutate(seito = factor(seito,
                         levels = c("民主", "自民", "公明", "みんな",
                                    "共産", "国民新党", "幸福", "新党日本", 
                                    "無所", "社民"))) %>% 
   ggplot(aes(x = exp,
              y = voteshare,
              color = seito,
              alpha = 0.5)) + # ドットの透明度を指定
   geom_point() +     
  geom_smooth(method = lm) +   # 回帰直線を引く
   labs(x = "選挙費用", 
        y = "得票率") +
  ggtitle("選挙費用と得票率の散布図: 2009年総選挙") +
  theme_bw(base_family = "HiraKakuProN-W3") +
  facet_wrap(~seito, ncol = 4) + # 4 列表示にする
  theme(legend.position = "none") + # レジェンドを非表示
  theme(axis.text.x  = element_text(angle = 40, vjust = 1, hjust = 1)) # 35度回転

視覚的に確認できること   
  • 自民党より民主党の方が多く得票している
  • 自民党より民主党の方が選挙費用が少ない
政党別の得票率を計算してみる
  • group_by() 関数を使って、政党ごとの得票率を計算する
df09_ave <- df09 %>%
  group_by(seito) %>%
  summarise(ave_vs = mean(voteshare, 
                          na.rm = TRUE))
DT::datatable(df09_ave)

4. 回帰直線を加えた散布図 (2)

  • 「GDP」と「寿命」の散布図

  • ここでは R が備えている {gapminder} というデータを使って、 2 次元平面で表現できる散布図に、もう一つ次元を加えて 3 次元以上の情報を可視化する方法を紹介する

  • {gapminder} パッケージをダウンロードする

library(gapminder)
変数名 詳細
country 国名
continent 大陸名
year
lifeExp 寿命
pop 人口
gdpPercap 一人あたり GDP, 2005年の時点での米ドルで表示
  • 記述統計を示す
library(stargazer)
  • チャンクオプションで {r, results = "asis"} と指定する
stargazer(as.data.frame(gapminder), 
          type ="html",
          digits = 2)
Statistic N Mean St. Dev. Min Max
year 1,704 1,979.50 17.27 1,952 2,007
lifeExp 1,704 59.47 12.92 23.60 82.60
pop 1,704 29,601,212.00 106,157,897.00 60,011 1,318,683,096
gdpPercap 1,704 7,215.33 9,857.45 241.17 113,523.10
DT::datatable(gapminder)

4.1 シンプルな散布図 ({gapminder})

  • まず、「一人あたり GDP (gdpPercap)」を x 軸、「平均寿命 (lifeExp)」を y 軸に指定して散布図を描いてみる
  • ggplot() に渡す前に、人口を「百万人単位に換算した」変数 pop_m を作成する
gapminder %>%
  mutate(pop_m = pop / 1000000) %>%  #人口を百万人単位に換算した変数 pop_mを作成
  ggplot() +
  geom_point(aes(x = gdpPercap, 
                 y = lifeExp)) +
  labs(x = "一人あたりGDP (USD)", 
       y = "寿命") +
  theme_bw(base_family = "HiraKakuProN-W3")

  • 「一人あたり GDP」の記述統計を見ると、データの範囲が 241米ドル(最低額)から 113,523 米ドル(最高額)まで非常に広範囲に及ぶ
  • 「一人あたり GDP」と「平均寿命」はリニアというより、対数関係のような関係
    → 見やすくするため、x 軸を log 変換 する
  • x = log(gdpPercap) と指定
gapminder %>%
  mutate(pop_m = pop / 1000000) %>% 
  ggplot() +
  geom_point(aes(x = log(gdpPercap), # gdpPercap を log 変換 
                 y = lifeExp)) +
  labs(x = "一人あたりGDP (USD)の対数値", 
       y = "寿命") +
  theme_bw(base_family = "HiraKakuProN-W3")

  • gdpPercap を対数化したら、かなり綺麗な線形関係が確認できた

  • ちなみに、画面の右端にある「一人あたり GDP」 が抜きん出て高い超リッチ国を確かめてみる

gapminder %>% 
  dplyr::filter(gdpPercap > 60000) %>% 
  dplyr::select(year, country, gdpPercap)
# A tibble: 5 × 3
   year country gdpPercap
  <int> <fct>       <dbl>
1  1952 Kuwait    108382.
2  1957 Kuwait    113523.
3  1962 Kuwait     95458.
4  1967 Kuwait     80895.
5  1972 Kuwait    109348.

4.2 大陸と人口を散布図に追加

  • aes() 内に color = countinent を加えて、大陸別に色分けしてみる
  • aes() 内にsize = pop_m と指定して、人口の多寡とドットのサイズをシンクロさせる
  • 点が大きくなると重複して見にくくなる → 点を半透明に設定 (alpha = 0.5)  
  • 分析結果は同じなので、きれいに見える対数化した図を使う: coord_trans(x = "log10")
gapminder %>%
  mutate(pop_m = pop / 1000000) %>% 
  ggplot() +
  geom_point(aes(x = log(gdpPercap), 
                 y = lifeExp, 
                 color = continent,
                 size = pop_m),
             alpha = 0.5) +
  labs(x = "一人あたりGDP (USD)の対数値", 
       y = "寿命",
       size = "人口",
       color = "大陸") +
  theme_bw(base_family = "HiraKakuProN-W3")

  • geom_smooth()を入れて fit 線を描いてみる
gapminder %>% 
  mutate(pop_m = pop / 1000000) %>% 
  ggplot(aes(x = log(gdpPercap), 
             y = lifeExp, 
             col = continent, 
             size = pop_m)) +
  geom_point(alpha = 0.5) +
    labs(x = "一人あたりGDP (USD)の対数値", 
       y = "寿命",
       size = "人口",
       color = "大陸") +
  theme_bw(base_family = "HiraKakuProN-W3") +
  geom_smooth()

4.3 リニアな線を引いてみる

  • geom_smooth(method = lm) と指定してリニアな線を引いてみる
gapminder %>% 
  mutate(pop_m = pop / 1000000) %>% 
  ggplot(aes(x = log(gdpPercap), 
             y = lifeExp, 
             col = continent, 
             size = pop_m)) +
  geom_point(alpha = 0.5) +
    labs(x = "一人あたりGDP (USD)の対数値", 
       y = "寿命",
       size = "人口",
       color = "大陸") +
  theme_bw(base_family = "HiraKakuProN-W3") +
  geom_smooth(method = lm)

4.4 次元ごとに分類して表示

  • facet_wrap(~continent) を指定して、大陸ごとに散布図を別々に描く
gapminder %>% 
  mutate(pop_m = pop / 1000000) %>% 
  ggplot(aes(x = log(gdpPercap), 
             y = lifeExp, 
             col = continent, 
             size = pop_m)) +
  geom_point(alpha = 0.5) +
    labs(x = "一人あたりGDP (USD)の対数値", 
       y = "寿命",
       size = "人口",
       color = "大陸") +
  theme_bw(base_family = "HiraKakuProN-W3") +
  geom_smooth(method = lm) +
  facet_wrap(~continent)

1979年から2007年までの {gapminder} のデータからわかること
・アフリカ大陸、アジア大陸、そしてヨーロッパ大陸では、「一人あたりGDP」が「寿命」に同程度影響している
・「一人あたりGDP」が「寿命」に大きく影響しているのは(つまり、傾きが大きいのは)アメリカ大陸とオセアニア大陸

4.5 特定の国をハイライトして表示

  • 日本、アメリカ、中国のデータを特定してみる
  • {gghighlight} パッケージを使う
library(gghighlight)
gapminder %>% 
  mutate(pop_m = pop / 1000000) %>% 
  ggplot(aes(x = log(gdpPercap), 
             y = lifeExp, 
             col = country, 
             size = pop_m)) +
  geom_point(alpha = 0.5) +
  gghighlight(country %in% c("Japan", "China", "United States"),
              label_params = list(size = 3)) +
    labs(x = "一人あたりGDP (USD)の対数値", 
       y = "寿命",
       size = "人口",
       color = "大陸") +
  theme_bw(base_family = "HiraKakuProN-W3") 

結論 ・いずれの国も、一人あたり GDP が大きくなるにつれて、寿命も大きくなっている
・中国は GDP が 6%-7% の頃に急激に寿命が伸び、その後ののびは緩やか
・アメリカ(青のドット)も一人あたり GDP が大きくなるにつれて、寿命も大きくなっているが、寿命は日本よりも短い

5. 散布図に文字を表示させる

5.1 データの準備

  • ここでは 18 歳有権者と投票率データを使って散布図を考える
  • 第24回 (2016) 参議院議員選挙データ vote_18.csv をダウンロード → RProjectフォルダに保存
  • データを読み込む
hc2016 <- read_csv("data/vote_18.csv")
  • 変数の詳細は次のとおり
変数名 詳細
pref 都道府県
age18 18歳有権者の投票率
age19 19歳有権者の投票率
age1819 18歳と19際有権者の投票率
all 都道府県の投票率
did 都道府県の人口密度
  • データの記述統計を示す

注意:チャンク・オプションには{r, results = "asis"と入力すること

stargazer(data.frame(hc2016), 
          type = "html")
Statistic N Mean St. Dev. Min Max
serial 47 24.000 13.711 1 47
age18 47 48.389 5.307 35.290 62.230
age19 47 38.419 6.033 26.580 53.800
age1819 47 43.446 5.558 30.930 57.840
all 47 54.968 3.887 45.520 62.860
did 47 655.374 1,194.258 68.650 6,168.040
  • {DT}パッケージを使って、インターアクティブなデータの記述統計を表示する
DT::datatable(hc2016)
  • 参考:画面に全てのデータフレームを一気に表示させるだけなら knitr::kable(hr2005) というコマンドを入力

データの出典:

5.2 次元を加えた散布図(都道府県)

5.2.1 散布図を見やすくする方法

「都市度」と「全有権者の投票率」

  • 「都市度」と「全有権者の投票率」の散布図に次元(都道府県名)を加えてみる
  • 「都市度 (did)」を x 軸、「全有権者の投票率 (all)」を y 軸に指定して散布図を描く
  • geom_text() 関数を使って、都道府県を表示させる
hc2016 %>% 
  ggplot(aes(did, all)) +
  geom_point() +
  stat_smooth(method = lm) +
  geom_text(aes(y = all + 0.5, 
                label = pref),
            size = 2, 
            family = "HiraKakuPro-W3") +
  labs(x = "都市度", y = "都道府県の投票率") +
  ggtitle("2016年参院選における投票率(都道府県別)") +
  theme_bw(base_family = "HiraKakuProN-W3")

「都市度 」と「18歳の投票率」の散布図

  • 「都市度 (did)」を x 軸、「18歳の投票率 (age18)」を y 軸に指定して散布図を描く
  • geom_text() 関数を使って、都道府県を表示させる
hc2016 %>% 
  ggplot(aes(did, age18)) +
  geom_point() +
  stat_smooth(method = lm) +
  geom_text(aes(y = age18 + 0.7, 
                label = pref),
            size = 2, 
            family = "HiraKakuPro-W3") +
  labs(x = "都市度", y = "18歳の投票率") +
  ggtitle("2016年参院選における投票率(都道府県別)") +
  theme_bw(base_family = "HiraKakuProN-W3")

  • 都道府県の文字が重なり判別しにくい
  • 人口密度が高いトップ 3 である東京、大阪、神奈川が「外れ値」として右側に孤立している
    → グラフが見にくい

解決策:
(1) 外れ値(この場合だと、東京、大阪、神奈川)をデータに含めない
(2) 値の差が大きい変数(この場合だと、都市度 did)を対数変換する

  • それぞれ試してみる
(1) 特定の「外れ値」を省いた散布図
  • 人口密度が高いトップ 3 である東京、大阪、神奈川をデータから外して散布図を描いてみる
  • この 3 つの都道府県の「都市度」は目視で 2000 以上だとわかる
    dplyr::filter(did < 2000) と指定

{ggrepel}:

  • {ggrepel} パッケージを使って都道府県名の表示を読みやすくばらつかせることができる
hc2016 %>% 
  filter(did < 2000) %>% # 東京、大阪、神奈川を除外する設定  
  ggplot(aes(did, age18)) +
  geom_point() +
  stat_smooth(method = lm) +
  ggrepel::geom_text_repel(aes(label = pref),
            size = 2, 
            family = "HiraKakuPro-W3") +
  labs(x = "都市度", y = "18歳の投票率") +
  ggtitle("2016年参院選における投票率(東京・大阪・神奈川を除く)") +
  theme_bw(base_family = "HiraKakuProN-W3")

  • だいぶ見やすくなった
  • しかし、3つのケースを含めていないというマイナス面がある
(2)「都市度 (did)」 を対数変換した散布図

→ 見やすくするため、x 軸の「都市度 (did)」を log 変換 する

  • x = log(did) と指定
hc2016 %>% 
  ggplot(aes(log(did), age18)) +
  geom_point() +
  stat_smooth(method = lm) +
  geom_text(aes(y = age18 + 0.7, 
                label = pref),
            size = 2, 
            family = "HiraKakuPro-W3") +
  labs(x = "都市度(対数変換済み)", y = "18歳の投票率") +
  ggtitle("2016年参院選における投票率(都市度を対数変換)") +
  theme_bw(base_family = "HiraKakuProN-W3")

  • だいぶ見やすくなった
  • 全てのケースを含めているという利点がある
  • しかし、回帰分析などをする場合、係数の解釈が単純ではないというマイナス面

都道府県名を枠に入れる方法

  • geom_text_repel()関数を使って、都道府県名を枠に入れる方法もある
hc2016 %>% 
  ggplot(aes(log(did), age18)) +
  geom_point() +
  stat_smooth(method = lm) +
  ggrepel::geom_label_repel(aes(label = pref),
            size = 2, 
            family = "HiraKakuPro-W3") +
  labs(x = "都市度(対数変換済み)", y = "18歳の投票率") +
  ggtitle("2016年参院選における投票率(都市度を対数変換)") +
  theme_bw(base_family = "HiraKakuProN-W3")

第24回参議院議員選挙データ (2016) まとめ 都道府県別に分析すると

・「都道府県の投票率」と「都市度」には極めて弱い負の相関がある
  → ほとんど無相関
・しかし「18歳の投票率」と「都市度」には正の相関がある!

5.2.2 特定の点をハイライトしラベル表示する

  • 条件に一致するデータだけをハイライトし、さらに都道府県名を表示させることができる
  • ここでは東北六県だけをハイライトして表示させる
hc2016 %>% 
  ggplot(aes(log(did), age18)) +
  geom_point() +
  geom_text(aes(y = age18 + 0.7, 
                label = pref),
            size = 2, 
            family = "HiraKakuPro-W3") +
  labs(x = "都市度(対数変換済み)", y = "18歳の投票率") +
  ggtitle("2016年参院選における投票率(都市度を対数変換)") +
  theme_bw(base_family = "HiraKakuProN-W3") +  
  gghighlight::gghighlight(
    pref == "青森"|
      pref == "秋田"|
      pref == "岩手"| 
      pref == "山形"| 
      pref == "宮城"| 
      pref == "福島")

  • stat_smooth(method = lm) を追加すれば、全都道府県の回帰直線と東北六県だけの回帰直線を同時に表示することもできる
hc2016 %>% 
  ggplot(aes(log(did), age18)) +
  geom_point() +
  stat_smooth(method = lm) +
  geom_text(aes(y = age18 + 0.7, 
                label = pref),
            size = 2, 
            family = "HiraKakuPro-W3") +
  labs(x = "都市度(対数変換済み)", y = "18歳の投票率") +
  ggtitle("2016年参院選における投票率(都市度を対数変換)") +
  theme_bw(base_family = "HiraKakuProN-W3") +  
  gghighlight::gghighlight(
    pref == "青森"|
      pref == "秋田"|
      pref == "岩手"| 
      pref == "山形"| 
      pref == "宮城"| 
      pref == "福島")

6. 米国下院の政治的二極化の散布図

6.1 データの準備

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

  • DW-NOMINATE score

  • dwnom1(x 軸):経済問題 - - -  -1(リベラル) 〜 1(保守的)

  • dwnom1(y 軸):人種問題 - - -  -1(リベラル) 〜 1(保守的)

  • Sample size: 14552

  • 米国下院議員を対象とした実施したサーベイデータ( congress.csv) をダウンロードする

  • データを読み込み congress と名前をつける

congress <- read_csv("data/congress.csv")
  • 変数を確認する
names(congress)
[1] "congress" "district" "state"    "party"    "name"     "dwnom1"   "dwnom2"  
  • 変数の最初の部分だけ表示
head(congress)
# A tibble: 6 × 7
  congress district state   party    name          dwnom1 dwnom2
     <dbl>    <dbl> <chr>   <chr>    <chr>          <dbl>  <dbl>
1       80        0 USA     Democrat TRUMAN      -0.276   0.0160
2       80        1 ALABAMA Democrat BOYKIN  F.  -0.0260  0.796 
3       80        2 ALABAMA Democrat GRANT  G.   -0.0420  0.999 
4       80        3 ALABAMA Democrat ANDREWS  G. -0.00800 1.00  
5       80        4 ALABAMA Democrat HOBBS  S.   -0.0820  1.07  
6       80        5 ALABAMA Democrat RAINS  A.   -0.170   0.870 
tail(congress)
# A tibble: 6 × 7
  congress district state   party      name     dwnom1   dwnom2
     <dbl>    <dbl> <chr>   <chr>      <chr>     <dbl>    <dbl>
1      112        4 WISCONS Democrat   MOORE    -0.538 -0.458  
2      112        5 WISCONS Republican SENSENBR  1.20  -0.438  
3      112        6 WISCONS Republican PETRI     0.776 -0.00300
4      112        7 WISCONS Republican DUFFY     0.781 -0.270  
5      112        8 WISCONS Republican RIBBLE    0.886 -0.193  
6      112        1 WYOMING Republican LUMMIS    0.932 -0.211  
  • filter() 関数を使って、議会ごとにデータを抜き出す
eighty <- congress %>% 
  filter(congress == 80)  # 第80回議会

twelve <- congress %>% 
  filter(congress == 112) # 第112回議会
  • 抜き出した第80回議会データの文頭を表示
head(eighty)
# A tibble: 6 × 7
  congress district state   party    name          dwnom1 dwnom2
     <dbl>    <dbl> <chr>   <chr>    <chr>          <dbl>  <dbl>
1       80        0 USA     Democrat TRUMAN      -0.276   0.0160
2       80        1 ALABAMA Democrat BOYKIN  F.  -0.0260  0.796 
3       80        2 ALABAMA Democrat GRANT  G.   -0.0420  0.999 
4       80        3 ALABAMA Democrat ANDREWS  G. -0.00800 1.00  
5       80        4 ALABAMA Democrat HOBBS  S.   -0.0820  1.07  
6       80        5 ALABAMA Democrat RAINS  A.   -0.170   0.870 

6.2 第80回議会のデータの散布図

  • 第80回議会のデータの散布図を描いてみる
eighty %>% 
  ggplot(aes(x = dwnom1, y = dwnom2)) +
  geom_point(aes(color = party)) +
  labs(x = "経済問題(dwnom1)",
       y = "人種問題(dwnom2)") +
  ggtitle("US 80th Congress") +
  theme_bw(base_family = "HiraKakuProN-W3") 

  • 人種問題(y 軸)に関して、民主党議員の方が保守的 = グラフの上側(+)に集中している
  • 経済問題に(x 軸)に関して、共和党議員の方が保守的 = グラフの右側(+)に集中している

6.3 第112回議会のデータの散布図

  • 第112回議会のデータの散布図
twelve %>% 
  ggplot(aes(x = dwnom1, y = dwnom2)) +
  geom_point(aes(color = party)) +
  labs(x = "経済問題(dwnom1)",
       y = "人種問題(dwnom2)") +
  ggtitle("US 112th Congress") +
  theme_bw(base_family = "HiraKakuProN-W3")

第80回/121回米国下院サーベイデータ (1947-2012) 分析結果 第80回議会と比較すると、第121回議会では
・人種問題(y 軸)に関して、民主党議員と共和党議員が 0 周辺に集中して分布
・人種問題(y 軸)に関して、民主党議員と共和党議員の間の差が消えた
→ 民主党と共和党の違いを説明する上で、人種問題の見解の違いは意味をなさなくなった
・経済問題に(x 軸)に関して、共和党議員の方が保守的 = グラフの右側(+)に集中
→ 民主党と共和党の違いを説明する上で、経済問題の見解の違いがより重要になった

7. Exercise

  • Q7.1:
    「1.3 ドットの形をカスタマイズ」を参考にして、2009年衆院選における「選挙費用」と「得票率」の散布図を描きなさい
    ・その際、shape = 23 を使い「内側が yellow」で「枠線が magenta」の「」を表示させなさい

  • Q7.2:
    「2.2 ドットの色を変えて次元追加」を参考にして、2009年衆院選における「選挙費用」と「得票率」の散布図を描きなさい
    ・その際、自民党候補者とそれ以外の候補者を色分けして表示させなさい

  • Q7.3:
    「2.4 ドットの色を指定する」を参考にして、2009年衆院選における「選挙費用」と「得票率」の散布図を描きなさい
    ・その際、自民党候補者を red、それ以外の候補者を grey に色分けして表示させなさい

  • Q7.4:
    Q1:「3. 回帰直線を加えた散布図 (1)」を参考にして、2005年衆院選における「選挙費用」と「得票率」の散布図を描きなさい
    ・その際、facet_wrap() 関数を使って政党ごとに散布図を表示させ、自民党と民主党が隣同士になるよう留意しなさい
    Q2::group_by() 関数を使って、政党別の得票率を計算し DT::datatable() 関数を使って結果を表示させなさい

  • Q7.5:
    Q1:「4.5 特定の国をハイライトして表示」を参考にして、{gapminder} を使って「一人あたりGDP (USD)の対数値」と 「寿命」の散布図を表示させなさい
    ・その際、自分が興味ある国を 3 つ選び、色別に表示させなさい
    Q2: 上のグラフからわかることを簡潔にまとめなさい

  • Q7.6:
    Q1:「5.2 次元を加えた散布図(都道府県)」を参考にして、第24回 (2016) 参議院議員選挙において、「都道府県の人口密度 (did)」を x 軸、「19歳有権者の投票率 (age19)」を y 軸とした散布図を描きなさい
    ・必要に応じて変数を対数変換すること
    Q2: 上のグラフからわかることを簡潔にまとめなさい
    参考文献

  • Tidy Animated Verbs

  • 宋財泫 (Jaehyun Song)・矢内勇生 (statuki statanai)「私たちのR: ベストプラクティスの探究」

  • 宋財泫「ミクロ政治データ分析実習(2022年度)」

  • 土井翔平(北海道大学公共政策大学院)「Rで計量政治学入門」

  • 矢内勇生(高知工科大学)授業一覧

  • 浅野正彦, 矢内勇生.『Rによる計量政治学』オーム社、2018年

  • 浅野正彦, 中村公亮.『初めてのRStudio』オーム社、2018年

  • Winston Chang, R Graphics Coo %>%kbook, O’Reilly Media, 2012.

  • Kieran Healy, DATA VISUALIZATION, Princeton, 2019

  • Kosuke Imai, Quantitative Social Science: An Introduction, Princeton University Press, 2017