1. t 検定の目的

2. Pairedデータの t 検定
-2.1. Quiz 1

3. Unpairedデータの t 検定
-3.1. Quiz 2

4. 有意水準に関するシミュレーション
-4.1. Quiz 3

5 EXERCISE
-5.1. EXERCISE 1
-5.2. EXERCISE 2

5. References

1. t 検定の目的

1) 標本平均が特定の値かどうか調べる

2) 二つの異なるグループの平均が異なるかどうか調べる

2. Pairedデータの t 検定

拓殖大学 vs. 早稲田大学(Pairedデータ)  

# 最初に乱数の種を明示しておくと、後で同じ結果が得られる
set.seed(12345) 
# 設定した母集団(拓殖大学)から10個のサンプルを抽出
takushoku <- rnorm(10, mean = 85, sd = 4)  

# 設定した母集団(早稲田大学)から10個のサンプルを抽出
waseda  <- rnorm(10, mean = 79, sd = 5)    
# 二種類のサンプルをデータフレームに変換
df1 <- data.frame(takushoku = takushoku, waseda = waseda) 
 # 人工的に作り出したデータの小数点以下を切り捨てる
round(df1, digits = 0)
   takushoku waseda
1         87     78
2         88     88
3         85     81
4         83     82
5         87     75
6         78     83
7         88     75
8         84     77
9         84     85
10        81     80
# データセットのサマリー
summary(df1)
   takushoku         waseda     
 Min.   :77.73   Min.   :74.57  
 1st Qu.:83.36   1st Qu.:77.61  
 Median :84.23   Median :80.67  
 Mean   :84.47   Mean   :80.43  
 3rd Qu.:87.40   3rd Qu.:82.71  
 Max.   :87.84   Max.   :88.09  

それぞれのサンプル調査結果を箱ひげ図を使って Visualize してみよう。
melt( )関数を使って、ggplot上で箱ひげ図を描きやすいデータに加工し、箱ひげ図を表示してみる。

library("reshape2")
## Warning: package 'reshape2' was built under R version 3.4.3
# 加工したデータフレームにdf1_meltと名前をつける
df1_melt <- melt(df1)
df1_melt
    variable    value
1  takushoku 87.34212
2  takushoku 87.83786
3  takushoku 84.56279
4  takushoku 83.18601
5  takushoku 87.42355
6  takushoku 77.72818
7  takushoku 87.52039
8  takushoku 83.89526
9  takushoku 83.86336
10 takushoku 81.32271
11    waseda 78.41876
12    waseda 88.08656
13    waseda 80.85314
14    waseda 81.60108
15    waseda 75.24734
16    waseda 83.08450
17    waseda 74.56821
18    waseda 77.34211
19    waseda 84.60356
20    waseda 80.49362

データを加工した df_melt の中には二つの変数 variable と value が作られたので、これらを使って箱ひげ図を描く。

library("ggplot2")
# 箱ひげ図を表示する
ggplot(df1_melt, aes(x = variable, y = value)) + geom_boxplot() + 
  labs(x = "university", y = "evaluation score")

t 検定の手順

  • 帰無仮説: \(\mathrm{H_0}\):「拓殖大学と早稲田大学への評価に違いはない(=違いは 0)」
  • 対抗仮説: \(\mathrm{H_1}\):「拓殖大学と早稲田大学への評価に違いはある」
  • t 値を計算する
  • 帰無仮説を棄却する臨界値を特定する
  • t 値が棄却域内かどうかを確かめる
  • 結論
  • Pairedデータの t 値の計算式

    \[T = \frac{\bar{d} - d_0}{u_x / \sqrt{n}}\]

    ただし、

    \[ {\bar{d}} = \frac{\sum (x_i - y_i)}{n}\]

    この式を使って、R で t 値を計算すると次のようになる。

    # dfというデータフレーム内の変数 takushoku を x、waseda を y と名付ける
    x <- df1$takushoku
    y <- df1$waseda
    # 拓殖大学への評価と早稲田大学への評価の差をとり、d と名付ける
    d <- x - y
    # 上記の公式に従って t 値を求める
    t <- (mean(d) - 0) / (sd(d) / sqrt(10))
    # 求めた t 値を表示する
    t
    [1] 2.135757

    ここで得られた 2.14 という t 値を使って「拓殖大学と早稲田大学のどちらの方が評価が高いのか?」ということを標本サイズ 10 のサンプルを使って、母集団では「どちらの大学への評価も同じ」であるという仮説が妥当かどうかを推定する。

    t 分布表は次のとおり。

    これを図示すると次のようになる。
    自由度 9 の t 分布における 5% 有意水準(α = 0.05)の 2 つの棄却限界値 (critical value) -2.26 と 2.26 を示している。

    # R を使って Paired データの t 検定を行うコマンドは次のとおりである。
    t.test(df1$takushoku, df1$waseda, paired = TRUE)
    
        Paired t-test
    
    data:  df1$takushoku and df1$waseda
    t = 2.1358, df = 9, p-value = 0.06144
    alternative hypothesis: true difference in means is not equal to 0
    95 percent confidence interval:
     -0.2390006  8.3156698
    sample estimates:
    mean of the differences 
                   4.038335 

    母集団の平均点は85点(拓殖大学)と79点(早稲田大学)と設定したが、こここで抽出した 10 個のサンプルでは、それぞれ 84.47(拓殖大学)と 80.43(早稲田大学)とそれぞれサンプル平均が異なることに注意。

    2.1. Quiz 1

    ・拓殖大学と早稲田大学に関する評価の世論調査。
    ・R で母集団を人工的に生成
    ・母集団では拓殖大学と早稲田大学への評価はそれぞれ次のとおり:
    ・平均点:拓殖大学 85 点、早稲田大学 79 点
    ・標準偏差:拓殖大学 4、早稲田大学 5
    ・→拓殖大学の評価より早稲田大学の評価のばらつきが若干大きい
    ・「拓殖大学と早稲田大学を 0 点から 100 点で評価して下さい」という世論調査結果を人工的に生成
    ・標本サイズ:20 人
    ・20 人それぞれが拓殖大学と早稲田大学の両方を評価して点数をつける

    set.seed(54321) # 最初に乱数の種を明示しておくと、後で同じ結果が得られる

    Q2-1:
    それぞれのサンプル調査結果を箱ひげ図を使って Visualize しなさい。

    Q2-2:
    サンプルから判断して、母集団では早稲田大学と拓殖大学のどちらが高く評価されているか t 検定しなさい。

    3. Unpairedデータの t 検定

    拓殖大学 vs. 早稲田大学(Unpairedデータ)

    * Unpaired データでは、大学を評価した人々は 20 人いる(Paired データでは大学を評価した人は 10 人)

    # 最初に乱数の種を明示しておくと、後で同じ結果が得られる
    set.seed(12345) 
    #設定した母集団(拓殖大学)から10個のサンプルを抽出
    takushoku <- rnorm(10, mean = 85, sd = 4)   
    
    #設定した母集団(早稲田大学)から10個のサンプルを抽出
    waseda  <- rnorm(10, mean = 79, sd = 5)     
    # 二種類のサンプルをデータフレームに変換
    df2 <- data.frame(takushoku = takushoku, waseda = waseda) 
     # 人工的に作り出したデータの小数点以下を切り捨てる
    round(df2, digits = 0)
       takushoku waseda
    1         87     78
    2         88     88
    3         85     81
    4         83     82
    5         87     75
    6         78     83
    7         88     75
    8         84     77
    9         84     85
    10        81     80
    # データセットのサマリー
    summary(df2)
       takushoku         waseda     
     Min.   :77.73   Min.   :74.57  
     1st Qu.:83.36   1st Qu.:77.61  
     Median :84.23   Median :80.67  
     Mean   :84.47   Mean   :80.43  
     3rd Qu.:87.40   3rd Qu.:82.71  
     Max.   :87.84   Max.   :88.09  

    それぞれのサンプル調査結果を箱ひげ図を使って Visualize してみよう。
    melt( )関数を使って、ggplot上で箱ひげ図を描きやすいデータに加工し、箱ひげ図を表示してみる。

    library("reshape2")
    # 加工したデータフレームにdf2_meltと名前をつける
    df2_melt <- melt(df2)
    df2_melt
        variable    value
    1  takushoku 87.34212
    2  takushoku 87.83786
    3  takushoku 84.56279
    4  takushoku 83.18601
    5  takushoku 87.42355
    6  takushoku 77.72818
    7  takushoku 87.52039
    8  takushoku 83.89526
    9  takushoku 83.86336
    10 takushoku 81.32271
    11    waseda 78.41876
    12    waseda 88.08656
    13    waseda 80.85314
    14    waseda 81.60108
    15    waseda 75.24734
    16    waseda 83.08450
    17    waseda 74.56821
    18    waseda 77.34211
    19    waseda 84.60356
    20    waseda 80.49362

    データを加工した df2_melt の中には二つの変数 variable と value が作られたので、これらを使って箱ひげ図を描く。

    library("ggplot2")
    # 箱ひげ図を表示する
    ggplot(df2_melt, aes(x = variable, y = value)) + geom_boxplot() + 
      labs(x = "university", y = "evaluation score")

    # R を使って Unpaired データの t 検定を行うコマンドは次のとおりである。
    t.test(df2$takushoku, df2$waseda) # R での t 検定は Unpaired がデフォルト
    
        Welch Two Sample t-test
    
    data:  df2$takushoku and df2$waseda
    t = 2.4002, df = 16.928, p-value = 0.02817
    alternative hypothesis: true difference in means is not equal to 0
    95 percent confidence interval:
     0.4873964 7.5892728
    sample estimates:
    mean of x mean of y 
     84.46822  80.42989 

    3.1. Quiz 2

    ・拓殖大学と早稲田大学に関する評価の世論調査。
    ・R で母集団を人工的に生成
    ・母集団では拓殖大学と早稲田大学への評価はそれぞれ次のとおり:
    ・平均点:拓殖大学 85 点、早稲田大学 79 点
    ・標準偏差:拓殖大学 4、早稲田大学 5
    ・→拓殖大学の評価より早稲田大学の評価のばらつきが若干大きい
    ・「拓殖大学と早稲田大学を 0 点から 100 点で評価して下さい」という世論調査結果を人工的に生成
    ・標本サイズ:10 人
    ・5 人が拓殖大学だけを評価し、残りの 5 人が早稲田大学だけを評価して点数をつける

    set.seed(54321) # 最初に乱数の種を明示しておくと、後で同じ結果が得られる

    Q2-1:
    それぞれのサンプル調査結果を箱ひげ図を使って Visualize しなさい。

    Q2-2:
    サンプルから判断して、母集団では早稲田大学と拓殖大学のどちらが高く評価されているか t 検定しなさい。

    4. 有意水準に関するシミュレーション

    sig_sim <- function(alpha = .05, n = 50, trials = 100) {
        ## Arguments:
        ##     alpha = significance level(有意水準)、defaultで 5% (α = 0.05)に設定
        ##     n = 標本サイズ、defaultで 50 に設定
        ##     trials = シミュレーションの試行数, defaultで 100 に設定
        ## Return:
        ##     帰無仮説を棄却する割合 (rejection rate) を表示させる
        ##   t 分布もヒストグラムとして表示させる
        
        ## vector to save the result
        res <- rep(NA, trials)
        T_vec <- rep(NA, trials)
        
        ## critical value
        cv <- abs(qt(alpha / 2, df = n -1))
        
        for (i in 1:trials) {
            x <- rnorm(50, mean = 50, sd = 5) # 標本 x は母平均 50、母標準偏差 5 から 50 個無作為抽出
            y <- rnorm(50, mean = 50, sd = 5) # 標本 y は母平均 50、母標準偏差 5 から 50 個無作為抽出
            d <- x - y                        # x と y の差を d とする
            T <- (mean(d) - 0) / (sd(d) / sqrt(n)) # サンプルから得られる t 値を計算
            T_vec[i] <- T
            res[i] <- abs(T) > cv    # t 値の絶対値が cv(棄却限界値)を超える場合を選択
        }
        hist(T_vec, freq = FALSE, col = "gray", # 計算された t 値をヒストグラムとして表示
             xlab = "test statistic",
             main = "Distribution of the test statistic")
        abline(v = c(-cv, cv), col = "red&quo