【第２章因果関係】練習問題2.8.1「初期教育における少人数クラスの有効性」
１．データセット・元論文の紹介
（１）データセット
・第２章の練習問題に取り組む際に必要になるデータセットは、第１章の練習問題と同様に以下のリンク先からダウンロードできる。
（２）元論文
・本章の練習問題からは問題を作成するにあたって参考とした論文が脚注で紹介されている。練習問題を解き、興味が湧いて元論文を読みたいと思う方もいると思うので、参考のためリンクを貼っておく。
２．練習問題2.8.1「初期教育における少人数クラスの有効性」
（１）因子変数の作成
①幼稚園のクラスタイプ（classtype）に応じてkinder変数を設定。
②また、人種（race）に応じてrace.facter変数を設定。
> star <- read.csv("STAR.csv")
> dim(star)
[1] 6325 6
> summary(star)
race classtype yearssmall hsgrad g4math g4reading
Min. :1.000 Min. :1.000 Min. :0.0000 Min. :0.000 Min. :487.0 Min. :528.0
1st Qu.:1.000 1st Qu.:1.000 1st Qu.:0.0000 1st Qu.:1.000 1st Qu.:688.0 1st Qu.:696.0
Median :1.000 Median :2.000 Median :0.0000 Median :1.000 Median :710.0 Median :723.0
Mean :1.341 Mean :2.052 Mean :0.9542 Mean :0.833 Mean :708.8 Mean :721.2
3rd Qu.:2.000 3rd Qu.:3.000 3rd Qu.:2.0000 3rd Qu.:1.000 3rd Qu.:732.5 3rd Qu.:750.0
Max. :6.000 Max. :3.000 Max. :4.0000 Max. :1.000 Max. :821.0 Max. :836.0
NA's :3 NA's :3278 NA's :3930 NA's :3972
> star$kinder <- ifelse(star$classtype == 1,"small",ifelse(star$classtype == 2,"normal","support"))
> star$kinder <- as.factor(star$kinder)
> class(star$kinder)
[1] "factor"
> star$race.facter[star$race == 1] <- "white"
> star$race.facter[star$race == 2] <- "black"
> star$race.facter[star$race == 4] <- "hispanic"
> star$race.facter[(star$race != 1) & (star$race != 2) & star$race != 4] <- "others"
> star$race.facter <- as.factor(star$race.facter)
> class(star$race.facter)
[1] "factor"
> summary(star)
race classtype yearssmall hsgrad g4math g4reading
Min. :1.000 Min. :1.000 Min. :0.0000 Min. :0.000 Min. :487.0 Min. :528.0
1st Qu.:1.000 1st Qu.:1.000 1st Qu.:0.0000 1st Qu.:1.000 1st Qu.:688.0 1st Qu.:696.0
Median :1.000 Median :2.000 Median :0.0000 Median :1.000 Median :710.0 Median :723.0
Mean :1.341 Mean :2.052 Mean :0.9542 Mean :0.833 Mean :708.8 Mean :721.2
3rd Qu.:2.000 3rd Qu.:3.000 3rd Qu.:2.0000 3rd Qu.:1.000 3rd Qu.:732.5 3rd Qu.:750.0
Max. :6.000 Max. :3.000 Max. :4.0000 Max. :1.000 Max. :821.0 Max. :836.0
NA's :3 NA's :3278 NA's :3930 NA's :3972
kinder race.facter
normal :2194 black :2058
small :1900 hispanic: 5
support:2231 others : 25
white :4234
NA's : 3 （２）４年生時の算数・読解の成績への影響（平均・標準偏差）
①算数について
1)幼稚園のクラスタイプが少人数クラスの場合、平均値は709.2点。
一方、標準クラスは709.5点のため、平均値の差は殆ど無い。
2)少人数クラスと標準クラスの標準偏差には2.5点程度の差がある。
②読解について
1)幼稚園のクラスタイプが少人数クラスの場合、平均値は723.4点。
一方、標準クラスは719.9.点のため、3.5点ほど平均値に差がある。
2)少人数クラスと標準クラスの標準偏差には1.6点程度の差がある。
> tapply(star$g4math,star$kinder,summary)
$normal
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
487.0 688.0 710.0 709.5 731.8 821.0 1352
$small
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
487.0 686.8 710.0 709.2 736.2 821.0 1160
$support
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
487.0 688.0 710.0 707.6 732.0 821.0 1418
> tapply(star$g4math,star$kinder,sd,na.rm = TRUE)
normal small support
41.02063 43.57318 44.74373
> tapply(star$g4reading,star$kinder,summary)
$normal
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
528.0 693.0 723.0 719.9 749.2 836.0 1358
$small
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
528.0 697.0 724.0 723.4 750.0 836.0 1174
$support
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
528.0 697.5 722.0 720.7 750.0 836.0 1440
> tapply(star$g4reading,star$kinder,sd,na.rm = TRUE)
normal small support
53.16788 51.54494 52.44263
（３）４年生時の算数・読解の成績への影響（分位値トリートメント効果）
①算数について
1) 33%タイルは標準クラス696、少人数クラス694と2点の差がある。
2)66%タイルは標準クラス724、少人数クラス726と2点の差がある。
②読解について
1) 33%タイルは標準クラス705、少人数クラス705と差が無い。
2)66%タイルは標準クラス740、少人数クラス741と1点の差がある。
> quantile(star$g4math[star$kinder == "normal"],probs = seq(from = 0.33,to = 0.66,by = 0.11),na.rm = TRUE)
33% 44% 55% 66%
696 705 714 724
> quantile(star$g4math[star$kinder == "small"],probs = seq(from = 0.33,to = 0.66,by = 0.11),na.rm = TRUE)
33% 44% 55% 66%
694 705 715 726
> quantile(star$g4reading[star$kinder == "normal"],probs = seq(from = 0.33,to = 0.66,by = 0.11),na.rm = TRUE)
33% 44% 55% 66%
705 717 728 740
> quantile(star$g4reading[star$kinder == "small"],probs = seq(from = 0.33,to = 0.66,by = 0.11),na.rm = TRUE)
33% 44% 55% 66%
705 719 731 741
（４）少人数クラス在籍年数別の４年生時の算数・読解の成績への影響
＜少人数クラスの在籍年数について＞
①４年間継続して少人数クラスだった子供は857人
（kinder=small かつ yearsmall=4）
②４年間で一度も少人数クラスを経験していない子供は3,957人
（kinder=normal または support かつ yearsmall=0）
③4年間で最低１年間は少人数クラスだった子供は1,511人
（上記1),2)の条件に該当しない子供全て）
＜少人数クラスの在籍年数の長さによる成績の違い＞
①算数について
1)グラフではクラスタイプが少人数・標準については少人数クラス
の在籍年数の長さに応じで平均値・中央値ともに高くなる傾向が
あるように思われる（但し、単調増加では無い）。
2)一方、クラスタイプが補助指導付きは、少人数や標準よりも、
傾向が弱くなっているように思われる。
②読解について
・少人数クラスの在籍年数の長さに応じて、平均値・中央値が
必ずしも増加していないため、読解の成績に関して大きな変化は
みられない。
> table(kinder = star$kinder,yearssmall = star$yearssmall)
yearssmall
kinder 0 1 2 3 4
normal 1961 95 58 80 0
small 0 576 272 195 857
support 1996 97 60 78 0
> g4math_normal_yearsmall <- tapply(star$g4math[star$kinder=="normal"],star$yearssmall[star$kinder=="normal"],mean,na.rm=TRUE)
> g4math_small_yearsmall <- tapply(star$g4math[star$kinder=="small"],star$yearssmall[star$kinder=="small"],mean,na.rm=TRUE)
> g4math_support_yearsmall <- tapply(star$g4math[star$kinder=="support"],star$yearssmall[star$kinder=="support"],mean,na.rm=TRUE)
> g4math_normal_yearsmall_median <- tapply(star$g4math[star$kinder=="normal"],star$yearssmall[star$kinder=="normal"],median,na.rm=TRUE)
> g4math_small_yearsmall_median <- tapply(star$g4math[star$kinder=="small"],star$yearssmall[star$kinder=="small"],median,na.rm=TRUE)
> g4math_support_yearsmall_median <- tapply(star$g4math[star$kinder=="support"],star$yearssmall[star$kinder=="support"],median,na.rm=TRUE)
> par(mfrow = c(2,3))
> plot(g4math_normal_yearsmall,type = "b",ylim = c(695,720),ylab="score",xlab = "yearsmall",main = "g4math_normal_mean")
> plot(g4math_small_yearsmall,type = "b",ylim = c(695,720),ylab="score",xlab = "yearsmall",main = "g4math_small_mean")
> plot(g4math_support_yearsmall,type = "b",ylim = c(695,720),ylab="score",xlab = "yearsmall",main = "g4math_support_mean")
> plot(g4math_normal_yearsmall_median,type = "b",ylim = c(695,720),ylab="score",xlab = "yearsmall",main = "g4math_normal_median")
> plot(g4math_small_yearsmall_median,type = "b",ylim = c(695,720),ylab="score",xlab = "yearsmall",main = "g4math_small_median")
> plot(g4math_support_yearsmall_median,type = "b",ylim = c(695,720),ylab="score",xlab = "yearsmall",main = "g4math_support_median")
> g4reading_normal_yearsmall <- tapply(star$g4reading[star$kinder=="normal"],star$yearssmall[star$kinder=="normal"],mean,na.rm=TRUE)
> g4reading_small_yearsmall <- tapply(star$g4reading[star$kinder=="small"],star$yearssmall[star$kinder=="small"],mean,na.rm=TRUE)
> g4reading_support_yearsmall <- tapply(star$g4reading[star$kinder=="support"],star$yearssmall[star$kinder=="support"],mean,na.rm=TRUE)
> g4reading_normal_yearsmall_median <- tapply(star$g4reading[star$kinder=="normal"],star$yearssmall[star$kinder=="normal"],median,na.rm=TRUE)
> g4reading_small_yearsmall_median <- tapply(star$g4reading[star$kinder=="small"],star$yearssmall[star$kinder=="small"],median,na.rm=TRUE)
> g4reading_support_yearsmall_median <- tapply(star$g4reading[star$kinder=="support"],star$yearssmall[star$kinder=="support"],median,na.rm=TRUE)
> par(mfrow = c(2,3))
> plot(g4reading_normal_yearsmall,type = "b",ylim = c(700,735),ylab="score",xlab = "yearsmall",main = "g4reading_normal_mean")
> plot(g4reading_small_yearsmall,type = "b",ylim = c(700,735),ylab="score",xlab = "yearsmall",main = "g4reading_small_mean")
> plot(g4reading_support_yearsmall,type = "b",ylim = c(700,735),ylab="score",xlab = "yearsmall",main = "g4reading_support_mean")
> plot(g4reading_normal_yearsmall_median,type = "b",ylim = c(700,735),ylab="score",xlab = "yearsmall",main = "g4reading_normal_median")
> plot(g4reading_small_yearsmall_median,type = "b",ylim = c(700,735),ylab="score",xlab = "yearsmall",main = "g4reading_small_median")
> plot(g4reading_support_yearsmall_median,type = "b",ylim = c(700,735),ylab="score",xlab = "yearsmall",main = "g4reading_support_median")
（５）少人数クラスの人種間の学力差への影響
①算数について
1)幼稚園時のクラスタイプが標準の場合、白人の平均点は711.4、
マイノリティの平均点は698.5となり、その差は12.9である。
2)幼稚園時のクラスタイプが少人数の場合、白人の平均点は711.2、
マイノリティの平均点は698.2となり、その差は13である。
3)人種間の平均点の差の差は0.1しか違わないため、少人数クラスの
効果で人種間の学力差が縮まったと言えない。
②読解について
1)幼稚園時のクラスタイプが標準の場合、白人の平均点は725.1、
マイノリティの平均点は689.4となり、その差は35.7である。
2)幼稚園時のクラスタイプが少人数の場合、白人の平均点は727.8、
マイノリティの平均点は699.3となり、その差は28.5である。
3)人種間の平均点の差の差は7.2あるため、少人数クラスの効果により
人種間の学力差が多少縮まる可能性がある。
> star.normal <- star[star$kinder == "normal",]
> star.small <- star[star$kinder == "small",]
> star.normal$race.facter2 <- as.factor(star.normal$race.facter2)
> star.normal$race.facter2 <- NA
> star.normal$race.facter2[star.normal$race == 1] <- "white"
> star.normal$race.facter2[star.normal$race == 2 | star.normal$race == 4 ] <- "minority"
> star.normal$race.facter2[(star.normal$race != 1) & (star.normal$race != 2) & star.normal$race != 4] <- "others"
> star.normal$race.facter2 <- as.factor(star.normal$race.facter2)
> star.small$race.facter2 <- NA
> star.small$race.facter2[star.small$race == 1] <- "white"
> star.small$race.facter2[star.small$race == 2 | star.small$race == 4 ] <- "minority"
> star.small$race.facter2[(star.small$race != 1) & (star.small$race != 2) & star.small$race != 4] <- "others"
> star.small$race.facter2 <- as.factor(star.small$race.facter2)
> tapply(star.normal$g4math,star.normal$race.facter2,summary)
$minority
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
547.0 671.8 698.5 698.5 727.0 821.0 586
$others
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
694.0 701.5 713.5 713.0 725.0 731.0 6
$white
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
487.0 690.2 712.0 711.4 734.5 821.0 758
> tapply(star.small$g4math,star.small$race.facter2,summary)
$minority
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
545.0 678.0 696.0 698.2 726.0 821.0 480
$others
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
698 713 728 728 743 758 6
$white
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
487.0 689.0 713.0 711.2 739.0 821.0 673
> tapply(star.normal$g4reading,star.normal$race.facter2,summary)
$minority
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
528.0 671.5 695.5 689.4 721.0 836.0 586
$others
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
684.0 729.0 750.0 741.5 762.5 782.0 6
$white
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
528.0 699.0 726.0 725.1 750.0 836.0 764
> tapply(star.small$g4reading,star.small$race.facter2,summary)
$minority
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
528.0 674.0 699.5 699.3 731.0 836.0 481
$others
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
703.0 736.2 769.5 769.5 802.8 836.0 6
$white
Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
528.0 701.0 729.0 727.8 756.0 836.0 686
（６）少人数クラスの長期的な学業（高校卒業率）への影響
＜全人種対象の場合＞
①幼稚園時のクラスタイプが標準の場合、高校卒業率は0.825。
一方で少人数の場合、0.836であり、その差は0.011程度。
②少人数クラスの在籍期間別では0年の場合、高校卒業率は0.828。
一方で４年間の場合、0.877であり、その差は0.05程度と大きい。
> tapply(star$hsgrad,star$kinder,mean,na.rm=TRUE)
normal small support
0.8251619 0.8359202 0.8392857
> tapply(star$hsgrad,star$yearssmall,mean,na.rm=TRUE)
0 1 2 3 4
0.8286020 0.7910448 0.8131868 0.8324607 0.8775510 ＜人種別に影響を見た場合＞
①幼稚園時のクラスタイプが標準の場合、白人の高校卒業率は0.856、
一方マイノリティは0.739であり、その差は0.117になる
②クラスタイプが少人数の場合、白人の高校卒業率は0.867、一方で
マイノリティは0.744であり、その差は0.123になる。
③クラスタイプ別の人種間の高校卒業率の差の差は0.006 のため、
殆ど差が無いと思われる。
> tapply(star.normal$hsgrad,star.normal$race.facter2,mean,na.rm = TRUE)
minority others white
0.7395833 0.6666667 0.8569620
> tapply(star.small$hsgrad,star.small$race.facter2,mean,na.rm = TRUE)
minority others white
0.7446809 1.0000000 0.8674699
３．練習問題を解いた感想
・観察対象を問題意識に応じて部分集合化して、シンプルな記述統計で仮説を検証していく過程は面白い。
・相変わらず、tapply関数と可視化に頼っている。大学生の頃はRでグラフを作成することが殆どなかったので、なかなか作り方が身につかなかった。
・練習問題を解きつつ、自分からグラフ化した方がわかりやすいな、どのグラフを使おうかなと考えながら試行錯誤した方が当たり前だけど使い方が身に付くのでよかった。もっと見やすいグラフの作り方を学びたい。
この記事が気に入ったらサポートをしてみませんか？