『社会科学のためのデータ分析入門』練習問題の解答第1章

ハーバード大学今井耕介教授の「Quantitative Social Science: An Introduction」の翻訳本が、岩波書店より「社会科学のためのデータ分析入門」というタイトルで発売されました。

政治を題材にデータ分析する人たちの間で全世界的に有名な今井先生ということで、早速翻訳本を読んでみました。

実際に読んでみると、「データ分析×R」の入門書で内容も網羅的であるため、この１冊で学部レベルの計量を身に着けることができる設計になっていました。

また、ただ教科書的ではなく、（政治やジャーナリズム、社会問題に興味がある人なら）扱う題材が非常に面白く、卒論やコラムなどの題材に転換できるものも多くありました。

計量経済はジェフリー・ウールドリッジの「Introductory Econometrics: A Modern Approach」が教科書として多く指定されることもありますが、計量政治はこれといった教科書的なものは、あまり聞いたことありません。

そんななか、この網羅的かつ興味を引く今井教授の本は、もしかしたら計量政治の代表的教科書になりうる可能性も秘めているかもと期待させる、そんなことを読後に感じました。

「社会科学のためのデータ分析入門」の練習問題の解答や解答方法がどこを探してもなかったので、僕が解いた解答を載せておきます。

合っているかもしれませんし、間違っているかもしれません。

間違えていたらコメント欄で教えていただけると幸いです。

注意

先頭に「＞」がついているのが、打ち込んだコードです。

先頭に「＞」が付いていないのは、コードの結果です。

変な変数名があっても気にしないでください

練習問題1.5.1

「世論調査のバイアスって大きいから意味ないかも？」みたいな課題について、本当に世論調査のバイアスが大きいのかを調べる問題

具体的に調べるのは、社会的望ましさバイアス

世論調査で選挙に行きましたか？って聞いた時、やっぱ選挙に行く行動が世の中的に良いことだから、選挙にいってなくても選挙に行ってると言ってしまう人についてってことですね

この社会的望ましさバイアスのせいで、世論調査の投票率はカサ増しされているのでは？というのをデータ分析していきます。

1

Rscript

#データ読み込み
> turnout <- read.csv("turnout.csv")  

#1
#データ構造の確認
> View(turnout)#省略

#要約（基本統計量）
> summary(turnout)#省略
  
#観察数
> nrow(turnout)
[1] 14

#year
> turnout$year #turnout[,"year"]
 [1] 1980 1982 1984 1986 1988 1990 1992 1994 1996 1998 2000 2002 2004 2008

解答

観察は14

データセットには1980年から2008年までのデータが含まれている

2

Rscript

#2
#VAPとVEPの投票率の変数を作成
> VAPRATE<- 100 * turnout$total/(turnout$VAP+turnout$overseas) 
> VEPRATE<- 100 * turnout$total/turnout$VEP 

#VAPの投票率
> VAPRATE
 [1] 52.03972 40.24522 52.53748 36.07845 49.72260 35.93884 54.04097 38.03086 47.53376 34.83169 49.34211 35.82850
[13] 54.54777 55.67409

#VEPの投票率
> VEPRATE
 [1] 54.19551 42.13701 55.24860 38.14115 52.76848 38.41895 58.11384 41.12625 51.65793 38.09316 54.22449 39.51064
[13] 60.10084 61.55433

#VAPの平均投票率
> mean(VAPRATE)
[1] 45.45658
#VEPの平均投票率
> mean(VEPRATE)
[1] 48.94937
#VAPとVEPの平均投票率の差
> mean(VEPRATE)-mean(VAPRATE)
[1] 3.492794

解答

VAPの平均投票率は、約45.45%

VEPの平均投票率は、約48.94%

VEPの平均投票率のほうがVAPより、約3.49%高い

イワマ

そりゃあデータを見るとVEP(有権者人口)のほうがVAP(選挙年齢人口）より少ないから、投票率あがるよなあ

イワマ

ってか、有権者人口と選挙年齢人口の違いが分からぬ

3

Rscript

#3
#ANESからVAP、VEPの投票率を引いた変数を作成
> VAPANES <- turnout$ANES-VAPRATE 
> VEPANES <- turnout$ANES-VEPRATE 

#平均値 
> mean(VAPANES)
[1] 20.32914
> mean(VEPANES)
[1] 16.83634

#差の範囲
> range(VAPANES)
[1] 11.06116 26.17150
> range(VEPANES)
[1]  8.581054 22.489359

解答

VAPとANESの投票率差の平均は約20.32%、差の範囲は約11.06%から約26.17%となっている。

VEPとANESの投票率差の平均は約16.82%、差の範囲は約8.58%から約22.48%となっている。

ANESの投票率はVAPよりVEPのほうに近く、差の範囲もVEPのほうが狭い

イワマ

でも、ANESの調査は実態から16%や20%も乖離してるってことだよね

イワマ

集計の方法にバイアスがないなら、これが社会的望ましさバイアスそのもの

イワマ

結構でかい

4

Rscript

#4
#大統領選挙と中間選挙の変数を作成
> ele <- turnout[c(1,3,5,7,9,11,13,14),]#大統領選挙 
> int <- turnout[c(2,4,6,8,10,12),]#中間選挙    

#大統領選挙のVEP投票率
> ele_VEPRATE<- 100 * ele$total/ele$VEP 
> ele_VEPRATE
[1] 54.19551 55.24860 52.76848 58.11384 51.65793 54.22449 60.10084 61.55433

#大統領選挙のANES投票率
> ele$ANES
[1] 71 74 70 75 73 73 77 78

#中間選挙のVEP投票率
> int_VEPRATE<- 100 * int$total/int$VEP 
> int_VEPRATE
[1] 42.13701 38.14115 38.41895 41.12625 38.09316 39.51064

#中間選挙のANES投票率
> int$ANES
[1] 60 53 47 56 52 62

#大統領選挙のVEPとANES投票率の平均差
> mean(ele_VEPANES)
[1] 17.892
#中間選挙のVEPとANES投票率の平均差
> mean(int_VEPANES)
[1] 15.4288
#大統領選挙と中間選挙のANESバイアス平均差
> mean(ele_VEPANES)-mean(int_VEPANES)
[1] 2.463193

解答

大統領選挙の方が中間選挙より、ANESのバイアスが約2.46%大きい（ANESとVEP投票率の差が大きい）

イワマ

大統領選挙の時の方が、「俺はちゃんと選挙いったぜ！（実は行ってないけど）」って言いたくなるみたい

イワマ

今の日本も、「選挙行ってない」って言うとなんか国民の義務を果たしていない感で後ろめたくなるよね（実体験）

5

Rscript

#5
#年を基準に前半と後半に分ける
> F <- turnout[c(1:7),] 
> L <- turnout[c(8:14),]  

#前半のVEP投票率
> F_VEPRATE<- 100*F$total/F$VEP 
> F_VEPRATE
[1] 54.19551 42.13701 55.24860 38.14115 52.76848 38.41895 58.11384

#前半のANES投票率
> F$ANES
[1] 71 60 74 53 70 47 75


#後半のVEP投票率
> L_VEPRATE<- 100*L$total/L$VEP 
> L_VEPRATE
[1] 41.12625 51.65793 38.09316 54.22449 39.51064 60.10084 61.55433

#後半のANES投票率
> L$ANES
[1] 56 73 52 73 62 77 78

#VEPとANESの投票率の差
> F_VEPANES <- F$ANES - F_VEPRATE
> L_VEPANES <- L$ANES - L_VEPRATE
> mean(F_VEPANES)
[1] 15.85378
> mean(L_VEPANES)
[1] 17.81891
#ANESの前半と後半期間のバイアス差
> mean(F_VEPANES) - mean(L_VEPANES)
[1] -1.965126

解答

前半期間より後半期間のバイアスが約1.96%増えており、ANESのバイアスは時間とともに増えている。

イワマ

なんで時が経つに連れてバイアスが大きくなったんだろう

イワマ

選挙教育で、選挙に行くのが社会人として当たり前という価値観が浸透したからだろうか

6

Rscript

#6
#補正済みVAP
> adVAP <- turnout$VAP - turnout$felons - turnout$noncit

#補正済み投票数 
> adtotal <- turnout$total 
> adtotal
 [1]  86515  67616  92653  64991  91595  67859 104405  75106  96263  72537 105375  78382 122295 131304
> adtotal[14] <- turnout[14,"total"] - turnout[14,"osvoters"] 
> adtotal
 [1]  86515  67616  92653  64991  91595  67859 104405  75106  96263  72537 105375  78382 122295 131041

#補正済みVAP投票率
> adVAPrate <- 100 * adtotal / adVAP 
> adVAPrate
 [1] 54.79552 42.67959 56.03515 38.64073 53.53897 38.99517 58.93660 41.65151 52.36551 38.70601 55.07730 40.18415 61.42082 62.89918

#補正済みVAP投票率の平均
> mean(adVAPrate)
[1] 49.70901
#ANESの平均投票率（算出してなかったので）
> mean(turnout$ANES)
[1] 65.78571

解答

補正済みVAP平均投票率が約49.7%、VAP平均投票率が約45.45%、VEP平均投票率が約48.94%、ANES平均投票率が約65.78%

補正済みVAP平均投票率にはVEPの値が一番近い。

イワマ

投票率ってVEP(有権者人口)を使うのが定義です(by wikipedia)

イワマ

なので、わざわざVAP（選挙年齢人口）や補正済みVAP（選挙年齢人口から受刑者や外国人を引いたもの）を使った意味が分からずなので、考察がはかどりませんでした。

練習問題1.5.2

次は人口動態の問題

生まれた人の数や死んだ人の数から、ケニアやスェーデン、世界全体の人口の動きをデータ分析していきます。

1

コード

#データ読み込み
> Kenya <- read.csv("Kenya.csv") 
> Sweden <- read.csv("Sweden.csv") 
> World <- read.csv("World.csv")  

#データ閲覧
> View(Kenya)
> View(Sweden)
> View(World)

#基本統計量 
> summary(Kenya)

#総観察人年
>Kenya$py <- Kenya$py.men + Sweden$py.women
>Sweden$py <- Sweden$py.men + Sweden$py.women
>World$py <- World$py.men + World$py.women

#CBR算出
> CBR.Kenya <- c(sum(Kenya[c(1:15),"births"]) / sum(Kenya[c(1:15),"py"]),
+                sum(Kenya[c(16:30),"births"]) / sum(Kenya[c(16:30),"py"]))
> CBR.Kenya
[1] 0.05209490 0.03851507
> CBR.Sweden <- c(sum(Sweden[c(1:15),"births"]) / sum(Sweden[c(1:15),"py"]),
+                 sum(Sweden[c(16:30),"births"] )/ sum(Sweden[c(16:30),"py"]))
> CBR.Sweden
[1] 0.01539614 0.01192554
> CBR.World <- c(sum(World[c(1:15),"births"]) / sum(World[c(1:15),"py"]),
+                sum(World[c(16:30),"births"]) / sum(World[c(16:30),"py"]))
> CBR.World
[1] 0.03732863 0.02021593

解答

ケニアのCBRは、1950-1955年は5.2%、2005-2010は3.85%

スウェーデンのCBRは、1950-1955年は1.53%、2005-2010は1.19%

世界全体のCBRは、1950-1955年は3.73%、2005-2010は2.02%

ケニア、スェーデン、世界全体、どれも粗出生率(CBR)は減少している。

２

コード

#2
#ケニアのASFR
> ASFR.Kenya <- Kenya$births/Kenya$py.women 
> ASFR.Kenya[c(4,5,6,7,8,9,10)]
[1] 0.16884585 0.35596942 0.34657814 0.28946367 0.20644016 0.11193267 0.03905205
> ASFR.Kenya[c(19,20,21,22,23,24,25)]
[1] 0.10057087 0.23583536 0.23294721 0.18087964 0.13126805 0.05626214 0.03815044
> ASFR.Kenya <- ASFR.Kenya[c(4,5,6,7,8,9,10,19,20,21,22,23,24,25)]

#スウェーデンのASFR
> ASFR.Sweden <- Sweden$births/Sweden$py.women 
> ASFR.Sweden[c(4,5,6,7,8,9,10)]
[1] 0.038908952 0.127710883 0.125243665 0.087364159 0.048603771 0.016210186 0.001341829
> ASFR.Sweden[c(19,20,21,22,23,24,25)]
[1] 0.0059709097 0.0507320271 0.1162085625 0.1322744621 0.0625923991 0.0121600765 0.0006143942
> ASFR.Sweden <- ASFR.Sweden[c(4,5,6,7,8,9,10,19,20,21,22,23,24,25)]

#世界全体のASFR 
> ASFR.World <- World$births/World$py.women 
> ASFR.World[c(4,5,6,7,8,9,10)]
[1] 0.09029521 0.23763370 0.25245229 0.20416410 0.13810534 0.06360832 0.01519064
> ASFR.World[c(19,20,21,22,23,24,25)]
[1] 0.048489719 0.151971307 0.146980966 0.093813813 0.046689639 0.016268995 0.004510245
> ASFR.World <- ASFR.World[c(4,5,6,7,8,9,10,19,20,21,22,23,24,25)]

解答

全体的にケニアのほうがスウェーデンより年齢別出生率は高く、総じて前半期間(1950-1955)のほうが後半期間(2005-2010)

より高い。

スウェーデンの後半期間は、25-30歳は10%以上の出生率であるが、それ以外は10%をきっている。逆にケニアの後半期間では、15-40歳まで10%以上の出生率をほこっている。

イワマ

ちゃんと分析結果を示すなら、縦軸に出生率、横軸を年齢別にして、折れ線グラフを書いた方がわかりやすい

３

コード

#ケニアのTFR
> TFR.KenyaF <- sum(ASFR.Kenya[c(1:7)]* 5) 
> TFR.KenyaL <- sum(ASFR.Kenya[c(8:14)]* 5) 
> TFR.Kenya <- c(TFR.KenyaF,TFR.KenyaL) 
> TFR.Kenya
[1] 7.591410 4.879568

#スウェーデンのTFR
> TFR.SwedenF <- sum(ASFR.Sweden[c(1:7)]* 5) 
> TFR.SwedenL <- sum(ASFR.Sweden[c(8:14)]* 5) 
> TFR.Sweden <- c(TFR.SwedenF,TFR.SwedenL ) 
> TFR.Sweden
[1] 2.226917 1.902764

#世界全体のTFR
> TFR.WorldF <- sum(ASFR.World[c(1:7)]* 5) 
> TFR.WorldL <- sum(ASFR.World[c(8:14)]* 5) 
> TFR.World <- c(TFR.WorldF,TFR.WorldL) 
> TFR.World
[1] 5.007248 2.543623

解答

ケニアのTFRは、1950-1955年は7.59、2005-2010は4.87

スウェーデンのTFRは、1950-1955年は2.22、2005-2010は1.9

世界全体のTFRは、1950-1955年は5、2005-2010は2.5

女性数や出生数は増えているが、女性数の増加ペースが早いため、1人の女性が出産可能時期に産む子供の数（TFR)は減少している。

イワマ

え、ケニアって1人の女性が８人も産むの？？？

イワマ

少子化って、経済状態と治安を悪くすれば解決するよね（本末転倒）

４

コード

#4
#ケニアのCDR
> CDR.KenyaF <- sum(Kenya[c(1:15),"deaths"]) / sum(Kenya[c(1:15),"py"]) 
> CDR.KenyaL <- sum(Kenya[c(16:30),"deaths"]) / sum(Kenya[c(16:30),"py"]) 
> CDR.Kenya <- c(CDR.KenyaF,CDR.KenyaL) 
> CDR.Kenya 
[1] 0.02396254 0.01038914

#スウェーデンのCDR 
> CDR.SwedenF <- sum(Sweden[c(1:15),"deaths"]) / sum(Sweden[c(1:15),"py"]) 
> CDR.SwedenL <- sum(Sweden[c(16:30),"deaths"]) / sum(Sweden[c(16:30),"py"]) 
> CDR.Sweden <- c(CDR.SwedenF,CDR.SwedenL) 
> CDR.Sweden 
[1] 0.009844842 0.009968455

#世界のCDR
> CDR.WorldF <- sum(World[c(1:15),"deaths"]) / sum(World[c(1:15),"py"]) 
> CDR.WorldL <- sum(Sweden[c(16:30),"deaths"]) / sum(World[c(16:30),"py"]) 
> CDR.World <- c(CDR.WorldF,CDR.WorldL) 
> CDR.World
[1] 1.931893e-02 1.368922e-05

解答

ケニアのCDRは、1950-1955年は2.39%、2005-2010は1.03%

スウェーデンのCDRは、1950-1955年は0.98%、2005-2010は0.99%

世界全体のCDRは、1950-1955年は1.9%、2005-2010は0.013%

ケニアや世界全体のCDRは後半期間に減少しているが、スウェーデンは前半期間と後半期間にあまり変化はない

イワマ

スウェーデンは社会として成熟してるから粗死亡率は一定なんだろうなあ

５

コード

#5
#ASDRの算出
> ASDR.Kenya <- Kenya[c(16:30),"deaths"] / Kenya[c(16:30),"py"] 
> ASDR.Sweden <- Sweden[c(16:30),"deaths"] / Sweden[c(16:30),"py"] 
> ASDR.Kenya
[1] 0.020920755 0.002911301 0.002918895 0.002942986 0.003885368 0.006558131 0.010603913 0.013881062
[9] 0.013474598 0.011288057 0.011152339 0.013898334 0.025395531 0.061261551 0.158620510
> ASDR.Sweden
[1] 6.790712e-04 8.138094e-05 1.135496e-04 2.687775e-04 4.697344e-04 4.941440e-04 5.057066e-04
[8] 6.689578e-04 1.039256e-03 1.769621e-03 2.988715e-03 4.709913e-03 9.828772e-03 2.803963e-02
[15] 1.098892e-01

解答

どの年代もケニアのほうがASDRが高い

イワマ

これも実際には、縦軸に死亡率、横軸に年代をとって、折れ線にするのが良さそう

６

コード

#6
P.Kenya <- Kenya[c(16:30),"py"] / sum(Kenya[c(16:30),"py"])
P.Sweden <- Sweden[c(16:30),"py"] / sum(Sweden[c(16:30),"py"])

#ケニアの反事実
sum(ASDR.Kenya * P.Sweden)
[1] 0.02321646
#スウェーデンの反事実#おまけ
sum(ASDR.Sweden * P.Kenya)
[1] 0.001610853

解答

もともとのケニアのCDRは1.03%、反事実のケニアのCDRは2.32%である。

もしケニアがスウェーデンと同じ人口分布だった場合、粗死亡率は2倍以上になる。

イワマ

この反事実っていうのは、因果推論でよくでてくるので第2章の2.3を読んでからのほうが理解が早いと思う

『社会科学のためのデータ分析入門』練習問題の解答第1章

練習問題1.5.1

1

2

3

4

5

6

練習問題1.5.2

1

２

３

４

５

６

2 Comments

コメントを残すコメントをキャンセル

練習問題1.5.1

1

2

3

4

5

6

練習問題1.5.2

1

２

３

４

５

６

2 Comments

コメントを残す コメントをキャンセル

コメントを残すコメントをキャンセル