In [1]:
options(repr.plot.width= 4, repr.plot.height = 4)
5.3 標準正規分布を用いた検定¶
- 検定統計量は $Z = \frac{\bar{X} - \mu}{\sigma / \sqrt{n}}$
例題¶
- 心理学テストの母集団分布は $\bar{X} \approx N \left( \mu, \frac{\sigma^2}{n}\right) $
- 標準化すると， $Z = \frac{\bar{X} - \mu}{\sigma / \sqrt{n}} \approx N(0, 1)$
In [2]:
library(readr)
In [3]:
d <- read_csv("teaching_methods.csv") # UTF-8
d
In [4]:
names(d) <- c("id", "name", "gender", "math", "stat", "psy_test", "stat_test1", "stat_test2", "teach_method")
d
In [5]:
psy_test <- d$psy_test
（4） 統計検定量の計算
In [6]:
z <- (mean(psy_test) - 12) / (sqrt(10 / length(psy_test)))
z
棄却域を計算する
上側確率は，
In [7]:
qnorm(1 - 0.05 / 2)
下側確率は，
In [8]:
qnorm(0.05 / 2)
棄却域は，
$Z \lt -1.95996$, $Z \gt 1.95996$
In [9]:
library(ggplot2)
In [10]:
ggplot(data.frame(x = c(-3, 3)), aes(x)) +
stat_function(fun = dnorm, args = list(mean = 0, sd = 1)) +
scale_x_continuous(breaks = c(-3:3, 1)) +
geom_vline(xintercept = c(qnorm(0.025), qnorm(0.975)))
$p$値を計算する．
検定統計量z が左側の棄却域に入る確率は，
In [11]:
pnorm(z)
両側検定なので，
In [12]:
2 * pnorm(-z, lower.tail = FALSE)
$p$値が有意水準0.05より小さいので，帰無仮説は棄却される.
(標本平均は母平均と等しいとは言えない)
5.4 $t$分布 を用いた検定¶
$t = \frac{\bar{X} - \mu}{\hat{\sigma} / \sqrt{n}}$
In [13]:
ggplot(data.frame(x = c(-5, 5)), aes(x)) +
stat_function(fun = dt, args = list(df = 1)) +
stat_function(fun = dt, args = list(df = 2), col = "green") +
stat_function(fun = dt, args = list(df = 4), col = "red") +
stat_function(fun = dt, args = list(df = 8), col = "blue") +
scale_x_continuous(breaks = c(-4:4, 1))
母集団分布は， $N(12, \sigma^2)$
検定統計量$t$は，
In [14]:
t <- (mean(psy_test) - 12) / sqrt(var(psy_test) / length(psy_test))
t
棄却域は，
In [15]:
lower <- qt(0.05 / 2, df = length(psy_test) - 1)
upper <- qt(0.05 / 2, df = length(psy_test) - 1, lower.tail = FALSE)
cat("t < ", lower, ", t > ", upper)
In [16]:
ggplot(data.frame(x = c(-3, 3)), aes(x)) +
stat_function(fun = dt, args = list(df = 19)) +
scale_x_continuous(breaks = c(-3:3, 1)) +
geom_vline(xintercept = c(qt(0.025, df = 19), qt(0.975, df = 19)))
帰無仮説は棄却された
$p$ 値は，
In [17]:
2 * pt(t, df = length(psy_test) - 1)
t.test() で計算
In [18]:
t.test(psy_test, mu = 12)
5.5 相関係数の検定¶
H0: 母集団において相間が0である（$\rho = 0$）
$t = \frac{r\sqrt{n - 2}}{\sqrt{1 - r^2}}$
In [19]:
stat_test1 <- d$stat_test1
stat_test2 <- d$stat_test2
検定統計量は，
In [20]:
r <- cor(stat_test1, stat_test2)
n <- length(stat_test1)
t <- (r * sqrt(n - 2)) / sqrt(1 - r^2)
t
棄却域は，
In [21]:
lower <- qt(0.05 / 2, df = n-2)
upper <- qt(0.05 / 2, df = n - 2, lower.tail = FALSE)
cat("t < ", lower, ", t > ", upper)
In [22]:
ggplot(data.frame(x = c(-3, 3)), aes(x)) +
stat_function(fun = dt, args = list(df = n - 2)) +
scale_x_continuous(breaks = c(-3:3, 1)) +
geom_vline(xintercept = c(qt(0.025, df = n - 2), qt(0.975, df = n - 2)))
帰無仮説は棄却された
$p$ 値は，
In [23]:
2 * pt(-t, df = n - 2)
cor.test() で計算
In [24]:
cor.test(stat_test1, stat_test2)
5.6 カイ二乗検定¶
In [25]:
math <- d$math
stat <- d$stat
table(math, stat)
検定統計量
$$\chi^2 = \sum_{i = 1}^{k} \frac{(O_i - E_i)^2}{E_i}$$カイ二乗分布
In [26]:
ggplot(data.frame(x = c(0, 20)), aes(x)) +
stat_function(fun = dchisq, args = list(df = 1)) +
stat_function(fun = dchisq, args = list(df = 2), col = "green") +
stat_function(fun = dchisq, args = list(df = 4), col = "red") +
stat_function(fun = dchisq, args = list(df = 8), col = "blue")
観測度数
In [27]:
library(pipeR)
In [28]:
m.o <- table(math, stat)
m.o
In [29]:
m.o %>>% rowSums
In [30]:
m.o %>>% colSums
In [31]:
m.o %>>% sum
期待度数
In [32]:
m.o.c <- colSums(m.o)
m.e <- rbind(m.o.c, m.o.c) * rowSums(m.o) / sum(m.o)
m.e
In [33]:
chi2 <- sum((m.o - m.e)^2 / m.e)
chi2
棄却域は，
In [34]:
n <- 2
qchisq(0.05, df = (n - 1) * (n - 1), lower.tail = FALSE)
In [35]:
ggplot(data.frame(x = c(0, 6)), aes(x)) +
stat_function(fun = dchisq, args = list(df = (n - 1) * (n - 1))) +
scale_x_continuous(breaks = c(0:6, 1)) +
geom_vline(xintercept = c(qchisq(0.95, df = (n - 1) * (n - 1))))
帰無仮説は棄却されなかった．
$p$ 値を計算すると，
In [36]:
pchisq(chi2, df = (n - 1) * (n - 1), lower.tail = FALSE)
chisq.test() で計算すると，
In [37]:
chisq.test(m.o, correct = FALSE)
5.7 サンプルサイズ¶
サンプルサイズが大きくなると，検定結果が有意になりやすい
In [38]:
reg_a <- matrix(c(16, 12, 4, 8), 2, 2)
rownames(reg_a) <- c("文系", "理系")
colnames(reg_a) <- c("履修した", "履修してない")
reg_a
In [39]:
chisq.test(reg_a, correct = FALSE)
In [40]:
reg_b <- reg_a * 10
reg_b
In [41]:
chisq.test(reg_b, correct = FALSE)
練習問題¶
（1）¶
In [42]:
height <- c(165,150,170,168,159,170,167,178,155,159,161,162,166,171,155,160,168,172,155,167)
t.test(height, mu = 170)
帰無仮説が棄却されたので，無作為標本とは言えない
（2）¶
In [43]:
d.study <- data.frame(time = c(1, 3, 10, 12, 6, 3, 8, 4, 1, 5), score = c(20, 40, 100, 80, 50, 50, 70, 50, 10, 60))
d.study
In [44]:
cor.test(d.study$time, d.study$score)
帰無仮説が棄却されたので，無相関ではない
（3）¶
スピアマンの順位相関係数
In [45]:
cor(d.study$time, d.study$score, method = "spearman")
In [46]:
cor.test(d.study$time, d.study$score, method = "spearman")
ケンドールの順位相関係数
In [47]:
cor(d.study$time, d.study$score, method = "kendall")
In [48]:
cor.test(d.study$time, d.study$score, method = "kendall")
（4）¶
In [49]:
library(readxl)
In [50]:
d.food <- read_excel("Chap03_food.xlsx", sheet = 1)
head(d.food)
In [51]:
m.o <- table(d.food)
m.o
In [52]:
chisq.test(m.o, correct = FALSE)
帰無仮説を棄却できない
（5）¶
（5-1）¶
In [53]:
jap <- c(60, 40, 30, 70, 55)
soc <- c(80, 25, 35, 70, 50)
In [54]:
cor.test(jap, soc)
（5-2）¶
In [55]:
jap <- rep(jap, 2)
soc <- rep(soc, 2)
In [56]:
cor.test(jap, soc)
サンプルサイズが2倍になると，相関係数は変わらないが，$p$値が小さくなった
In [57]:
devtools::session_info()