1.0.1 群間変動.

SSB=c()
for (i in 1:10){
  ssb <- 40*(mean(d[[i]])-mean(d2))^2
  SSB <-c(SSB,ssb)
}
#群間分散
sum(SSB)/400

## [1] 74.88577

1.0.2 群内変動.

SSW=c()
for (i in 1:10){
  ssw <- sum((d[[i]]-mean(d[[i]]))^2)
  SSW <-c(SSW,ssw)
}
#群内分散
sum(SSW)/400

## [1] 91.92727

1.0.3 全変動.

SST <- sum(SSB)+sum(SSW)
#母分散
SST/400

## [1] 166.813

#40個の標本を抽出したときの標本分散
SST/400/40

## [1] 4.170326

2.1 推定値の分布.

400人から40人を抽出した標本平均の分布.

par(family = "HiraKakuProN-W3") 
hist(m1,xlim=c(35,65),xlab="平均",ylab="回数",main="単純無作為抽出")
#母数
abline (v=mean (d2))

mean (m1)

## [1] 50.35486

var (m1)

## [1] 4.193911

var(d2)*399/400/40#標本の平均の分散の理論値

## [1] 4.170326

3.1 理論値.

Vts <-sum(SSW)/400/40+sum(SSB)/400/4
Vts

## [1] 21.01963

多段抽出では分散が大きくなる.

4.1 理論値.

sum(SSW)/400/40

## [1] 2.298182

群内変動から求めた分散に一致する。

5.1 標本分散.

・層別抽出では、群内分散を標本数で割ったものになる。（小）.
　　　$\displaystyle \dfrac{1}{n}\sum_{s=1}^M W_s\sigma_s^2$.
・無作為抽出では、郡内分散と群間分散を標本数で割ったものになる。（中）.
　　　$\displaystyle \dfrac{1}{n}\sum_{s=1}^M W_s\sigma_s^2+\dfrac{1}{n} \sum_{s=1}^MW_s(\mu_s-\mu)^2$　

・２段抽出では、群間分散は標本数で割らない（大）.
　　　$\displaystyle \dfrac{1}{n}\sum_{s=1}^M W_s\sigma_s^2+ \sum_{s=1}^MW_s(\mu_s-\mu)^2$　

5.2 具体例.

par (mfrow=c (3,1), oma=c(0,0,0,0))#omaは余白調整
par(family = "HiraKakuProN-W3") 
hist(m1,xlim=c(35,65),xlab="平均",ylab="回数",main="単純無作為抽出")
abline(v=mean (d2))

hist(m2,xlim=c(35,65),xlab="平均",ylab="回数",main="多段抽出")
abline(v=mean (d2))

hist(m3,xlim=c(35,65),xlab="平均",ylab="回数",main="層化抽出")
abline(v=mean (d2))

多段抽出＞単純無作為抽出＞層化抽出.

5.3 層化抽出の優位性.

m4 <- numeric (10000)
#復元抽出
for(i in 1:10000){
m4[i]<-mean (sample (x=d2 ,size=40*1.8, replace=T)) 
}
var(m1)#単純無作為抽出

## [1] 4.193911

var(m4)#標本1.8倍の単純無作為抽出

## [1] 2.340814

var(m3)#層化抽出

## [1] 2.280152

分散を1/1.8にするには標本サイズnが1.8倍必要.
層化抽出が標本サイズを約半分に節約している

5.4 層化抽出が有効である条件.

①母集団における各層(グループ）の割合がわかっている.
　例:ある学年における各クラスの人数.
②標本抽出枠(名簿)に層のデータが含まれる.
　例：学年名簿に所属クラスが記されている.
③層ごとに母数が異なる.
　例:クラスごとにテストの平均得点が異なる.

①または②が満たされないとき、次善の策として単純無作為抽出がとられる。
③が満たされないとき、層化抽出の精度は単純無作為抽出と同じ.

5.5 標本抽出法を比べる.

5.6 層化抽出が優位である理由.

単純無作為抽出の場合
　① 標本平均の分散=母分散／標本サイズ.
　② 母分散=母集団の偏差平方和／母集団のサイズ.
　③ 母集団の偏差平方和=郡内平方和＋群間平方和（＃平方和分解）.

①に②③を代入すると
　④ 標本平均の分散＝(郡内平方和＋群間平方和）/母集団のサイズ/標本サイズ.

層化抽出の場合.
　⑤ 標本平均の分散＝Σ(i組の分散✕i組のサイズ)／母集団のサイズ／標本サイズ.
　⑥ 郡内平方和=Σ（i組の分散×i組のサイズ）.
⑤に⑥を代入すると.
　⑦ 標本平均の分散=群内平方和／母集団のサイズ／標本サイズ.

単純無作為抽出と層化抽出の差.
標本平均の分散の差=④ー⑦=群間平方和／母集団のサイズ／標本サイズ.

層ごとに平均（母数)が異なるほど、層化抽出の効果が大きい.

5.7 層化抽出優位の具体例.

#平方和を求める関数
sv <- function(x){
  return(var(x)*(length(x)-1))
}

#群間平方和
#定義した関数を利用
#群間変動
gk <- sv(c(
mean(d[[1]]),mean(d[[2]]),mean(d[[3]]),mean(d[[4]]),mean(d[[5]]),
mean(d[[6]]),mean(d[[7]]),mean(d[[8]]),mean(d[[9]]),mean(d[[10]])))*40
gk

## [1] 29954.31

#郡内平方和
gn <- sum(c(
sv(d[[1]]),sv(d[[2]]),sv(d[[3]]),sv(d[[4]]),sv(d[[5]]),
sv(d[[6]]),sv(d[[7]]),sv(d[[8]]),sv(d[[9]]),sv(d[[10]])))
gn

## [1] 36770.91

sv(d2)

## [1] 66725.22

SST=SSB+SSW が成立している。
400で割れば母分散 $\sigma^2$ 、さらに40で割れば標本の分散となる。
次のvar(m1)で確かめられる。

#単純無作為抽出の標本平均の分散
var(m1)

## [1] 4.193911

#（郡内平方和＋群間平方和）/母集団のサイズ/標本サイズ
(gn+gk)/400/40

## [1] 4.170326

#層化抽出の標本平均の分散
var(m3)

## [1] 2.280152

#郡内平方和/母集団のサイズ/標本サイズ
gn/400/40

## [1] 2.298182

#単純無作為抽出と層化抽出の分散の差
var(m1)-var(m3)

## [1] 1.913759

#群内平方和/母集団のサイズ/標
gk/400/40

## [1] 1.872144

5.8 まとめ.

1.単純無作為抽出が常に最善ではない.
　既知の情報を意図的に揃えれば、小さいデータで精度のよい推定が可能.
2.普通の検定、推定は単純無作為抽出された標本の話.
　多段抽出、層化抽出された標本の場合の計算は複雑（誤差の独立性）.
3.Rで簡単にシミュレーションができる 　数式にもとづく理論値の正しさを確認できる.

6.1 層化抽出.

各層から非復元抽出を行う.
各群からのサンプル数の決め方は、

• 等配分法
• 比例配分法（各層の大きさに比例）
• ネイマン配分法（各層の大きさと分散の大きさに比例）

がある。

n1=2
n2=2
n3=2
n4=2
m1<-numeric(10000)
for (i in 1:10000) {
  S1 <- sample(x=d[[1]], replace=F,size=n1)
  S2 <- sample(x=d[[2]], replace=F,size=n2)               
  S3 <- sample(x=d[[3]], replace=F,size=n3)
  S4 <- sample(x=d[[4]], replace=F,size=n4)
  Yhat <- 20*mean(S1)+10*mean(S2)+5*mean(S3)+5*mean(S4)
  m1[i]<-Yhat
}
hist(m1/40)

mean(m1/40)

## [1] 237.2678

var(m1/40)

## [1] 1663.511

sd(m1/40)

## [1] 40.78616

n1=4
n2=2
n3=1
n4=1
m2<-numeric(10000)
for (i in 1:10000) {
  S1 <- sample(x=d[[1]], replace=F,size=n1)
  S2 <- sample(x=d[[2]], replace=F,size=n2)               
  S3 <- sample(x=d[[3]], replace=F,size=n3)
  S4 <- sample(x=d[[4]], replace=F,size=n4)
  Yhat <- 20*mean(S1)+10*mean(S2)+5*mean(S3)+5*mean(S4)
  m2[i]<-Yhat
}
hist(m2/40)

mean(m2/40)

## [1] 237.0307

var(m2/40)

## [1] 4094

sd(m2/40)

## [1] 63.98437

n1=1
n2=2
n3=4
n4=1
m3<-numeric(10000)
for (i in 1:10000) {
  S1 <- sample(x=d[[1]], replace=F,size=n1)
  S2 <- sample(x=d[[2]], replace=F,size=n2)               
  S3 <- sample(x=d[[3]], replace=F,size=n3)
  S4 <- sample(x=d[[4]], replace=F,size=n4)
  Yhat <- 20*mean(S1)+10*mean(S2)+5*mean(S3)+5*mean(S4)
  m3[i]<-Yhat
}
hist(m3/40)

mean(m3/40)

## [1] 237.4658

var(m3/40)

## [1] 613.7483

sd(m3/40)

## [1] 24.77394

n1=1
n2=2
n3=4
n4=1
m3<-numeric(10000)
for (i in 1:10000) {
  S1 <- sample(x=d[[1]], replace=T,size=n1)
  S2 <- sample(x=d[[2]], replace=T,size=n2)               
  S3 <- sample(x=d[[3]], replace=T,size=n3)
  S4 <- sample(x=d[[4]], replace=T,size=n4)
  Yhat <- 20*mean(S1)+10*mean(S2)+5*mean(S3)+5*mean(S4)
  m3[i]<-Yhat
}
hist(m3/40)

mean(m3/40)

## [1] 236.8604

var(m3/40)

## [1] 1331.308

sd(m3/40)

## [1] 36.4871