課題3 相関とカテゴリカルデータ
大森愛弓 22W1402006K
2024年6月1日
この課題の目標
- 散布図と相関係数の理解
- クラスター分析による分類法の理解
- カテゴリカルデータの理解
使用データ
今回使用するデータは、東京大学谷口研究室と朝日新聞が実施した2022年参院選有権者・政治家調査データです(https://www.masaki.j.u-tokyo.ac.jp/utas/utasindex.html#2022)。政治家調査と有権者調査には同じ質問が含まれていますから、両者をデータフレームに取り入れて比較することを目指します。設問1. パッケージとデータの読み込み
- 各チャンク内のコメントの指示に従って、チャンク内に適切なスクリプトを書いた上で、KnitしPDFファイルを作成してください。
- 今回使用するパッケージは、tidyverse,
cluster,factoextra,ca,vcdです。インストールしていない場合には、先にインストールをおこなっておいてください。
- データはmanabaにアップロードしているtodai2022_pol.csvとtodai2022_vot.csvです。それぞれどんな質問と選択肢があるのかはコードブック（Wordファイル）を確認してください。
パッケージの読み込み
library(readxl)
library(tidyverse)
# どのパッケージが何の分析で用いているのかを動画や冊子、授業用のファイルなどで確認するようにしてください。データの読み込み
pol <- read_csv("todai2022_pol.csv",locale = locale(encoding = "SHIFT-JIS"))
vot <- read_csv("todai2022_vot.csv",locale = locale(encoding = "SHIFT-JIS"))
# 有権者調査データ、政治家調査データをそれぞれ、vot,polというデータフレームとして読み込む。
# このcsvデータの文字コードがshift-JISで、Rがデフォルトしている文字コードUNICODEと異なるため、このまま読み込むと日本語部分が文字化けを起こします。
# そこで、read_csv("ファイル名.csv", locale = locale(encoding = "CP932")) のようにして文字コードを指定するようにしてください。CP932の部分はSHIFT-JISと書いても構いません。設問2. 散布図の作成と相関係数の算出
- 政治家調査データを用いて、候補者の年齢をX軸に当選回数をY軸とした散布図を作成してください。
- 年齢と当選回数との相関係数を算出してください。
- 現職・元職のみに限定して散布図を作成し、相関係数を求めてください。
- 候補者全体と現職・元職とを比較してわかることを記載してください。
候補者の年齢と当選回数
ggplot(pol, aes(AGE , TERM)) + geom_point() + labs(x = "年齢" , y ="当選回数")
with(pol,cor(AGE,TERM))[1] 0.3954279pol1 <- pol %>% filter(INCUMB == 2 | INCUMB == 2)
pol_1 <- ggplot(pol1,aes(AGE , TERM)) + geom_point() + labs(x = "年齢" , y = "当選回数")
print(pol_1)
with(pol1,cor(AGE,TERM))[1] 0.2258406# 特定のケースだけ取り出すには、*filter*関数を使います
# 散布図はggplotのうち、geom_pointで作成します。
# 相関係数はcorで求められます。- 候補者全体の年齢と当選回数との相関係数は約0.40で、現職・元職に限定した場合の相関係数は約0.23(←算出した数値を入力)である
- 両者を比較すると候補者全体の方が現職・元職に限った場合と比較して、年齢と当選の相関係数が高いことがわかる。
設問3. クラスター分析
- 候補者調査データにおいて、自民党に対する感情温度（Q2_1)と岸田首相に対する感情温度(Q2_7)を用いてk-means法によって非階層クラスタリングをおこなってください。その際、クラスの数を2つ～5つに変えてみて、もっとも「うまく」分類できていると思えるものを探してみてください。
- 今回使う変数は、非該当＝666、無回答＝999とコーディングされているため、最初に666、999が入力されている候補者（データ上の行）を削除する必要があります。filter関数で該当する列を除外してください。
非階層クラスタリング
library(tidyverse)
library(cluster)
library(factoextra)
pol <- read_csv("todai2022_pol.csv",locale = locale(encoding = "SHIFT-JIS"))
polass <- pol %>% filter(Q2_1 < 666 & Q2_7 < 666) %>% select(Q2_1 , Q2_7)
kmpol2 <- kmeans(polass,2)
kmpol3 <- kmeans(polass,3)
kmpol4 <- kmeans(polass,4)
kmpol5 <- kmeans(polass,5)
fviz_cluster(kmpol2,data = polass)
fviz_cluster(kmpol3,data = polass)
fviz_cluster(kmpol4,data = polass)
fviz_cluster(kmpol5,data = polass)
# 必要な変数のみ取り出して、新たなデータフレームを作成しておく。
# kmeans(データフレーム, クラスター数)
# 結果を図示するためには、fviz_cluster()を使う- クラスター分析の結果、自民党に対する感情温度と岸田首相に対する感情温度は単純な関係ではなく、多様であるということがわかった。（←Xに文章を入力）
- 候補者をもっとも「うまく」分類しているのは、クラスター数が5（←数値を入力）のときである。
階層クラスタリング
- 上記と同じ変数でウォード法による階層クラスタリングをおこなってください。
- デンドログラムを作成して、類似度からいくつに分類するのが適切か判定してください。
dispol <- dist(polass)
hcpol <- hclust(dispol,"ward.D2")
plot(hcpol)
# 最初にdist関数でケースの類似度(距離)を測定する
# hclust(ケースの類似度データ, "方法")
# 今回はウォード法を使うのでward.D2と指定する- 判定した分類数に基づいてcutree関数を用いてケースを分割し、候補者の所属政党との関係をクロス表に示してください。
cut_result <- cutree(hcpol,h=200)
cut_result [1] 1 2 3 1 4 4 2 1 3 1 1 1 3 2 1 1 2 1 4 3 1 4 1 1 1 4 3 2 3 1 1 4 1 2 1 3 1
[38] 3 2 1 3 4 2 1 4 4 4 2 1 3 1 1 1 2 1 4 3 3 3 1 1 4 2 1 4 4 4 1 4 2 1 2 1 4
[75] 1 1 3 3 4 3 3 3 4 1 3 3 1 4 3 1 3 2 3 1 4 1 1 2 4 1 4 2 1 1 2 3 2 1 2 3 1
[112] 3 4 4 1 4 2 4 2 3 3 3 3 4 1 3 1 1 1 1 1 2 3 2 2 1 1 1 4 1 1 1 4 1 3 2 2 4
[149] 3 3 2 4 3 2 1 4 1 4 4 1 2 3 3 4 4 3 1 2 3 3 3 4 4 2 4 4 4 1 3 3 2 3 3 1 1
[186] 3 2 4 2 3 3 1 4 3 4 1 3 1 3 2 3 3 4 4 2 3 1 1 3 1 1 4 3 2 2 1 3 4 4 3 2 1
[223] 4 2 3 4 3 4 4 1 4 3 3 1 4 3 3 1 1 4 1 1 1 4 3 3 3 2 3 4 4 4 1 1 4 2 1 3 1
[260] 3 4 3 2 3 4 1 4 3 1 3 1 1 3 2 2 1 1 1 3 1 4 2 4 2 3 2 4 3 1 4 2 1 3 2 1 3
[297] 3 4 3 4 1 1 1 1 1 4 2 4 1 3 1 3 4 1 4 2 3 3 1 3 4 2 3 3 1 3 2 2 2 2 2 2 2
[334] 2 2 2 2 3 2 2 2 2 2 3 2 2 2 2 2 2 2 2 3 2 2 2 2 2 2 2 1 4 4 1 1 1 4 4 3 3
[371] 3 3 3 3 3 3 3 3 3 3 3 1 3 3 3 1 3 3 3 3 3 3 1 3 3 3 3 3 4 4 4 4 4 4 4 4 4
[408] 4 4 4 4 1 4 1 4 4 4 4 3 3 3 3 3 4 1 1 4 4 4 4 1 4 1 4 4 4 4 4 1 4 3 1 3 3
[445] 4 3 1 1 1 1 4 1 1 4 4 4poldelete <- pol %>% filter(Q2_1 < 666 & Q2_7 < 666)
# デンドログラムの高さをみてcutree関数のh=数値を決める
# クロス表をつくる際に、polデータフレームからQ2_1とQ2_7の欠損値を除外したデータフレームを新たにつくった上で、そのデータフレームのPARTY変数とのクロス表を作らないと互いのデータフレームのケース数があわなくてエラーが発生します。- h数値に200，250を入力したが、デンドログラムの結果はいずれの値の場合も4つに分類することが適切であることが示された。
設問4. カテゴリカル変数のクロス集計
- 動画では扱っていませんが、janitorというパッケージのtabyl関数を使うと簡単にクロス集計表を作成できます。
- 今回はtabyl関数を用いたクロス集計表を作成します。まずは、janitorパッケージをインストールしておいてください。
tabylを用いたクロス表: 「小さな政府への賛否」の有権者・政治家比較
- 最初にjanitorパッケージを読み込みます
- 今回は候補者調査と有権者調査で同じ質問が尋ねられている項目のうち、「小さな政府への賛否」を比較します(政治家調査Q4_9, 有権者調査Q43_5)。
- クロス表は政治家調査では「所属政党(PARTY)」×「小さな政府への賛否(Q4_9)」とし、有権者調査では「長期的党派性(Q41)」×「小さな政府への賛否(Q43_5)」とします。
- 作成例として候補者調査データでのクロス表の作り方を記載していますので、これを参考に有権者データで同様のクロス表を作成してください。
- 分析で取り上げる政党は、自民、公明、立憲、維新、共産、国民の6党とします。
library(janitor) # janitorパッケージの読み込み
# 候補者調査でのクロス表の作り方
pol_cross <- pol %>% filter(Q4_9 <= 5) # 欠損値と分析から除外する政党候補者を取り除いて新たなデータフレームを作成する
# データフレーム %>% tabyl(変数1, 変数2)でクロス集計表を作成できる
# ↑のスクリプトに %>% をつなげて割合での表示などがおこなえる
pol_tab <- pol_cross %>% tabyl(PARTY,Q4_9)
pol_tab %>% adorn_totals(c("row","col")) %>% # 行列それぞれの合計値を示す
adorn_percentages("row") %>% # 行ごとに割合を示すスクリプト "col"とすると列ごとに示せる
adorn_pct_formatting(digits = 2) %>% # パーセント表示の桁数を示す
adorn_ns() # パーセントの後ろに括弧で実数を表示する PARTY 1 2 3 4 5
1 0.00% (0) 0.00% (0) 33.78% (25) 44.59% (33) 21.62% (16)
2 0.00% (0) 0.00% (0) 8.00% (4) 36.00% (18) 56.00% (28)
3 0.00% (0) 0.00% (0) 33.33% (8) 45.83% (11) 20.83% (5)
4 0.00% (0) 8.70% (4) 82.61% (38) 4.35% (2) 4.35% (2)
5 0.00% (0) 0.00% (0) 13.64% (3) 45.45% (10) 40.91% (9)
6 0.00% (0) 0.00% (0) 0.00% (0) 3.45% (2) 96.55% (56)
7 0.00% (0) 0.00% (0) 8.33% (1) 0.00% (0) 91.67% (11)
8 0.00% (0) 0.00% (0) 0.00% (0) 0.00% (0) 100.00% (13)
9 9.59% (7) 17.81% (13) 43.84% (32) 13.70% (10) 15.07% (11)
10 4.00% (2) 4.00% (2) 72.00% (36) 8.00% (4) 12.00% (6)
11 14.81% (8) 18.52% (10) 5.56% (3) 14.81% (8) 46.30% (25)
12 6.67% (2) 3.33% (1) 26.67% (8) 36.67% (11) 26.67% (8)
Total 3.75% (19) 5.93% (30) 31.23% (158) 21.54% (109) 37.55% (190)
Total
100.00% (74)
100.00% (50)
100.00% (24)
100.00% (46)
100.00% (22)
100.00% (58)
100.00% (12)
100.00% (13)
100.00% (73)
100.00% (50)
100.00% (54)
100.00% (30)
100.00% (506)# 上記の例を参考にして、以下に有権者調査データでクロス表を作成してください。
vot_cross <- vot%>% filter(Q41 < 99 & Q43_5 <= 5)
vot_tab <- vot_cross %>% tabyl(Q41,Q43_5)
vot_tab %>% adorn_totals(c("row","col")) %>%
adorn_percentages("row") %>%
adorn_pct_formatting(digits = 2) %>%
adorn_ns() Q41 1 2 3 4 5
1 6.70% (54) 10.30% (83) 36.85% (297) 30.77% (248) 15.38% (124)
2 4.92% (9) 10.93% (20) 29.51% (54) 33.33% (61) 21.31% (39)
3 8.48% (14) 15.15% (25) 28.48% (47) 30.30% (50) 17.58% (29)
4 5.38% (5) 9.68% (9) 23.66% (22) 46.24% (43) 15.05% (14)
5 3.23% (2) 16.13% (10) 33.87% (21) 20.97% (13) 25.81% (16)
6 10.53% (4) 13.16% (5) 31.58% (12) 18.42% (7) 26.32% (10)
7 12.50% (4) 9.38% (3) 43.75% (14) 15.62% (5) 18.75% (6)
8 16.67% (4) 12.50% (3) 41.67% (10) 8.33% (2) 20.83% (5)
9 18.18% (2) 0.00% (0) 45.45% (5) 18.18% (2) 18.18% (2)
10 15.38% (2) 7.69% (1) 30.77% (4) 30.77% (4) 15.38% (2)
12 5.67% (24) 8.04% (34) 41.37% (175) 29.55% (125) 15.37% (65)
Total 6.70% (124) 10.43% (193) 35.73% (661) 30.27% (560) 16.86% (312)
Total
100.00% (806)
100.00% (183)
100.00% (165)
100.00% (93)
100.00% (62)
100.00% (38)
100.00% (32)
100.00% (24)
100.00% (11)
100.00% (13)
100.00% (423)
100.00% (1,850)政治家では、NHK党、諸派が特に小さな政府論者が多く、無所属、参政党もそれについで小さな政府論者が多い。 一方、有権者踏査では、国民民主党、れいわ新選組、社民党、NHK党、参政党に小さな政府論者が多い。れいわ新撰組、社民党については、意外な結果だと思った。