比較政治学B

教科書（今井 2018）第3章のRコードを整理する。

準備

tidyverseとpatchworkを使うので、（インストール済みでない場合はまずインストールして）パッケージを読み込む。

if(!requireNamespace("tidyverse")) install.packages("tidyverse")
if(!requireNamespace("devtools")) install.packages("devtools")
if(!requireNamespace("patchwork"))  devtools::install_github("thomasp85/patchwork")
library("tidyverse")
library("patchwork")

Macでggplot2を使うときに日本語の文字化けを避けるため、以下を実行する（Windowsユーザは実行しなくてよい）。

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

3.1 戦時における民間人の被害を測定する

アフガニスタンに関するサーベイデータ (afghan.csv) をダウンロードし、プロジェクト内のdataディレクトリに保存する。

download.file(url = "http://qss.princeton.press/student-files/MEASUREMENT/afghan.csv",
              destfile = "data/afghan.csv")

データを読み込み、afghanという名前のデータフレームを作る。

afghan <- read_csv("data/afghan.csv")

## Parsed with column specification:
## cols(
##   province = col_character(),
##   district = col_character(),
##   village.id = col_integer(),
##   age = col_integer(),
##   educ.years = col_integer(),
##   employed = col_integer(),
##   income = col_character(),
##   violent.exp.ISAF = col_integer(),
##   violent.exp.taliban = col_integer(),
##   list.group = col_character(),
##   list.response = col_integer()
## )

データの中身を確認する。

glimpse(afghan)

## Observations: 2,754
## Variables: 11
## $ province            <chr> "Logar", "Logar", "Logar", "Logar", "Logar...
## $ district            <chr> "Baraki Barak", "Baraki Barak", "Baraki Ba...
## $ village.id          <int> 80, 80, 80, 80, 80, 80, 80, 80, 80, 35, 35...
## $ age                 <int> 26, 49, 60, 34, 21, 18, 42, 39, 20, 18, 33...
## $ educ.years          <int> 10, 3, 0, 14, 12, 10, 6, 12, 5, 10, 11, 0,...
## $ employed            <int> 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, ...
## $ income              <chr> "2,001-10,000", "2,001-10,000", "2,001-10,...
## $ violent.exp.ISAF    <int> 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, ...
## $ violent.exp.taliban <int> 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, ...
## $ list.group          <chr> "control", "control", "control", "ISAF", "...
## $ list.response       <int> 0, 1, 1, 3, 3, 2, 1, 3, 1, 2, 2, 3, 1, 1, ...

## 関心のある変数の要約
afghan %>%
  select(age, educ.years, employed, income) %>%
  summary()

##       age          educ.years        employed         income         
##  Min.   :15.00   Min.   : 0.000   Min.   :0.0000   Length:2754       
##  1st Qu.:22.00   1st Qu.: 0.000   1st Qu.:0.0000   Class :character  
##  Median :30.00   Median : 1.000   Median :1.0000   Mode  :character  
##  Mean   :32.39   Mean   : 4.002   Mean   :0.5828                     
##  3rd Qu.:40.00   3rd Qu.: 8.000   3rd Qu.:1.0000                     
##  Max.   :80.00   Max.   :18.000   Max.   :1.0000

ISAFとタリバンから被害を受けたかどうかに関するクロス集計表。

afghan %>%
  with(table(ISAF = violent.exp.ISAF, 
             Taliban = violent.exp.taliban)) %>% 
  prop.table()

##     Taliban
## ISAF         0         1
##    0 0.4953445 0.1318436
##    1 0.1769088 0.1959032

3.2 Rで欠損（欠測）データを扱う

ISAFから被害を受けたことを示す変数 violent.exp.ISAFの中身を確認する。

summary(afghan$violent.exp.ISAF)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##  0.0000  0.0000  0.0000  0.3749  1.0000  1.0000      25

欠測が25個あることがわかる。欠測を含めて分析するため、「被害なし」「被害あり」「無回答」という三つの異なる値をもつカテゴリ変数を新たに作り、isaf という名前をつけよう。そのために、ifelse() 関数を使う。この関数は、ifelse(条件式, 条件式の評価がTRUEのときの値・処理, FALSEのときの値・処理) という使い方をする。以下のコマンドでは、まず is.na()で値が欠測 NA のときには999という値を、それ以外のときには元の値を入れるという処理をした後、factor()で因子型の変数を作る。因子のラベルは、0なら「被害なし」、1なら「被害あり」、999なら「無回答」とする。 NA かどうかを判定するとき、変数 == NAという書き方はできないので注意が必要である。代わりに、is.na(変数) とする。

afghan <- afghan %>% 
  mutate(isaf = ifelse(is.na(violent.exp.ISAF), 999, violent.exp.ISAF)) %>%
  mutate(isaf = factor(isaf, levels = c(0, 1, 999),
                       labels = c("被害なし", "被害あり", "無回答")))

新しく作った変数を確認する。

with(afghan, table(violent.exp.ISAF, isaf, useNA = "ifany"))

##                 isaf
## violent.exp.ISAF 被害なし 被害あり 無回答
##             0        1706        0      0
##             1           0     1023      0
##             <NA>        0        0     25

同様に、タリバンからの被害も無回答も含めて検討するため、taliban という新たな変数を作る。

afghan <- afghan %>% 
  mutate(taliban = ifelse(is.na(violent.exp.taliban), 999, violent.exp.taliban)) %>%
  mutate(taliban = factor(taliban, levels = c(0, 1, 999),
         labels = c("被害なし", "被害あり", "無回答")))

新しく作った変数を確認する。

with(afghan, table(violent.exp.taliban, taliban, useNA = "ifany"))

##                    taliban
## violent.exp.taliban 被害なし 被害あり 無回答
##                0        1812        0      0
##                1           0      888      0
##                <NA>        0        0     54

これらの新しい変数を使ってクロス表を作り直す。

afghan %>%
  with(table(ISAF = isaf, Taliban = taliban)) %>%
  prop.table()

##           Taliban
## ISAF          被害なし    被害あり      無回答
##   被害なし 0.482933914 0.128540305 0.007988381
##   被害あり 0.172476398 0.190994916 0.007988381
##   無回答   0.002541757 0.002904866 0.003631082

3.3 1変量の分布をビジュアル化する

教科書で紹介されている図を、ggplot2パッケージを使って再現する。ggplot2の基本的な使い方については、図表の作成を参照。

3.3.1 棒グラフ

棒グラフは geom_bar() を使って作る。yに何も指定しないと縦軸が度数（count）になるので、割合にするため、countをcountの合計で割ったものをyに指定する。

ISAFの被害を棒グラフにする。

bar_isaf <- ggplot(afghan, aes(x = isaf)) +
  geom_bar(aes(y = ..count.. / sum(..count..))) +
  ylim(0, 0.7) +
  labs(x = "回答カテゴリ", y = "回答者の割合",
       title = "ISAFによる民間人被害")
print(bar_isaf)

タリバンの被害を棒グラフにする。

bar_taliban <- ggplot(afghan, aes(x = taliban)) +
  geom_bar(aes(y = ..count.. / sum(..count..))) +
  ylim(0, 0.7) +
  labs(x = "回答カテゴリ", y = "回答者の割合",
       title = "タリバンによる民間人被害")
print(bar_taliban)

教科書のレイアウトのように二つの図を並べて表示する方法は色々あるが、最も簡単なのは、patchworkパッケージを使う方法である。パッケージを読み込んだら（このページの冒頭で読み込み済みのはず）、ggplot2で作った複数の図を + で繋げば、並べて表示してくれる。

print(bar_isaf + bar_taliban)

3.3.2 ヒストグラム

ヒストグラムは geom_histogram() を使って作る。デフォルトの縦軸は度数 (count, frequency) である。縦軸を確率密度 (probability density) に変えたいときは、y = ..density.. とする。ビンの幅は binwidthで指定できる。また、ビンの縁の色はcolorで、ビンを塗りつぶす色は fill で指定できる。

回答者の年齢のヒストグラムを作る。

hist_age <- ggplot(afghan) +
  geom_histogram(aes(x = age, y = ..density..), binwidth = 5, boundary = 15,
                 color = "black", fill = "dodgerblue") +
  labs(x = "年齢", y = "確率密度", title = "回答者の年齢分布")
print(hist_age)

教育年数のヒストグラムを作る。

hist_edu <- ggplot(afghan) +
  geom_histogram(aes(x = educ.years, y = ..density..),
                 binwidth = 1, boundary = -0.5,
                 color = "black") +
  labs(x = "教育を受けた年数", y = "確率密度",
       title = "回答者の教育程度の分布") +
  geom_text(x = 2, y = 0.5, label = "中央値", color = "tomato",
            family = "HiraginoSans-W3") +       # ラベルを追加
  geom_vline(xintercept = median(afghan$educ.years),
             color = "tomato", linetype = "dashed") # 中央値を表す縦線を追加
print(hist_edu)

3.3.3 箱ひげ図

箱ひげ図は、geom_boxplot()を使って作る。

年齢の箱ひげ図を作る。

box_age <- ggplot(afghan, aes(y = age)) +
  geom_boxplot(width = 100) +
  labs(x = "", y = "年齢", title = "年齢の分布") +
  theme(axis.ticks.x = element_blank(),   # x軸の目盛り線を消す
        axis.text.x = element_blank()) +  # x軸の目盛りラベルを消す
  coord_fixed(ratio = 3)    # 箱を少し縦長にする
print(box_age)

州ごとの教育年数の分布を箱ひげ図で確認する。

box_age_prov <- ggplot(afghan, aes(x = province, y = educ.years)) +
  geom_boxplot() +
  labs(x = "州 (province)", y = "教育を受けた年数",
       title = "州別の教育程度")
print(box_age_prov)

州別の被害報告割合を調べる。dplyr::group_by() を使えば簡単にできる。

afghan %>%
  group_by(province) %>%
  summarize(Taliban = mean(violent.exp.taliban, na.rm = TRUE),
            ISAF = mean(violent.exp.ISAF, na.rm = TRUE))

## # A tibble: 5 x 3
##   province Taliban  ISAF
##   <chr>      <dbl> <dbl>
## 1 Helmand   0.504  0.541
## 2 Khost     0.233  0.242
## 3 Kunar     0.303  0.399
## 4 Logar     0.0802 0.144
## 5 Uruzgan   0.455  0.496

3.3.4 グラフの印刷と保存

ggplot2で作った図の保存については図表の作成を参照。

3.4 標本調査

3.4.1 ランダム化の役割

村に関するデータ (afghan-village.csv) をダウンロードし、プロジェクト内のdataディレクトリに保存する。

download.file(url = "http://qss.princeton.press/student-files/MEASUREMENT/afghan-village.csv",
              destfile = "data/afghan-village.csv")

データを読み込み、afghan_village という名前のデータフレームを作る。

afghan_village <- read_csv("data/afghan-village.csv")

## Parsed with column specification:
## cols(
##   altitude = col_double(),
##   population = col_integer(),
##   village.surveyed = col_integer()
## )

中身を確認する。

glimpse(afghan_village)

## Observations: 1,864
## Variables: 3
## $ altitude         <dbl> 1959.08, 2425.88, 2236.60, 1691.76, 1928.04, ...
## $ population       <int> 197, 744, 179, 225, 379, 617, 940, 1817, 213,...
## $ village.surveyed <int> 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ...

このサーベイで抽出された村かどうかを示す village.surveyed 変数を因子型に変えた village_s という変数を新たに作ろう。

afghan_village <- afghan_village %>% 
  mutate(village_s = factor(village.surveyed, levels = 0:1,
                            labels = c("非抽出", "抽出")))

新たに作った変数を確認しておく。

with(afghan_village, table(village.surveyed, village_s))

##                 village_s
## village.surveyed 非抽出 抽出
##                0   1660    0
##                1      0  204

標高の箱ひげ図を作る。

box_altitude <- ggplot(afghan_village, aes(x = village_s, y = altitude)) +
  geom_boxplot() +
  labs(x = "", y = "標高（メートル）")
print(box_altitude)

対数人口の箱ひげ図を作る。

box_logpop <- ggplot(afghan_village, aes(x = village_s, y = log(population))) +
  geom_boxplot() +
  labs(x = "", y = "対数人口") +
  scale_y_continuous(breaks = seq(2, 10, by = 2))  # y軸の目盛りを調整
print(box_logpop)

二つの箱ひげ図を並べて表示する。

print(box_altitude + box_logpop)

3.4.2 無回答とその他のバイアスの発生要因

被害の有無に関する無回答の割合を州別に確認する。

afghan %>% 
  group_by(province) %>%
  summarize(Taliban無回答 = mean(is.na(violent.exp.taliban)),
            ISAF無回答 = mean(is.na(violent.exp.ISAF)))

## # A tibble: 5 x 3
##   province Taliban無回答 ISAF無回答
##   <chr>            <dbl>      <dbl>
## 1 Helmand        0.0304     0.0164 
## 2 Khost          0.00635    0.00476
## 3 Kunar          0          0      
## 4 Logar          0          0      
## 5 Uruzgan        0.0620     0.0207

アイテムカウント法（リスト実験）で、ISAFの支持率の推定する。

afghan %>%
  filter(list.group != "taliban") %>%
  group_by(list.group) %>%
  summarize(mean = mean(list.response)) %>%
  spread(key = list.group, value = mean) %>%
  mutate(support = ISAF - control) %>%
  select(support)

## # A tibble: 1 x 1
##   support
##     <dbl>
## 1  0.0490

床面効果と天井効果の確認。

with(afghan, table(回答 = list.response, グループ = list.group))

##     グループ
## 回答 control ISAF taliban
##    0     188  174       0
##    1     265  278     433
##    2     265  260     287
##    3     200  182     198
##    4       0   24       0

3.5 政治的分極化を測定する

コードがないので省略。

3.6 2変量関係の要約

合衆国下院議員の理想点 (ideal point) に関するデータ (congress.csv) をダウンロードし、プロジェクト内のdataディレクトリに保存する。

download.file(url = "http://qss.princeton.press/student-files/MEASUREMENT/congress.csv",
              destfile = "data/congress.csv")

データを読み込み、congress という名前のデータフレームを作る。

congress <- read_csv("data/congress.csv")

## Parsed with column specification:
## cols(
##   congress = col_integer(),
##   district = col_integer(),
##   state = col_character(),
##   party = col_character(),
##   name = col_character(),
##   dwnom1 = col_double(),
##   dwnom2 = col_double()
## )

中身を確認する。

glimpse(congress)

## Observations: 14,552
## Variables: 7
## $ congress <int> 80, 80, 80, 80, 80, 80, 80, 80, 80, 80, 80, 80, 80, 8...
## $ district <int> 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 98, 98, 1, 2, 3, 4, 5, ...
## $ state    <chr> "USA", "ALABAMA", "ALABAMA", "ALABAMA", "ALABAMA", "A...
## $ party    <chr> "Democrat", "Democrat", "Democrat", "Democrat", "Demo...
## $ name     <chr> "TRUMAN", "BOYKIN  F.", "GRANT  G.", "ANDREWS  G.", "...
## $ dwnom1   <dbl> -0.276, -0.026, -0.042, -0.008, -0.082, -0.170, -0.12...
## $ dwnom2   <dbl> 0.016, 0.796, 0.999, 1.005, 1.066, 0.870, 0.990, 0.89...

政党を表す party の中身を確認してみる。

with(congress, table(party))

## party
##   Democrat      Other Republican 
##       8132         19       6401

民主党 (Democrat)、共和党 (Republican)、その他 (Other) の三つのカテゴリがあることがわかる。作図するときに民主党と共和党だけをプロットするため、その他をNAにした新たな変数 party2 を作ろう。その際、民主党の値を blue、共和党の値を red にする。これは、これらの色をggpplot2で使うための工夫である。

congress <- congress %>%
  mutate(party2 = ifelse(party == "Other", NA, party),
         party2 = ifelse(party == "Democrat", "blue", party2),
         party2 = ifelse(party == "Republican", "red", party2))

作った変数の中身を確認してみよう。

with(congress, table(party, party2, useNA = "ifany"))

##             party2
## party        blue  red <NA>
##   Democrat   8132    0    0
##   Other         0    0   19
##   Republican    0 6401    0

望み通りの変数ができた。

3.6.1 散布図

第80議会の散布図を作る。

scat_c80 <- congress %>%
  filter(congress == 80) %>%   ## 第80議会を抜き出す
  ggplot(aes(x = dwnom1, y = dwnom2,
             color = party2, shape = party2)) + # 点の色と形を政党ごとに変える
  geom_point() +
  xlim(-1.5, 1.5) + ylim(-1.5, 1.5) +    # 表示範囲を指定
  scale_color_identity(guide = FALSE) +  # 点の色をparty2で指定したものにし、凡例を非表示に
  scale_shape_discrete(guide = FALSE) +   # 点の形の凡例を非表示にする
  geom_text(x = -1, y = 1, label = "民主党",
            color = "blue", family = "HiraginoSans-W3") +
  geom_text(x = 1, y = -1, label = "共和党",
            color = "red", family = "HiraginoSans-W3") +
  labs(x = "経済的リベラル vs 保守", y = "人種的リベラル vs 保守",
       title = "第80議会")
print(scat_c80)

第112議会の散布図を作る。

scat_c112 <- congress %>%
  filter(congress == 112) %>%   ## 第112議会を抜き出す
  ggplot(aes(x = dwnom1, y = dwnom2,
             color = party2, shape = party2)) + # 点の色と形を政党ごとに変える
  geom_point() +
  xlim(-1.5, 1.5) + ylim(-1.5, 1.5) +    # 表示範囲を指定
  scale_color_identity(guide = FALSE) +  # 点の色をparty2で指定したものにし、凡例を非表示に
  scale_shape_discrete(guide = FALSE) +  # 点の形の凡例を非表示にする
  geom_text(x = -1, y = 1, label = "民主党",
            color = "blue", family = "HiraginoSans-W3") +
  geom_text(x = 1, y = -1, label = "共和党",
            color = "red", family = "HiraginoSans-W3") +
  labs(x = "経済的リベラル vs 保守", y = "人種的リベラル vs 保守",
       title = "第112議会")
print(scat_c112)

二つの図を並べて表示。

print(scat_c80 + scat_c112)

経済的リベラル/保守に関して、政党別、各議会別に、議員の理想点の中央値を計算する。

dwnom1_med <- congress %>% 
  filter(party != "Other") %>%
  group_by(party, congress) %>%
  summarize(median = median(dwnom1),
            party_color = party2[1])
head(dwnom1_med)

## # A tibble: 6 x 4
## # Groups:   party [1]
##   party    congress median party_color
##   <chr>       <int>  <dbl> <chr>      
## 1 Democrat       80 -0.126 blue       
## 2 Democrat       81 -0.207 blue       
## 3 Democrat       82 -0.179 blue       
## 4 Democrat       83 -0.174 blue       
## 5 Democrat       84 -0.223 blue       
## 6 Democrat       85 -0.231 blue

各党の中央値の時系列プロットを作る。

line_dwnom1 <- ggplot(dwnom1_med, aes(x = congress, y = median,
                                      color = party_color, linetype = party_color)) +
  geom_line() +
  ylim(-1, 1) +
  scale_color_identity(guide = FALSE) +
  scale_linetype_discrete(guide = FALSE) +
  geom_text(x = 110, y = 0.8, label = "共和党",
            color = "red", family = "HiraginoSans-W3") +
  geom_text(x = 110, y = -0.5, label = "民主党",
            color = "blue", family = "HiraginoSans-W3") +
  labs(x = "議会会期", y = "DW-NOMINATEスコア（第1次元）の中央値")
print(line_dwnom1)

3.6.2 相関

合衆国のジニ係数に関するデータ (USgini.csv) をダウンロードし、プロジェクト内のdataディレクトリに保存する。

download.file(url = "http://qss.princeton.press/student-files/MEASUREMENT/USGini.csv",
              destfile = "data/USgini.csv")

データを読み込み、gini という名前のデータフレームを作る。

gini <- read_csv("data/USgini.csv")

## Parsed with column specification:
## cols(
##   X1 = col_integer(),
##   year = col_integer(),
##   gini = col_double()
## )

中身を確認する。

glimpse(gini)

## Observations: 67
## Variables: 3
## $ X1   <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17...
## $ year <int> 1947, 1948, 1949, 1950, 1951, 1952, 1953, 1954, 1955, 195...
## $ gini <dbl> 0.376, 0.371, 0.378, 0.379, 0.363, 0.368, 0.359, 0.371, 0...

各政党の理想点中央値を記録したdwnom1_med を変形して、分極化の程度（共和党と民主党の距離）を計算する変数distanceを作る。また、各議会に対応する年を表す変数yearを作る。

pol <- dwnom1_med %>%
  select(-party_color) %>%
  spread(key = party, value = median) %>%
  mutate(distance = Republican - Democrat) %>%
  arrange(congress) %>%  # 念のためにcongressを古い順（昇順）に並べ替える
  mutate(year = seq(1948, 2012, by = 2))
head(pol)

## # A tibble: 6 x 5
##   congress Democrat Republican distance  year
##      <int>    <dbl>      <dbl>    <dbl> <dbl>
## 1       80   -0.126      0.266    0.392  1948
## 2       81   -0.207      0.262    0.469  1950
## 3       82   -0.179      0.261    0.440  1952
## 4       83   -0.174      0.257    0.431  1954
## 5       84   -0.223      0.251    0.474  1956
## 6       85   -0.231      0.245    0.476  1958

党派性の違いの時系列グラフを作る。

plt_distance <- ggplot(pol, aes(x = year, y = distance)) +
  geom_point() +
  labs(x = "年", y = "理想点の距離\n共和党中央値 - 民主党中央値", # \n で改行できる
       title = "政治的分極化")
print(plt_distance)

ジニ係数の時系列グラフを作る。

plt_gini <- ggplot(gini, aes(x = year, y = gini)) +
  geom_point() +
  ylim(0.35, 0.45) +
  labs(x = "年", y = "ジニ係数", title = "所得の不平等")
print(plt_gini)

並べて表示してみる。

print(plt_distance + plt_gini)

相関係数を計算する。

pol %>% 
  left_join(gini, by = "year") %>% # 二つのデータフレームで同じyearがある行だけ合体させる
  with(cor(gini, distance))

## [1] 0.9418128

3.6.3 Q-Qプロット

人種的リベラル/保守について、第112議会の理想点の分布を政党別に表示する。ggplotのfacetを利用する。

hist_dwnom2 <- congress %>%
  filter(party != "Other", congress == 112) %>%
  mutate(party = factor(party, levels = c("Democrat", "Republican"),
                        labels = c("民主党", "共和党"))) %>%
  ggplot(aes(x = dwnom2, y = ..density..)) +
  geom_histogram(color = "black", binwidth = 0.2, boundary = 0) +
  xlim(-1.5, 1.5) +
  facet_grid(. ~ party) +  # party 毎にヒストグラムを作って並べる
  labs(x = "人種的リベラル vs 保守", y = "確率密度")
print(hist_dwnom2)

QQプロットで民主党と共和党の分布を比較する。

## 第112議会の民主党のdwnom2を抜き出す
dem112_dwnom2 <- congress %>%
  filter(congress == 112, party == "Democrat") %>%
  pull(dwnom2)
## 第112議会の共和党のdwnom2を抜き出す
rep112_dwnom2 <- congress %>%
  filter(congress == 112, party == "Republican") %>%
  pull(dwnom2)
qq_112 <- qqplot(dem112_dwnom2, rep112_dwnom2, plot.it = FALSE) %>%
  as_data_frame() %>%   # qqplot() の出力をデータフレームに変換する
  ggplot(aes(x, y)) +
  geom_point() +
  geom_abline(intercept = 0, slope = 1, color = "gray") +  # 45度線を足す
  xlim(-1.5, 1.5) + ylim(-1.5, 1.5) +
  coord_fixed() + # 縦軸と横軸のスケールを揃える
  labs(x = "民主党", y = "共和党", title = "人種的リベラル vs 保守")
print(qq_112)

3.7 クラスター化

3.7.1 Rにおける行列

データフレームの作成はdata.frame()でできるが、この授業では、tibble::data_frame() を代わりに使う。tibble パッケージはtidyverseに含まれるので、tidyverseさえ読み込めば使える。違いを確認しよう。

Y <- data.frame(y1 = as.factor(c("a", "b", "c")),
                y2 = c(0.1, 0.2, 0.3))
Z <- data_frame(z1 = as.factor(letters[1:3]),
                y2 = seq(0.1, 0.3, by = 0.1))
class(Y)

## [1] "data.frame"

class(Z)

## [1] "tbl_df"     "tbl"        "data.frame"

3.7.2 Rにおけるリスト

特に追加すべき情報はないので省略する。

3.7.3 k平均法

2クラスターの\(k\)平均法を、第80議会と第112議会で実行する。

k80two_out <- congress %>%
  filter(congress == 80) %>%
  select(dwnom1, dwnom2) %>%
  kmeans(centers = 2, nstart = 5)
k112two_out <- congress %>%
  filter(congress == 112) %>%
  select(dwnom1, dwnom2) %>%
  kmeans(centers = 2, nstart = 5)

2クラスターモデルの最終中心点を確認する。

k80two_out$centers

##        dwnom1     dwnom2
## 1 -0.04843704  0.7827259
## 2  0.14681029 -0.3389293

k112two_out$centers

##       dwnom1     dwnom2
## 1 -0.3912687 0.03260696
## 2  0.6776736 0.09061157

政党とクラスターのクロス集計表。

congress %>%
  filter(congress == 80) %>%
  with(table(政党 = party, クラスター = k80two_out$cluster))

##             クラスター
## 政党         1   2
##   Democrat   132  62
##   Other        0   2
##   Republican   3 247

congress %>%
  filter(congress == 112) %>%
  with(table(政党 = party, クラスター = k112two_out$cluster))

##             クラスター
## 政党         1   2
##   Democrat   200   0
##   Republican   1 242

4クラスターの\(k\)平均法を、第80議会と第112議会で実行する。

k80four_out <- congress %>%
  filter(congress == 80) %>%
  select(dwnom1, dwnom2) %>%
  kmeans(centers = 4, nstart = 5)
k112four_out <- congress %>%
  filter(congress == 112) %>%
  select(dwnom1, dwnom2) %>%
  kmeans(centers = 4, nstart = 5)

結果を図示する。

plt_k80four <- congress %>%
  filter(congress == 80) %>%
  ggplot(aes(x = dwnom1, y = dwnom2)) +
  geom_point(aes(color = as.factor(k80four_out$cluster))) +
  geom_point(data = as_data_frame(k80four_out$centers), 
             pch = 8) +                      # 中心点
  scale_color_discrete(guide = FALSE) +
  xlim(-1.5, 1.5) + ylim(-1.5, 1.5) +
  coord_fixed() +
  labs(x = "経済的リベラル vs 保守", y = "人種的リベラル vs 保守",
       title = "第80議会")
plt_k112four <- congress %>%
  filter(congress == 112) %>%
  ggplot(aes(x = dwnom1, y = dwnom2)) +
  geom_point(aes(color = as.factor(k112four_out$cluster))) +
  geom_point(data = as_data_frame(k112four_out$centers), 
             pch = 8) +                       # 中心点
  scale_color_discrete(guide = FALSE) +
  xlim(-1.5, 1.5) + ylim(-1.5, 1.5) +
  coord_fixed() +
  labs(x = "経済的リベラル vs 保守", y = "人種的リベラル vs 保守",
       title = "第112議会")
print(plt_k80four + plt_k112four)

授業の内容に戻る

比較政治学B

測定

矢内　勇生

2018-09-21

準備

3.1 戦時における民間人の被害を測定する

3.2 Rで欠損（欠測）データを扱う

3.3 1変量の分布をビジュアル化する

3.3.1 棒グラフ

3.3.2 ヒストグラム

3.3.3 箱ひげ図

3.3.4 グラフの印刷と保存

3.4 標本調査

3.4.1 ランダム化の役割

3.4.2 無回答とその他のバイアスの発生要因

3.5 政治的分極化を測定する

3.6 2変量関係の要約

3.6.1 散布図

3.6.2 相関

3.6.3 Q-Qプロット

3.7 クラスター化

3.7.1 Rにおける行列

3.7.2 Rにおけるリスト

3.7.3 k平均法

比較政治学B

測定

矢内 勇生

2018-09-21

準備

3.1 戦時における民間人の被害を測定する

3.2 Rで欠損（欠測）データを扱う

3.3 1変量の分布をビジュアル化する

3.3.1 棒グラフ

3.3.2 ヒストグラム

3.3.3 箱ひげ図

3.3.4 グラフの印刷と保存

3.4 標本調査

3.4.1 ランダム化の役割

3.4.2 無回答とその他のバイアスの発生要因

3.5 政治的分極化を測定する

3.6 2変量関係の要約

3.6.1 散布図

3.6.2 相関

3.6.3 Q-Qプロット

3.7 クラスター化

3.7.1 Rにおける行列

3.7.2 Rにおけるリスト

3.7.3 k平均法

矢内　勇生