出身階層間の教育達成格差を単純な数値シミュレーションで 表現する．

仮定

1.社会に上層（n1人）と下層（n0人）の2グループが存在する．

2.初期条件として子供の成績は正規分布にしたがう．

3.上層出身の子供は，下層出身の子供より平均値が高い．ただし分散は同じ．

4.全体の上位　x　人だけが進学できる．

関数eduは進学者がx人である場合の出身階層間の進学格差

上層進学者割合/下層進学者割合

を計算する．

edu<-function(x,n1,n0,m1,m0,sd){
  #x:進学者数    n1:上層人数　　　n0:下層人数
  df1 <- data.frame(score = rnorm(n1, m1, sd),id = rep(1,n1))#df1:上層n1人の成績データ
  df0 <- data.frame(score = rnorm(n0, m0, sd),id = rep(0,n0))#df0:下層n0人の成績データ    
  #score,idは変数名ラベル．結合のため同じ名前を使う
  df <- rbind(df1, df0) #データフレームdfへと，df1とdf0を行結合して格納する
  #同じ列名(score)でないとマッチしないので注意する
  df<-df[order(df$score, decreasing = TRUE), ]  #成績降順で並び替え
  x1=head(df$id, n=x) #上位x人のid抽出
  rr <- (sum(x1)/x)/(1-sum(x1)/x)#相対リスク比.上層進学率/下層進学率  
  return(rr)}

上層進学者と下層進学者の相対リスク比を計算する

edu(x=30, n1=1000,n0=1000,m1=52,m0=50,sd=5)
## [1] 1.5

rr2は進学者数の変化に伴う結果をplotする関数

rr2<-function(n1,n0,m1,m0,sd){
  #n1:上層人数　　　n0:下層人数
  end<-n1+n0
  result<-Inf#結果の格納．最初は下層進学者0人のため，infを入れておく
  for(i in 1:end){
  result<- c(result,edu(i,n1,n0,m1,m0,sd))}#結果をfor文でresultに追加
  #ここで先に定義した関数edu使う．進学者数をiで変化させる
    xop<-0:end #plot用にx軸を定義
  plot(xop,result)
}
rr2(300,300,52,50,5)

Rは計算に時間がかかるので注意

rr2(1000,1000,55,50,5)

インプリケーション

教育機会の拡大と共に進学率のリスク比が1に近づく．

リスク比の分散は，教育機会が小さいほど大きい． （なぜそうなるのか．理由を考えてみよう）

課題

以上に定義したベースモデルを使い，次の問題を考えてみよう．

問題．エージェントの属性が成績だけでなく，親の収入によっても決まる場合， 成績と親収入との相関が高いほど，出身階層間格差が大きくなることを示せ．

ヒント．2次元正規分布を使って，収入と成績の相関を表現してみよう

問題．このシミュレーションを解析的なモデルで表現してみよう．

ヒント.　上層と下層の成績の分布関数をそれぞれ\(F_1(t), F_2(t)\)とおく． 二つの混合分布の上位\(x\)パーセンタイルを\(s\)とおく． \[ \frac{1-F_1(s)}{1-F_2(s)} \] を直接計算してリスク比が\(s\)に関して減少であることを示す．ロジスティック分布（正規分布の代用）を使えば計算が簡単です．

メモ

授業用の資料として使うちょっとした計算なら，\(\TeX\) \(\to\) PDF \(\to\) FTP経由 \(\to\) WEB　みたいな面倒なことせんでも, Markdown \(\to\) WEB で十分ですね．

これなら実質的に起動してるのR Studioだけやし．計算と\(\TeX\) writingがシームレスにつながるのってすごく楽しい．

これがRじゃなくて，Mathematica でできたら，言うことないなー． WolframのMarkdown対応を望みます（CDFって, そういう方向を目指してたと思うんやけど）．

By Hamada