一標本からのサンプルの抽出についての検討

一標本からのサンプルの抽出について検討しました。

今、身長の平均値175cm, 標準偏差が5cmの成人男性の集団(合計1000人)を考えます。
(対象の集団は175±5cm(n=1000)とも表現可)

Rを使って、この集団のデータを擬似的に作成します。

#Rの起動
$ R
#データの取得
> dat <- rnorm(mean=175, n=1000, std=5)

#データの要約を表示

> summary(dat)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.
  160.3   171.5   175.2   175.1   178.4   192.5


###解釈###
最大値が192.5cm, 最小値が160.3cm, 平均値が175.2cm
#このデータは偏りがないはずであるが、偏りがもしもある場合は、中央値と四分位範囲、範囲について議論するのがよいとされる。
第一四分位数が171.5cm, 第三分位数が178.4cm(四分位範囲:171.5-178.4cm)
(中央値(四分位範囲)[範囲]): 175.2(171.5 - 178.4)[160.3 - 192.5] cm

ここで、この集団から無作為に10人抽出して身長を測定することを考えます。
この作業から、母集団の平均値をどの程度推定できるか検討してみます。


#ランダムに50人のサンプル抽出

> sample <- dat[sample(1000,10)]

#標本平均を算出
> mean
[1] 174.9052

#ヒストグラムに母平均値を示す垂線を重ねて描写
png("120730_hist_1.png")
hist(dat, breaks=100)
abline(v=mean(dat), col="green")
dev.off()



#繰り返し標本抽出と標本平均の算出を行う。
> mean(dat[sample(1000,10)])
[1] 175.2295
> mean(dat[sample(1000,10)])
[1] 173.3754
> mean(dat[sample(1000,10)])
[1] 179.5982
> mean(dat[sample(1000,10)])
[1] 177.0066
> mean(dat[sample(1000,10)])
[1] 173.4215

#ヒストグラムの上に標本平均の垂線を重ねて描写(計5回のサンプリング)
png("120730_hist_2.png")
hist(dat, breaks=100)
abline(v=mean(dat), col="green")
abline(v=mean(dat[sample(1000,10)], col="magenda")) 
abline(v=mean(dat[sample(1000,10)], col="magenda")) 
abline(v=mean(dat[sample(1000,10)], col="magenda")) 
abline(v=mean(dat[sample(1000,10)], col="magenda")) 
abline(v=mean(dat[sample(1000,10)], col="magenda")) 
dev.off()



sampleオブジェクト(対象の母集団から50人の標本抽出を行ったもの)の平均値が、175と比べて統計的に有意に異なるかを検定する。(一標本t検定)

> t.test(sample, mu=175, alternative="two.sided")

One Sample t-test

data:  sample 
t = -0.1224, df = 49, p-value = 0.9031
alternative hypothesis: true mean is not equal to 175 
95 percent confidence interval:
 173.3477 176.4626 
sample estimates:
mean of x 
 174.9052 

この結果、p=0.9031<0.05であり、統計的に有意に母集団の平均が175cmと異なるとは言えない。(母平均が175cmであるとは言えないが。)
そして、母平均は173.3477cmから176.4626cmの間に95%の確率で存在する。
(95%信頼区域: 173.3477 - 176.4626 cm)