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

練習問題2.8.1

1

コード

> #1
> #データ読み込み
> star <- read.csv("STAR.csv") 
> #基本統計量
> dim(star)
[1] 6325    6

> summary(star)#省略

> #kinder作成
> star$kinder <- NA 
> star$kinder[star$classtype == 1] <- "small" 
> star$kinder[star$classtype == 2] <- "middle" 
> star$kinder[star$classtype == 3] <- "big" 
> star$kinder <- as.factor(star$kinder)  

> #race上書き
> star$race[star$race == 1] <- "white" 
> star$race[star$race == 2] <- "black" 
> star$race[star$race == 4] <- "hispanic" 
> star$race[star$race == 3 | star$race == 5| star$race == 6] <- "others" 
> star$race <- as.factor(star$race)

2

コード

> #2
> #部分集合
> small <- subset(star,star$kinder == "small") 
> middle <- subset(star,star$kinder == "middle")  

> #点数
> mean(small$g4math, na.rm = TRUE)
[1] 709.1851
> mean(small$g4reading, na.rm = TRUE)
[1] 723.3912
> mean(middle$g4math, na.rm = TRUE)
[1] 709.5214
> mean(middle$g4reading, na.rm = TRUE)
[1] 719.89

 
> #標準偏差
> sd(small$g4math, na.rm = TRUE)
[1] 43.57318
> sd(small$g4reading, na.rm = TRUE)
[1] 51.54494
> sd(middle$g4math, na.rm = TRUE)
[1] 41.02063
> sd(middle$g4reading, na.rm = TRUE)
[1] 53.16788

解答

算数の平均点は少人数クラスのほうが、約0.34点低い

読解の平均点は少人数クラスのほうが、約4.1点高い

算数の標準偏差は少人数クラスのほうが、約2.55大きい

読解の標準偏差は少人数クラスのほうが、約1.62小さい

算数の成績は少人数クラスのほうが成績が良いとは言えないが、読解の成績は平均点が高くかつ標準偏差が小さいことから、少人数クラスのほうが読解の成績が良いと言える。

イワマ

算数は地頭が大事なのかな

イワマ

国語はどのくらい文や表現に触れているかが勝負だから少人数クラスのほうが良いのかもです

3

コード

> #3
> #3分位置
> quantile(small$g4math, probs = seq(from = 0, to = 1, by = 1/3) , na.rm = TRUE)
0% 33.33333% 66.66667% 100% 
487 695 726 821 
> quantile(small$g4reading, probs = seq(from = 0, to = 1, by = 1/3) , na.rm = TRUE)
0% 33.33333% 66.66667% 100% 
528 705 741 836 
> quantile(middle$g4math, probs = seq(from = 0, to = 1, by = 1/3) , na.rm = TRUE)
0% 33.33333% 66.66667% 100% 
487 696 725 821 
> quantile(middle$g4reading, probs = seq(from = 0, to = 1, by = 1/3) , na.rm = TRUE)
0% 33.33333% 66.66667% 100% 
528 705 740 836

解答

少人数クラスでも標準規模クラスでも、両教科の分位値に大きな違いはない。

読解では少人数クラスのほうが平均点が高いが、最低点・最高点等や分位値のところはクラスによる差がないと言える。

第1三分位値数と第２三分位値数の間にいる人たち、つまり平均点付近にいる人たちの成績は少人数クラスの集団が良いと言える可能性がある。

イワマ

分位値についての記述が難しい

イワマ

分位値を使った作図に箱ひげ図とかあるけど、あまり学術論文やビジネスでのレポートでは見ないよね、だから解釈も慣れない。。。

イワマ

RTokyoを運営している玄人データサイエンティストの人によると、結構箱ひげ図は便利と言っていたので使いこなせるようになりたみ

4

コード

> #4
> #分割表
> year.kinder.tab <- table(year = star$yearssmall, kinder = star$kinder)
> year.kinder.tab
            kinder
year    big middle small
0        1996 1961 0
1         97 95 576
2         60 58 272
3         78 80 195
4         0 0 857

> #少人数クラス期間別算数平均
> tapply(star$g4math, star$yearssmall, mean, na.rm = TRUE)
0 1 2 3 4 
707.9793 707.5524 711.9140 709.6170 710.0519 

> #少人数クラス期間別算数中央値
> tapply(star$g4math, star$yearssmall, median, na.rm = TRUE)
0 1 2 3 4 
710 709 714 712 711 

> #少人数クラス期間別国語平均
> tapply(star$g4reading, star$yearssmall, mean, na.rm = TRUE)
0 1 2 3 4 
719.8754 723.1471 717.8681 719.8986 724.6651 

> #少人数クラス期間別国語中央値
> tapply(star$g4reading, star$yearssmall, median, na.rm = TRUE)
0 1 2 3 4 
722.0 724.5 720.0 721.0 726.0

解答

分割表の記述については省略

算数の成績は少人数クラスの2年間在籍している集団が平均点も中央値も一番高く、在籍している期間が長いほど成績が良いわけではなかった。

国語の成績は少人数クラスに一番長く（4年間）在籍している集団が平均点も中央値も一番高いが、在籍している期間が長いほど成績が良いわけではなく、国語は1年間在籍している集団が2,3年間所属している集団より成績が高かった。

イワマ

少人数クラスのほうがコストが高いだろうし、期間が長ければ長いほど良いわけじゃないから、最適な年数で少人数クラスを終わらせたほうが良いのかもなあ

5

コード

> #5
> #中人数クラス人種別算数平均
> tapply(middle$g4math, middle$race, mean, na.rm = TRUE)
black hispanic others white 
698.5323 NA 713.0000 711.4104 

> #中人数クラス人種別国語平均
> tapply(middle$g4reading, middle$race, mean, na.rm = TRUE)
black hispanic others white 
689.3548 NA 741.5000 725.1158 

> #少人数クラス人種別算数平均
> tapply(small$g4math, small$race, mean, na.rm = TRUE)
black hispanic others white 
697.5043 739.5000 728.0000 711.1900 

> #少人数クラス人種別国語平均
> tapply(small$g4reading, small$race, mean, na.rm = TRUE)
black hispanic others white 
698.6140 737.5000 769.5000 727.8388

解答

標準規模クラスでは人種間に学力の違いがあり、算数では約12.88点、読解では約35.76点、白人の方が黒人より平均点が高い。

ヒスパニック系についてはデータがなかった。

少人数クラスでも人種間に学力の違いがあり、算数では約13.69点、読解では約29.22点、白人の方が黒人より平均点が高い。

逆にマイノリティでもヒスパニック系は、算数で約28点、読解で約10点、白人より平均点が高い。

白人と黒人については、算数では少人数クラスのほうが人種間の学力差が広がっている。国語では逆に少人数クラスのほうが学力差が縮まっている。

イワマ

国語は少人数のほうが良いのかもなあ

イワマ

子供の成績って親の所得や教育への態度によるだろうから、人種で区別するのはナンセンスな気もする

6

コード

> #6
> #クラス別卒業率
> tapply(star$hsgrad, star$kinder, mean, na.rm = TRUE)
big middle small 
0.8392857 0.8251619 0.8359202 

> #少人数クラス期間別別卒業率
> tapply(star$hsgrad, star$yearssmall, mean, na.rm = TRUE)
0 1 2 3 4 
0.8286020 0.7910448 0.8131868 0.8324607 0.8775510 


>#人種別卒業率
> tapply(middle$hsgrad, middle$race, mean, na.rm = TRUE)
    black  hispanic    others     white 
0.7395833        NA 0.6666667 0.8569620 
> tapply(small$hsgrad, small$race, mean, na.rm = TRUE)
    black  hispanic    others     white 
0.7446809       NaN 1.0000000 0.8674699

解答

補助教員付きのクラスが高卒できた割合が一番高い

少人数クラスに在籍していた集団のなかでは、少人数クラスに在籍すればするほど高卒できた割合が高い。しかし、少人数クラスに在籍したことがなかった集団に比べて、少人数クラスに在籍していた年数が1年、2年の集団は高卒できた割が約3%、約1.5%それぞれ低い。

標準規模クラスでは、白人のほうが黒人に比べて高卒できた割合が11.74%で、少人数クラスでは、白人のほうが黒人に比べて高卒できた割合が12.28%であった。そのため、STARプロジェクトはマイノリティの卒業格差を縮めたとは言えない。

イワマ

少人数クラスがそんなに良いわけではないということがわかりましたね

イワマ

実際、資本主義が成熟してくると、代替可能な低賃金労働者か高技能な高給取りのどっちかしかいらなくなるから、現在のアメリカだと全員が高卒するのが社会全体から見ると良いことかはわからないけどね

練習問題2.8.2

1

コード

> #1
> #データ読み込み
> gay <- read.csv("gay.csv")
> #基本統計量
> dim(gay)
[1] 69592 4
> summary(gay)#省略

> #ベースラインインタビュー変数作成
> wave1 <- subset(gay, gay$study == 1 & gay$wave == 1)
> #バイアスが無いか調べる
> tapply(wave1$ssm, wave1$treatment, mean)
No Contact 
3.042764 
Recycling Script by Gay Canvasser 
3.130975 
Recycling Script by Straight Canvasser 
3.013474 
Same-Sex Marriage Script by Gay Canvasser 
3.025195 
Same-Sex Marriage Script by Straight Canvasser 
3.099710

2

コード

[codebox title="コード"]

> #2
> #第２波調査
> wave2 <- subset(gay, gay$study == 1 & gay$wave == 2)

#ゲイ調査員のトリートメント効果
> (mean(wave2$ssm[wave2$treatment == "Same-Sex Marriage Script by Gay Canvasser"])-mean(wave1$ssm[wave1$treatment == "Same-Sex Marriage Script by Gay Canvasser"]))-(mean(wave2$ssm[wave2$treatment == "No Contact"])-mean(wave1$ssm[wave1$treatment == "No Contact"]))
[1] 0.1174436

#ストレート調査員のトリートメント効果
> (mean(wave2$ssm[wave2$treatment == "Same-Sex Marriage Script by Straight Canvasser"])-mean(wave1$ssm[wave1$treatment == "Same-Sex Marriage Script by Straight Canvasser"]))-(mean(wave2$ssm[wave2$treatment == "No Contact"])-mean(wave1$ssm[wave1$treatment == "No Contact"]))
[1] 0.0653028

[/codebox]

解答

ゲイ調査員が訪問した方が、約0.052点同性婚の対する支持が高くなる。

3

コード

> #3
#ゲイがリサイクルを勧めた場合
> (mean(wave2$ssm[wave2$treatment == "Recycling Script by Gay Canvasser"])-mean(wave1$ssm[wave1$treatment == "Recycling Script by Gay Canvasser"]))-(mean(wave2$ssm[wave2$treatment == "No Contact"])-mean(wave1$ssm[wave1$treatment == "No Contact"]))
[1] -0.02037848

#ストレートがリサイクルを勧めた場合
> (mean(wave2$ssm[wave2$treatment == "Recycling Script by Straight Canvasser"])-mean(wave1$ssm[wave1$treatment == "Recycling Script by Straight Canvasser"]))-(mean(wave2$ssm[wave2$treatment == "No Contact"])-mean(wave1$ssm[wave1$treatment == "No Contact"]))
[1] -0.006046567

解答

どんな内容であれゲイの人（またはストレートの人）が訪問した場合によるバイアスを確かめるため。

ゲイであれストレートであれ、同性婚に対する支持の点数は減るないし、ほぼ変化はない。

そのため、訪問した人が同性婚以外の内容を話すことについてのバイアスは存在しない可能性が高いと言える。

4

コード

#WAVE4
> wave4 <- subset(gay, gay$study == 1 & gay$wave == 4)
> (mean(wave4$ssm[wave4$treatment == "Same-Sex Marriage Script by Gay Canvasser"])-mean(wave1$ssm[wave1$treatment == "Same-Sex Marriage Script by Gay Canvasser"]))-(mean(wave4$ssm[wave4$treatment == "No Contact"])-mean(wave1$ssm[wave1$treatment == "No Contact"]))
[1] 0.1101947
> (mean(wave4$ssm[wave4$treatment == "Same-Sex Marriage Script by Straight Canvasser"])-mean(wave1$ssm[wave1$treatment == "Same-Sex Marriage Script by Straight Canvasser"]))-(mean(wave4$ssm[wave4$treatment == "No Contact"])-mean(wave1$ssm[wave1$treatment == "No Contact"]))
[1] 0.03025142

#WAVE5
> wave5 <- subset(gay, gay$study == 1 & gay$wave == 5)
> (mean(wave5$ssm[wave5$treatment == "Same-Sex Marriage Script by Gay Canvasser"])-mean(wave1$ssm[wave1$treatment == "Same-Sex Marriage Script by Gay Canvasser"]))-(mean(wave5$ssm[wave5$treatment == "No Contact"])-mean(wave1$ssm[wave1$treatment == "No Contact"]))
[1] 0.1654644
> (mean(wave5$ssm[wave5$treatment == "Same-Sex Marriage Script by Straight Canvasser"])-mean(wave1$ssm[wave1$treatment == "Same-Sex Marriage Script by Straight Canvasser"]))-(mean(wave5$ssm[wave5$treatment == "No Contact"])-mean(wave1$ssm[wave1$treatment == "No Contact"]))
[1] 0.04161006

#WAVE6
> wave6 <- subset(gay, gay$study == 1 & gay$wave == 6)
> (mean(wave6$ssm[wave6$treatment == "Same-Sex Marriage Script by Gay Canvasser"])-mean(wave1$ssm[wave1$treatment == "Same-Sex Marriage Script by Gay Canvasser"]))-(mean(wave6$ssm[wave6$treatment == "No Contact"])-mean(wave1$ssm[wave1$treatment == "No Contact"]))
[1] 0.1040044
> (mean(wave6$ssm[wave6$treatment == "Same-Sex Marriage Script by Straight Canvasser"])-mean(wave1$ssm[wave1$treatment == "Same-Sex Marriage Script by Straight Canvasser"]))-(mean(wave6$ssm[wave6$treatment == "No Contact"])-mean(wave1$ssm[wave1$treatment == "No Contact"]))
[1] 0.006570065

#WAVE7
> wave7 <- subset(gay, gay$study == 1 & gay$wave == 7)
> (mean(wave7$ssm[wave7$treatment == "Same-Sex Marriage Script by Gay Canvasser"])-mean(wave1$ssm[wave1$treatment == "Same-Sex Marriage Script by Gay Canvasser"]))-(mean(wave7$ssm[wave7$treatment == "No Contact"])-mean(wave1$ssm[wave1$treatment == "No Contact"]))
[1] 0.07693728
> (mean(wave7$ssm[wave7$treatment == "Same-Sex Marriage Script by Straight Canvasser"])-mean(wave1$ssm[wave1$treatment == "Same-Sex Marriage Script by Straight Canvasser"]))-(mean(wave7$ssm[wave7$treatment == "No Contact"])-mean(wave1$ssm[wave1$treatment == "No Contact"]))
[1] -0.09948238

解答

結果は省略

全体的に５波までは効果は高くなる傾向だったが、1年後の第７波は第２波に比べて減少してしまっている。

それでも、ゲイが訪問員として同性婚台本を用いた場合の条件では戸別訪問の効果は持続していると言える。

イワマ

この解答って好意的に書くか、否定的に書くかがわからぬ

5

コード

> #5
> wave1.2 <- subset(gay, gay$study == 2 & gay$wave == 1)
> tapply(wave1.2$ssm, wave1.2$treatment, mean)
No Contact 
2.970075 
Recycling Script by Gay Canvasser 
NA 
Recycling Script by Straight Canvasser 
NA 
Same-Sex Marriage Script by Gay Canvasser 
2.971729 
Same-Sex Marriage Script by Straight Canvasser 
NA

解答

変化が大きくないため、ランダム化は適切に行われていると言える

6

コード

> #6
> wave2.2 <- subset(gay, gay$study == 2 & gay$wave == 2)
> (mean(wave2.2$ssm[wave2.2$treatment == "Same-Sex Marriage Script by Gay Canvasser"])-mean(wave1.2$ssm[wave1.2$treatment == "Same-Sex Marriage Script by Gay Canvasser"]))-(mean(wave2.2$ssm[wave2.2$treatment == "No Contact"])-mean(wave1.2$ssm[wave1.2$treatment == "No Contact"]))
[1] 0.1222399

解答

研究1でのゲイによるトリートメント効果は0.1174436、研究2では0.1222399で、そこまで大きな差はなかった。

よってほぼ一致してると言える。

7

コード

> #7
>#WAVE3
> wave3.2 <- subset(gay, gay$study == 2 & gay$wave == 3)
> (mean(wave3.2$ssm[wave3.2$treatment == "Same-Sex Marriage Script by Gay Canvasser"])-mean(wave1.2$ssm[wave1.2$treatment == "Same-Sex Marriage Script by Gay Canvasser"]))-(mean(wave3.2$ssm[wave3.2$treatment == "No Contact"])-mean(wave1.2$ssm[wave1.2$treatment == "No Contact"]))
[1] 0.1487668

>#WAVE4
> wave4.2 <- subset(gay, gay$study == 2 & gay$wave == 4)
> (mean(wave4.2$ssm[wave4.2$treatment == "Same-Sex Marriage Script by Gay Canvasser"])-mean(wave1.2$ssm[wave1.2$treatment == "Same-Sex Marriage Script by Gay Canvasser"]))-(mean(wave4.2$ssm[wave4.2$treatment == "No Contact"])-mean(wave1.2$ssm[wave1.2$treatment == "No Contact"]))
[1] 0.12352

> #WAVE7
> wave7.2 <- subset(gay, gay$study == 2 & gay$wave == 7)
> (mean(wave7.2$ssm[wave7.2$treatment == "Same-Sex Marriage Script by Gay Canvasser"])-mean(wave1.2$ssm[wave1.2$treatment == "Same-Sex Marriage Script by Gay Canvasser"]))-(mean(wave7.2$ssm[wave7.2$treatment == "No Contact"])-mean(wave1.2$ssm[wave1.2$treatment == "No Contact"]))
[1] 0.3054089

解答

研究全体として、ゲイの訪問員が同性婚台本を用いる条件かであると、同性婚への支持が高まる効果がある。

イワマ

実際にゲイの人と会うと、同性婚も認めてやろうという気になるんだろうね

イワマ

ゲイの人への潜在的な嫌悪感は、実際に交流することで減りそうですね

練習問題2.8.3

1

コード

> #1
> leaders <- read.csv("leaders.csv")
> dim(leaders)
[1] 250 11
> summary(leaders)#省略

> #暗殺計画回数を調べる
> nrow(leaders)
[1] 250

> #暗殺計画のあった国数を調べる
> length(unique(leaders$country))
[1] 88

> #年で平均何回の暗殺計画があったか
> nrow(leaders)/length(unique(leaders$year))
[1] 2.45098

解答

250の暗殺計画が記録されている。

少なくとも1回は指導者暗殺が計画された国は88ヶ国ある。

年に平均して約2.45回暗殺計画がある

イワマ

何気に暗殺計画が一番多いの日本なのジワる

2

コード

> #2
> leaders$success <- NA
> leaders$success[leaders$result == "dies within a day after the attack"] <- 1
> leaders$success[leaders$result != "dies within a day after the attack"] <- 0
> mean(leaders$success)
[1] 0.184

解答

指導者暗殺計画の全体的な成功率は18.4%である。

そのため暗殺の成功はランダムに決まるという仮定は妥当ではない。

イワマ

結構、成功率高いやん

イワマ

先進国と発展途上国では、捜査能力が異なるからきっと成功率はだいぶ違うんだろうけど

3

コード

> #3
> tapply(leaders$politybefore, leaders$success, mean)
0 1 
-1.7892157 -0.3188406 
> tapply(leaders$age, leaders$success, mean)
0 1 
52.69118 57.21739

解答

暗殺が成功した計画の平均ポリティ指標は約-0.31、失敗した計画の平均ポリティ指標は約-1.78で、暗殺に成功するほうが平均ポリティ指標が高い。

また、成功した暗殺計画の指導者の平均年齢は約52.69歳、失敗した時の指導者の平均年齢は約57.21歳で、暗殺に成功するほうが指導者の平均年齢は低い。

上記より、暗殺の成功はランダムに決まるという仮定は妥当ではないと言える。

イワマ

若い人がターゲットなほど、暗殺は成功するのか

イワマ

やっぱ、亀の甲で身の回りに身長になるんですかね

4

コード

> #4
> leaders$warbefore <- NA
> leaders$warbefore[leaders$interwarbefore == 1 | leaders$civilwarbefore == 1] <- 1
> leaders$warbefore[leaders$interwarbefore != 1 & leaders$civilwarbefore != 1] <- 0
> warYES <- subset(leaders, leaders$warbefore == 1)
> tapply(warYES$politybefore, warYES$success, mean)
0 1 
-1.6973684 -0.1666667 
> tapply(warYES$age, warYES$success, mean)
0 1 
53.25 57.50

解答

戦争経験があった中で、暗殺が成功した計画の平均ポリティ指標は約-1.69、失敗した計画の平均ポリティ指標は約-0.166で、暗殺に成功するほうが平均ポリティ指標が高い。しかし、成功と失敗の平均ポリティ指標の差は戦争経験があった方が小さい。平均ポリティ指標は戦争経験が関わっている可能性が高い。

また、成功した暗殺計画の指導者の平均年齢は約53.25歳、失敗した時の指導者の平均年齢は約57.50歳で、暗殺に成功するほうが指導者の平均年齢は低い。こちらは戦争経験があろうとなかろうと結果は大きく変わらなかった。

イワマ

まあ、そうでしょうな

5

コード

> #5
> leaders$warafter <- NA
> leaders$warafter[leaders$interwarafter == 1 | leaders$civilwarafter == 1] <- 1
> leaders$warafter[leaders$interwarafter != 1 & leaders$civilwarafter != 1] <- 0
> tapply(leaders$warafter, leaders$success, mean)
0 1 
0.2941176 0.1956522
> tapply(leaders$polityafter, leaders$success, mean)
         0          1 
-1.9493464 -0.3224638

解答

暗殺が成功した計画した後の3年間で戦争が起きた確率は約29.41%、失敗した場合は約19.56%だった。

暗殺が成功した計画した後の3年間でのポリティ指標は約-1.94、失敗した場合は約-0.32だった。

よって、失敗に比べて、暗殺成功は民主化を後退させ、戦争を引き起こす可能性が高いと言える

イワマ

民主化に進もうとしてた指導者を殺したのか、独裁を突き進めようとした指導者を殺したかにもよりそう

イワマ

まあ、暴力で政治を変えるのは民主主義に反するから、民主化は後退しそうだよね

イワマ

やっぱCIAがやってるような、市場原理主義を蔓延らせてから民主化運動を起こさせるのが賢いやり方かもね

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

練習問題2.8.1

1

2

3

4

5

6

練習問題2.8.2

1

2

3

4

5

6

7

練習問題2.8.3

1

2

3

4

5

4 Comments

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

練習問題2.8.1

1

2

3

4

5

6

練習問題2.8.2

1

2

3

4

5

6

7

練習問題2.8.3

1

2

3

4

5

4 Comments

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

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