【第１章イントロダクション】練習問題1.5.1「自己申告に基づく投票率のバイアス」
１．書籍・著書の紹介
データ分析を学ぼうと今井耕介先生の「社会科学のためのデータ分析」（以下、本書）を読んでいます。本書を選んだ理由は、今井先生自身が教鞭を取った米国トップスクールの講義の内容をもとに執筆された定評のある教科書のようだからです（今井先生の経歴は以下のリンク先参照）。
本書が評価されている理由は主に以下の３つだと思います。
①分析の具体例としてパブリッシュされた論文を再現できること
②データ分析手法を幅広くカバーしていること
③サポートページが充実しており、自主学習のハードルが低いこと
単なるデータ分析の手法の紹介だけでなく、学術の知見にも触れられ、一挙両得であるのは大変嬉しいです。また、線形回帰に始まり、クラスター分析やテキストマイニングといった様々な手法を一気通貫で学べるのも魅力的だと思います。そして、書籍の内容を簡単に再現できる以下のサポートページが用意されているので独学者にとっても優しいと思います。
２．記事の狙い
本書には、各章末に２〜３題からなる練習問題が付いており、サポートページで対象データセットをダウンロードすることで、実際に手を動かしてデータ分析を学ぶことができます。
どうせ練習問題を解くためにRのコードを書くのであれば、noteの記事にしようと思い、この記事を書き始めました。当初は１つの記事に章単位の練習問題全てを記載しようと思いましたが、１つの練習問題だけでもかなりのボリュームになったので、章別練習問題別に記事にまとめることにしました。
３．練習問題1.5.1「自己申告に基づく投票率のバイアス」
（１）データセットの読込・概要の確認
・データ構造はデータフレーム型で観察数14×変数9個のデータセットです。
・データの期間は1980〜2008年までの28年間で2年毎になっています。但し、2006 年のみデータが存在しません。
> turnout <- read.csv("turnout.csv")
> class(turnout)
[1] "data.frame"
> dim(turnout)
[1] 14 9
> summary(turnout)
year VEP VAP total ANES felons
Min. :1980 Min. :159635 Min. :164445 Min. : 64991 Min. :47.00 Min. : 802
1st Qu.:1986 1st Qu.:171192 1st Qu.:178930 1st Qu.: 73179 1st Qu.:57.00 1st Qu.:1424
Median :1993 Median :181140 Median :193018 Median : 89055 Median :70.50 Median :2312
Mean :1993 Mean :182640 Mean :194226 Mean : 89778 Mean :65.79 Mean :2177
3rd Qu.:2000 3rd Qu.:193353 3rd Qu.:209296 3rd Qu.:102370 3rd Qu.:73.75 3rd Qu.:3042
Max. :2008 Max. :213314 Max. :230872 Max. :131304 Max. :78.00 Max. :3168
noncit overseas osvoters
Min. : 5756 Min. :1803 Min. :263
1st Qu.: 8592 1st Qu.:2236 1st Qu.:263
Median :11972 Median :2458 Median :263
Mean :12229 Mean :2746 Mean :263
3rd Qu.:15910 3rd Qu.:2937 3rd Qu.:263
Max. :19392 Max. :4972 Max. :263
NA's :13
> turnout$year
[1] 1980 1982 1984 1986 1988 1990 1992 1994 1996 1998 2000 2002 2004 2008（２）選挙年齢人口（VAP）投票率・有権者人口（VEP）投票率
①全期間にわたってVAP（青●）は、VEP（赤▲）より低い値になる。
②VAPとVEPは平均的に3.49%程度の差が生じる。
③差の範囲は、最小1.89%〜最大5.88%とバラつきがある。
④またVAPとVEPの差の特徴として以下の２つがある。
1)時間の経過により差が大きくなる傾向にある。
2)但し、単調増加ではなく周期性を持っている。
> VAP.rate <- (turnout[,4]/(turnout[,3]+turnout[,8]))*100
> summary(VAP.rate)
Min. 1st Qu. Median Mean 3rd Qu. Max.
34.83 36.57 48.44 45.46 52.41 55.67
> VEP.rate <- (turnout[,4]/(turnout[,2]))*100
> summary(VEP.rate)
Min. 1st Qu. Median Mean 3rd Qu. Max.
38.09 39.91 52.21 48.95 54.99 61.55
> par(mfrow = c(1,2))
> plot(turnout$year,VAP.rate,col = "blue",pch = 16,ylim = c(30,65),xlab = "year",ylab = "vote.rate",main = "Comparison VAP and VEP")
> points(turnout$year,VEP.rate,col = "red",pch = 17)
> text(1983,60,"VEP",col = "red")
> text(1983,35,"VAP",col = "blue")
> plot(turnout$year,VEP.rate-VAP.rate,type = "l",xlab = "year",ylab = "vote.rate diff",main = "Difference VAP and VEP")
> summary(VEP.rate-VAP.rate)
Min. 1st Qu. Median Mean 3rd Qu. Max.
1.892 2.538 3.178 3.493 4.111 5.880 
（３）VAP投票率・VEP投票率とANES投票率推定値の差
①VAPとANESは、平均して20.3%程度の差がある。
②その差の範囲は、最小11%〜最大26.1%程度。
③VEPとANESは、平均して16.8%程度の差がある。
④その差の範囲は、最小8.6%〜最大22.5%程度。
⑤VEPの方が、VAPよりもANESと近い値にある傾向がみられる。
> summary(turnout[,5]-VAP.rate)
Min. 1st Qu. Median Mean 3rd Qu. Max.
11.06 18.22 20.62 20.33 22.42 26.17
> summary(turnout[,5]-VEP.rate)
Min. 1st Qu. Median Mean 3rd Qu. Max.
8.581 15.267 16.893 16.836 18.529 22.489
> par(mfrow=c(1,2))
> plot(turnout$year,turnout[,5]-VAP.rate,type = "l",ylim = c(5,30),xlab = "year",ylab = "diff vote.rate",main = "Difference VAP and ANES")
> plot(turnout$year,turnout[,5]-VEP.rate,type = "l",ylim = c(5,30),xlab = "year",ylab = "diff vote.rate",main = "Difference VEP and ANES")
（４）大統領選挙と中間選挙のANES推定値のバイアス
＜米国選挙に関する前提＞
①大統領選挙は4年毎に実施。データセットでの開始年は1980年。
②中間選挙も４年毎に実施。データセットの開始年は1982年。
但し、2006年の中間選挙のデータは、データセットに無い。
＜大統領選挙におけるVEPとANESの比較＞
①VEPとANESは、平均して17.9%程度の差がある。
②その差の範囲は、最大16.4~21.3%程度。標準偏差は、1.65%程度。
> turnout.pre <- turnout[seq(from = 1,to = nrow(turnout),by = 2),]
> x <- turnout[nrow(turnout),]
> turnout.pre <- rbind(turnout.pre,x)
> turnout.pre
year VEP VAP total ANES felons noncit overseas osvoters
1 1980 159635 164445 86515 71 802 5756 1803 NA
3 1984 167702 173995 92653 74 1165 7482 2361 NA
5 1988 173579 181955 91595 70 1594 9280 2257 NA
7 1992 179656 190778 104405 75 2183 11447 2418 NA
9 1996 186347 200016 96263 73 2586 13601 2499 NA
11 2000 194331 210623 105375 73 3083 16218 2937 NA
13 2004 203483 220336 122295 77 3158 18068 3862 NA
14 2008 213314 230872 131304 78 3145 19392 4972 263
> VEP.rate.pre <- (turnout.pre$total/turnout.pre$VEP)*100
> summary(turnout.pre$ANES - VEP.rate.pre)
Min. 1st Qu. Median Mean 3rd Qu. Max.
16.45 16.87 17.07 17.89 18.76 21.34
> sd(turnout.pre$ANES - VEP.rate.pre)
[1] 1.653152 ＜中間選挙におけるVEPとANESの比較＞
①VEPとANESは、平均して15.4%程度の差がある。
②その差の範囲は、最大8.6~22.5%程度。標準偏差は、4.59%程度。
> turnout.mid <- turnout[seq(from = 2, to = 12,by = 2),]
> turnout.mid
year VEP VAP total ANES felons noncit overseas osvoters
2 1982 160467 166028 67616 60 960 6641 1982 NA
4 1986 170396 177922 64991 53 1367 8362 2216 NA
6 1990 176629 186159 67859 47 1901 10239 2659 NA
8 1994 182623 195258 75106 56 2441 12497 2229 NA
10 1998 190420 205313 72537 52 2920 14988 2937 NA
12 2002 198382 215462 78382 62 3168 17237 3308 NA
> VEP.rate.mid <- (turnout.mid$total/turnout.mid$VEP)*100
> summary(turnout.mid$ANES - VEP.rate.mid)
Min. 1st Qu. Median Mean 3rd Qu. Max.
8.581 14.145 14.866 15.429 17.116 22.489
> sd(turnout.mid$ANES - VEP.rate.mid)
[1] 4.596035（５）時間の経過によるANESのバイアス変化
＜データ分割の前提＞
・前半（1980~1992年）と後半（1994~2008年）の２グループに分割。
＜前半（1980~1992年）におけるVEPとANESの比較＞
①VEPとANESは、平均して15.8%程度の差がある。
②その差の範囲は、最小8.58〜18.7%程度。標準偏差は3.42%程度。
> turnout.old <- turnout[seq(from = 1 , to = nrow(turnout)/2 , by =1 ),]
> turnout.old
year VEP VAP total ANES felons noncit overseas osvoters
1 1980 159635 164445 86515 71 802 5756 1803 NA
2 1982 160467 166028 67616 60 960 6641 1982 NA
3 1984 167702 173995 92653 74 1165 7482 2361 NA
4 1986 170396 177922 64991 53 1367 8362 2216 NA
5 1988 173579 181955 91595 70 1594 9280 2257 NA
6 1990 176629 186159 67859 47 1901 10239 2659 NA
7 1992 179656 190778 104405 75 2183 11447 2418 NA
> VEP.rate.old <- (turnout.old$total/turnout.old$VEP)*100
> summary(turnout.old$ANES - VEP.rate.old)
Min. 1st Qu. Median Mean 3rd Qu. Max.
8.581 15.832 16.886 15.854 17.547 18.751
> sd(turnout.old$ANES - VEP.rate.old)
[1] 3.420122 ＜後半（1994~2008年）におけるVEPとANESの比較＞
①VEPとANESは、平均して17.8%程度の差がある。
②その差の範囲は、最小13.8〜22.5%程度。標準偏差は3.21%程度。
＜前半（1980~1992年）と後半（1994~2008年）のANESのバイアス＞
・平均的な差が大きく、なおかつ差の最小値・最大値共に大きくなっているため、後半の方がANESのバイアスが大きくなっていると思われる。
> turnout.new <- turnout[seq(from = nrow(turnout)/2+1 , to = nrow(turnout) , by =1 ),]
> turnout.new
year VEP VAP total ANES felons noncit overseas osvoters
8 1994 182623 195258 75106 56 2441 12497 2229 NA
9 1996 186347 200016 96263 73 2586 13601 2499 NA
10 1998 190420 205313 72537 52 2920 14988 2937 NA
11 2000 194331 210623 105375 73 3083 16218 2937 NA
12 2002 198382 215462 78382 62 3168 17237 3308 NA
13 2004 203483 220336 122295 77 3158 18068 3862 NA
14 2008 213314 230872 131304 78 3145 19392 4972 263
> VEP.rate.new <- (turnout.new$total/turnout.new$VEP)*100
> summary(turnout.new$ANES - VEP.rate.new)
Min. 1st Qu. Median Mean 3rd Qu. Max.
13.91 15.66 16.90 17.82 20.06 22.49
> sd(turnout.new$ANES - VEP.rate.new)
[1] 3.210682（６）補正済VAPとVAP・VEP・ANES推定値の比較
＜補正済VAP算出時の前提＞
①osvoters（在外有権者投票数合計）は、2008年を除いてNA。
②計算を円滑に行うため、NAは「0」に置換する。
＜補正済VAPと各投票率の比較＞
①補正済VAPとANES
1)ANESの方が常に大きく、平均して16%程度の差がある。
2)その差の範囲は最小8%〜最大21.8%程度。
②補正済VAPとVAP
1) 補正済VAPの方が常に大きく、平均して4.25%程度の差がある。
2)その差の範囲は最小2.43%〜最大7.22%程度。
③補正済VAPとVEP
1)補正済VAPの方が常に大きく、平均して0.75% 程度の差がある。
2)その差の範囲は最小0.49%〜最大1.34%程度。
> turnout$osvoters <- ifelse(is.na(turnout$osvoters),0,turnout$osvoters)
> VAP.rate.mod <- ((turnout$total - turnout$osvoters)/(turnout$VAP - turnout$felons - turnout$noncit))*100
> summary(VAP.rate.mod)
Min. 1st Qu. Median Mean 3rd Qu. Max.
38.64 40.55 52.95 49.71 55.80 62.90
> summary(turnout$ANES - VAP.rate.mod)
Min. 1st Qu. Median Mean 3rd Qu. Max.
8.005 14.545 16.134 16.077 17.772 21.816
> summary(VAP.rate - VAP.rate.mod)
Min. 1st Qu. Median Mean 3rd Qu. Max.
-7.225 -4.880 -3.845 -4.252 -3.167 -2.434
> summary(VEP.rate - VAP.rate.mod)
Min. 1st Qu. Median Mean 3rd Qu. Max.
-1.3448 -0.8137 -0.6905 -0.7596 -0.5822 -0.4996
> par(mfrow = c(1,1))
> plot(turnout$year,turnout$ANES - VAP.rate.mod,col = "blue",pch = 16,ylim = c(-8,25),xlab = "year",ylab = "diff.vote.rate",main = "Comparison Vote Rate")
> points(turnout$year,VAP.rate - VAP.rate.mod,col = "red",pch = 17)
> points(turnout$year,VEP.rate - VAP.rate.mod,col = "black",pch = 18)
> text(1983,20,"ANES-VAPmod",col = "blue")
> text(1983,-6,"VAP-VAPmod",col = "red")
> text(1983,3,"VEP-VAPmod",col = "black")
４．練習問題を解いた感想
・ANESと他の投票率の乖離が大きいので、投票率の算定式を間違えている気がして不安。誰か、練習問題を解いている人は居ないだろうか。
・データセットを作成した都度、summary関数で全体感を確認した方が良い。想定と処理の作業結果に相違点が無いか、相違がある場合その理由は何故かを考えるきっかけになる。
・データを可視化すると見えていないことがわかる時がある。まだ、Rでデータをグラフ化するコードを書くことに慣れていないので、これから習熟したい。
この記事が気に入ったらサポートをしてみませんか？