R パッケージ
一覧library(corrr)
library(DT)
library(GGally)
library(psych)
library(qgraph)
library(tidyverse)
2 つの質的変数の関連性を示す集計方法 データ情報を失うことなく 2 変数間の関係を分析できる 例)男女間で内閣支持率に差があるか? 「性別」と「内閣支持率」(仮想データ)
(df: degree of freedom
) によって異なるdegree of freedom (df)
:
ここでは 2 つの変数(gender
&
support
)がある
gender
には「男性」と「女性」という 2
つの選択の「自由」がある
support
には「支持」と「不支持」という 2
つの選択の「自由」がある
この場合の「自由度」は次の式で求める
degree of freedom
= (2-1)*(2-1) = 1
→ ここでの「自由度」は 1
95%信頼区間(=5%で統計的に有意)で検定したい場合
横軸 1 行目の \(χ^2_.050\) と df
= 1 が交差する値に注目
→ 3.841
が「臨界値」
サンプルから得られた統計量 \(χ2=4\)
結論 母集団では内閣支持率において男女間で差があり、女性より男性がより支持している
上記のカイ二乗検定を R を使ってやってみる
chi2_data2.csv
をダウンロードし、RProject
フォルダーに保存する
データのダウンロードが終わったら、データを読み込み
cab3
と名前を付ける
<- read_csv("data/chi2_data2.csv") cab2
cab2
を確認する::datatable(cab2) DT
<- table(cab2$gender, cab2$support)
total_cab2 addmargins(total_cab2)
内閣不支持 内閣支持 Sum
女性 30 20 50
男性 20 30 50
Sum 50 50 100
chisq.test(cab2$gender, cab2$support, correct = FALSE)
Pearson's Chi-squared test
data: cab2$gender and cab2$support
X-squared = 4, df = 1, p-value = 0.0455
結論 母集団では内閣支持率において男女間で差があり、女性より男性がより支持している
サンプルサイズが半分の 50 の時はどうなるか?
Download chi2_data3.csv
<- read_csv("data/chi2_data3E.csv") cab3
::datatable(cab3) DT
<- table(cab3$gender, cab3$support)
table_cab3 addmargins(table_cab3)
not_support support Sum
female 15 10 25
male 10 15 25
Sum 25 25 50
chisq.test(cab3$gender, cab3$support,
correct = FALSE)
Pearson's Chi-squared test
data: cab3$gender and cab3$support
X-squared = 2, df = 1, p-value = 0.1573
chisq.test(cab3$gender, cab3$support, correct = FALSE)
Pearson's Chi-squared test
data: cab3$gender and cab3$support
X-squared = 2, df = 1, p-value = 0.1573
結論 母集団では内閣支持率において男女間で差があるとはいえない
ポイント サンプルサイズ (N) が小さいと統計的有意性が得にくくなる
フィシャーの直接確率計算法を R を使ってやってみる
chi2_data4.csvをダウンロードし、RProject
フォルダーに保存する
データのダウンロードが終わったら、データを読み込み
cab4
と名前を付ける
<- read_csv("data/chi2_data4.csv") cab4
cab4
を確認する::datatable(cab4) DT
<- table(cab4$gender, cab4$support)
total_cab4 addmargins(total_cab4)
不支持 支持 Sum
女性 3 2 5
男性 2 1 3
Sum 5 3 8
fisher.test(total_cab4, alternative = "less")
Fisher's Exact Test for Count Data
data: total_cab4
p-value = 0.7143
alternative hypothesis: true odds ratio is less than 1
95 percent confidence interval:
0.00000 17.73797
sample estimates:
odds ratio
0.7772203
correlation
)(scatterplot)
で表してみるlinear
)」な関係の強さを表すx
と y
の相関係数は次の式で表せる
Source: https://www.analyticsvidhya.com/blog/2021/01/beginners-guide-to-pearsons-correlation-coefficient/
<- c(1, 5, 10)
x <- c(1, 2, 10) y
<-data.frame(x, y) xy
x
, y
の散布図を描く plot(x ~ y)
ggplot2
を使う library("ggplot2")
%>%
xy ggplot(aes(x, y)) +
geom_point() +
stat_smooth(method = lm, se = FALSE)
x
, y
の相関係数を求める cor(x, y)
[1] 0.936599
x
, y
の相関係数と
p
値を求める cor.test(x, y)
Pearson's product-moment correlation
data: x and y
t = 2.6729, df = 1, p-value = 0.2279
alternative hypothesis: true correlation is not equal to 0
sample estimates:
cor
0.936599
x
と y
の相関係数(= 0.936599)p
値(= 0.2279)p
値(= 0.2279)(つまり
22.79%)が意味していることx
と y
の相関係数は
0」が正しいとすれば、このようなデータが出現する確率は
22.79%という意味P
値 が a = 0.05
(= 5%
の有意水準)を超えているため、帰無仮説は棄却できない関係 | 変数の方向 | 予測 | 実例 |
因果関係 | 一方向的 | 予測に使える | 薬を飲む → 症状が改善 |
回帰関係 | 一方向的 | 予測に使える | 模擬試験の点数 → 本試験の点数 |
相関関係 | 双方向的 | 予測に使えない | 英語の読解力 ⇔ 英語のリスニング力 |
・相関関係があるからといって、必ずしも因果関係があるとは限らない
・次の2 つの変数の相関を調べてみる
・x
軸・・・選挙区ごとに候補者が費やした選挙費用合計:千万円
・y
軸・・・選挙区ごとの投票率:%
・人工的に架空のデータを作ってみる
・50%の確率 (.5) で 0 か 1 の値を 100 個、無作為に抽出し
comp
と名前を付ける
set.seed(12345) # 乱数を固定
<- rbinom(100, 1, .5) comp
set.seed(12345)
を入れなければ、試行の度に異なる変数が作成されるcomp
をヒストグラムで表示してみるhist(comp)
<- rnorm(100, mean = 0.4 + 0.5*comp, sd = 0.2) money
turnout
と名前を付ける<- rnorm(100, mean = 0.4 + 0.3*comp, sd = 0.1) turnout
df
と名前を付け、データを表示する<- data.frame(money = round(money, digits = 2), # 桁数を指定
df turnout = round(turnout, digits = 2),
comp = as.factor(comp))
head(df)
money turnout comp
1 0.79 0.54 1
2 1.29 0.75 1
3 0.91 0.72 1
4 0.97 0.62 1
5 0.27 0.39 0
6 0.46 0.37 0
tail(df)
money turnout comp
95 0.90 0.69 1
96 1.01 0.78 1
97 0.59 0.97 1
98 1.07 0.69 1
99 0.58 0.45 0
100 0.43 0.48 0
::datatable(df) DT
・「選挙費用の合計」を x
軸、「投票率」を y
軸とした散布図と回帰直線を描いてみる
%>%
df ggplot(aes(x = money, y = turnout)) +
geom_point() +
geom_smooth(se = FALSE, method = 'lm') +
labs(x = "選挙費用の合計(千万円)", y = "投票率") +
theme_bw(base_family = "HiraKakuProN-W3") # 文字化け対策
・相関係数を確認すると
cor.test(money, turnout)
Pearson's product-moment correlation
data: money and turnout
t = 7.5656, df = 98, p-value = 2.118e-11
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
0.4664265 0.7179987
sample estimates:
cor
0.6072149
money
と turnout
の相関係数は
0.6072149
p
値(= 2.118e-11 = 0.00000000002118)p
値(= 2.118e-11 =
0.000000002118%)(つまりほぼ%)が意味していることx
と y
の相関係数は
0」が正しいとすれば、このようなデータが出現する確率はほぼ 0
%という意味P
値 が a = 0.01(= 1%
の有意水準)以下なので、帰無仮説は棄却、対抗仮説を受容するmoney
と turnout
の間には正の「相関関係」があるmoney
と turnout
の間には正の「因果関係」はあるのか?・もし両者の間に「因果関係」があり、「選挙費用の合計」が「投票率」を上げているのであれば
→ 投票率を上げるために、候補者は選挙費用を多く使う必要がある
・ここでは、次の 4 つの可能性が存在する(詳細は「 セレクションバイアスと
Rubin の因果モデル(理論)」を 参照)
・ここで第 3 の要因として選挙の「接戦度」が考えられる
・「接戦度」は説明変数と応答変数の両方に影響を与えている 交絡因子
・無風選挙区と比べると、接戦の選挙区では選挙運動でより多くのお金が使われる
・無風選挙区と比べると、接戦の選挙では投票率が高い
→ 接戦では、選挙でお金が多く使われ、投票率が高い
→ 無風では、選挙でお金があまり使われず、投票率が低い
・「接戦の選挙区」(青色)と「無風の選挙区」(赤色)に分けてプロットしてみる
%>%
df ggplot(aes(money, turnout)) +
geom_point(aes(color = comp)) +
geom_smooth(method = lm,
se = FALSE,
aes(color = comp)) +
labs(x = "選挙費用(千万円)", y = "投票率 (%)") +
scale_color_discrete(name = "接戦度",
labels = c("無風区","接戦区")) +
theme_bw(base_family = "HiraKakuProN-W3")
関係 | 方向 | 予測 | 実例 |
相関関係 | 双方向的 | 予測に使えない | 英語の読解力 ⇔ 英語のリスニング力 |
回帰関係 | 一方向的 | 予測に使える | 模擬試験の点数 → 本試験の点数 |
✔ 因果推論に関する詳しい解説は次のセクションを参照して下さい:
因果推論
・14.
セレクションバイアスと Rubin の因果モデル(理論)
・15.
セレクションバイアス(通院と健康状態のシミュレーション)
・16.
ランダム化比較試験: RCT
・17.
因果効果推定のための回帰分析
qgraphパッケージ
を使って相関関係を可視化してみる
分析に使うデータ:2009年〜2014年衆院選データ hr96_17.csv を読み込む
na = "."
は欠損処理
<- read_csv("data/hr96-17.csv",
hr na = ".") # 欠損処理
・2009年衆院選データから、特定の変数だけを抜き出す
names(hr)
[1] "year" "pref" "ku" "kun"
[5] "wl" "rank" "nocand" "seito"
[9] "j_name" "gender" "seshu_dummy" "jiban_seshu"
[13] "name" "previous" "...15" "age"
[17] "exp" "status" "vote" "voteshare"
[21] "eligible" "turnout" "castvotes" "...24"
[25] "...25" "nojiban_seshu" "mag"
exppv (有権者一人あたり選挙費用)の作成
exp
と eligible
のデータ型を確認するstr(hr$exp)
num [1:9660] NA 9828097 2177203 9311555 9231284 ...
str(hr$eligible)
num [1:9660] 346774 346774 346774 346774 346774 ...
numeric
) で問題ないexp
と eligible
を使って、有権者 1
人あたりに使う選挙費用 (exppv
) を作る<- hr %>%
hr ::mutate(exppv = exp/eligible) # eligible は小選挙区ごとの有権者数 dplyr
summary(hr$exppv)
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
0.0013 8.1762 18.7646 23.0907 33.3863 120.8519 2831
<- hr %>%
hr2009 ::filter(year == 2009) %>%
dplyr::select(age, nocand, rank, wl, previous, vote, voteshare, eligible, exp, exppv) dplyr
・データの様子を表示させる
names(hr2009)
[1] "age" "nocand" "rank" "wl" "previous" "vote"
[7] "voteshare" "eligible" "exp" "exppv"
head(hr2009)
# A tibble: 6 × 10
age nocand rank wl previous vote voteshare eligible exp exppv
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 42 5 5 0 0 3352 1.5 369526 1772906 4.80
2 46 5 1 1 0 122348 54.4 369526 3559575 9.63
3 36 5 2 0 0 78691 35 369526 9617887 26.0
4 61 5 4 0 0 6082 2.7 369526 1642095 4.44
5 59 5 3 0 0 14485 6.4 369526 1802968 4.88
6 47 4 2 0 0 58225 23.9 378272 11405740 30.2
summary(hr2009)
age nocand rank wl
Min. :25.0 Min. :2.000 Min. :1.000 Min. :0.0000
1st Qu.:41.0 1st Qu.:3.000 1st Qu.:1.000 1st Qu.:0.0000
Median :50.0 Median :4.000 Median :2.000 Median :0.0000
Mean :50.1 Mean :4.005 Mean :2.496 Mean :0.4337
3rd Qu.:59.0 3rd Qu.:4.000 3rd Qu.:3.000 3rd Qu.:1.0000
Max. :85.0 Max. :9.000 Max. :9.000 Max. :2.0000
NA's :4
previous vote voteshare eligible
Min. : 0.000 Min. : 177 Min. : 0.10 Min. :211750
1st Qu.: 0.000 1st Qu.: 5992 1st Qu.: 2.40 1st Qu.:298265
Median : 0.000 Median : 62034 Median :30.00 Median :352167
Mean : 1.331 Mean : 61940 Mean :26.34 Mean :349973
3rd Qu.: 2.000 3rd Qu.:107292 3rd Qu.:47.30 3rd Qu.:405333
Max. :15.000 Max. :201461 Max. :95.30 Max. :487837
exp exppv
Min. : 10024 Min. : 0.0258
1st Qu.: 1794542 1st Qu.: 5.3290
Median : 4809437 Median : 13.9190
Mean : 6118181 Mean : 18.4032
3rd Qu.: 9109114 3rd Qu.: 27.3219
Max. :25354069 Max. :100.8919
NA's :15 NA's :15
・age, exp, exppvに NA(欠損値)が含まれていることに注意
2009年衆院選データ変数間の相関係数を計算し、可視化する
・cor()
関数を使って相関係数を表示させる
<- cor(hr2009, use = "complete.obs") corHR
NA
が含まれている場合は
use = "complete.obs
と指定cor_auto(hr2009)
でも計算できる・計算した相関係数を表示させる
corHR
age nocand rank wl previous
age 1.00000000 -0.01949051 -0.18875565 0.06449578 0.48783691
nocand -0.01949051 1.00000000 0.35882406 -0.19173305 -0.12843147
rank -0.18875565 0.35882406 1.00000000 -0.58585349 -0.48212211
wl 0.06449578 -0.19173305 -0.58585349 1.00000000 0.39104752
previous 0.48783691 -0.12843147 -0.48212211 0.39104752 1.00000000
vote 0.19315400 -0.20289537 -0.86695872 0.63917654 0.53338630
voteshare 0.20543012 -0.23982316 -0.89626914 0.68207240 0.55385390
eligible -0.02675139 0.19908259 0.06906283 -0.11248525 -0.03812071
exp 0.30790965 -0.15181589 -0.61620242 0.40505780 0.57268149
exppv 0.28775237 -0.18464384 -0.59240696 0.42901652 0.54665625
vote voteshare eligible exp exppv
age 0.1931540 0.20543012 -0.02675139 0.30790965 0.2877524
nocand -0.2028954 -0.23982316 0.19908259 -0.15181589 -0.1846438
rank -0.8669587 -0.89626914 0.06906283 -0.61620242 -0.5924070
wl 0.6391765 0.68207240 -0.11248525 0.40505780 0.4290165
previous 0.5333863 0.55385390 -0.03812071 0.57268149 0.5466562
vote 1.0000000 0.96092467 0.14578029 0.66201463 0.5686694
voteshare 0.9609247 1.00000000 -0.05370451 0.69213847 0.6667191
eligible 0.1457803 -0.05370451 1.00000000 -0.06058169 -0.2921183
exp 0.6620146 0.69213847 -0.06058169 1.00000000 0.9498970
exppv 0.5686694 0.66671908 -0.29211834 0.94989701 1.0000000
・相関係数を可視化する
<- qgraph(
cor1
corHR,graph = "glasso",
sampleSize = nrow(hr2009),
tuning = 0,
layout = "spring",
title = "Correlations among variables of HR elections",
details = TRUE
)
・正の相関は緑色で、負の相関は赤色で表示される
・色が濃いほど相関関係が強い
・cor1 の図に “cor_hr2009.pdf” という名前を付けて保存する
qgraph(cor1,
filetype = 'pdf',
filename = "cor_hr2009",
height = 5,
width = 10)
GGally パッケージ
を使って、複数の変数間の相関関係を可視化できる<- hr2009 |>
df_corr09 select(vote, voteshare, exp, exppv, age, rank)
<- GGally::ggpairs(df_corr09,
corr_09 title = "Correlations")
corr_09
JGSS-2008.csv
)をダウンロードして下の問題にこたえなさいserial |
:シリアル番号 |
gender |
:「男性」「女性」 |
eval |
:自民党の政権能力を評価するなら「評価する」、評価しないなら「評価しない」 |
Q1: R
を使って、行の観測度数に注目したクロス表を出力しなさい
(クロス表を出力するに至るRコマンドと出力を明記すること
Q2: このサンプルから、母集団でも女性より男性の方が、自民党の政権担当能力を高く評価していると言えるだろうか?適切な帰無仮説と対抗仮説を明示すること
R の datasets パッケージ women は米国女性の平均身長と体重のサンプルである
data(women)
<- data.frame(women)
women women
height weight
1 58 115
2 59 117
3 60 120
4 61 123
5 62 126
6 63 129
7 64 132
8 65 135
9 66 139
10 67 142
11 68 146
12 69 150
13 70 154
14 71 159
15 72 164
Q1: height と weight
の単位を次のように変換し、表示しなさい
・height の単位 (inch) を cm に変換
・1 inch は 2.54 cm
・weight の単位 (pound) を kg に変換
・1 pound は約0.4536 kg
Q2: height を x 軸、weight を y 軸として回帰直線を加えた散布図を描きなさい
Q3: height と weight の相関係数を求めなさい また二変数に関して母集団における統計的有意性を検定しなさい
Q4: height と weight は相関関係、因果関係どちらの関係があると考えられるか またその理由を簡潔に述べなさい
R の datasets パッケージ cars は車のスピード (speed) とブレーキを踏んだ時に停止するまでに必要な距離 (dist) のデータである
data(cars)
cars
speed dist
1 4 2
2 4 10
3 7 4
4 7 22
5 8 16
6 9 10
7 10 18
8 10 26
9 10 34
10 11 17
11 11 28
12 12 14
13 12 20
14 12 24
15 12 28
16 13 26
17 13 34
18 13 34
19 13 46
20 14 26
21 14 36
22 14 60
23 14 80
24 15 20
25 15 26
26 15 54
27 16 32
28 16 40
29 17 32
30 17 40
31 17 50
32 18 42
33 18 56
34 18 76
35 18 84
36 19 36
37 19 46
38 19 68
39 20 32
40 20 48
41 20 52
42 20 56
43 20 64
44 22 66
45 23 54
46 24 70
47 24 92
48 24 93
49 24 120
50 25 85
Q1: speed と dist
の単位を次のように変換し、表示しなさい
・speed の単位(mile per hour)を kilo meter per hour に変換
・1 mile は 1.6 km
・dist の単位 (foot) を meter に変換
・1 foot は約0.3048 m
Q2: speed を x 軸、dist を y 軸として回帰直線を加えた散布図を描きなさい
Q3: speed と dist の相関係数を求めなさい また二変数に関して母集団における統計的有意性を検定しなさい
Q4: speed と dist は相関関係、因果関係どちらの関係があると考えられるか またその理由を簡潔に述べなさい
df1
には 22 個の変数が入っている変数名 | 詳細 |
---|---|
year | 選挙年 (1996-2017) |
pref | 都道府県名 |
ku | 小選挙区名 |
kun | 小選挙区 |
rank | 当選順位 |
wl | 選挙の当落: 1 = 小選挙区当選、2 = 復活当選、0 = 落選 |
nocand | 立候補者数 |
seito | 候補者の所属政党 |
j_name | 候補者の氏名(日本語) |
name | 候補者の氏名(ローマ字) |
previous | これまでの当選回数(当該総選挙結果は含まない) |
gender | 立候補者の性別: “male”, “female” |
age | 立候補者の年齢 |
exp | 立候補者が使った選挙費用(総務省届け出) |
status | 候補者のステータス: 0 = 非現職、1 現職、2 = 元職 |
vote | 得票数 |
voteshare | 得票率 (%) |
eligible | 小選挙区の有権者数 |
turnout | 小選挙区の投票率 (%) |
seshu_dummy | 世襲候補者ダミー: 1 = 世襲、0 = 非世襲(地盤世襲 or 非世襲) |
jiban_seshu | 地盤の受け継ぎ元の政治家の氏名と関係 |
nojiban_seshu | 世襲元の政治家の氏名と関係 |
\[age, nocand, rank, wl, previous, vote, voteshare, eligible, exp\]
Q1: 「立候補者が使った選挙費用」(exp
)
を「小選挙区の有権者数 」(eligible
)
で割って得られた変数「有権者一人あたりに費やす選挙費用(円)」(exppv
)
を作成し、データフレームに付け加え、exppv
の記述統計量を示しなさい
Q2: 9 の変数それぞれの相関関係を計算し表示しなさい
Q3: GGally
パッケージを使って、9 つ
の変数間の相関関係を可視化しなさい