第13章：ノンパラメトリック法

Ch13.R

# --------------------
# p100~: ウィルコクソンの順位和検定
# --------------------

# 成績テーブル
df1 <- data.frame(
  score = c(30,20,52,40,50,35)
  , grp =  rep(c('A','B'),each=3)
)

# 順位和
df1$rnk <- rank(df1$score);df1

# グループごとの個数
N <- tapply(df1$rnk, df1$grp, length);N
N_A <- N['A']

# グループごとの順位和
w <- tapply(df1$rnk, df1$grp, sum);w
w_A <- w['A']

# 6つの中から3つを選ぶ組み合わせ数が20であることを確認
choose(nrow(df1),N_A)

# 6つの中から3つを選ぶ組み合わせの一覧
combn(df1$rnk, N_A)

# 順位和のとりうる値たち
W_A <- colSums(combn(df1$rnk, N_A));W_A


# テーブル関数にて度数分布表を作成
tbl1 <- table(W_A);tbl1

# 個数の合計が20であることを確認
sum(tbl1)

# P(W_A <= 9)を計算すると7/20 = 0.35となることを確認
mean(W_A <= w_A)






# --------------------
# p101~: 例1
# --------------------

# 成績テーブル
df2 <- data.frame(
  score = c(30,20,52,40,50,35,60)
  , grp =  c('A','A','A','B','B','B','B')
)

# 順位和
df2$rnk <- rank(df2$score);df2

# グループごとの個数
N <- tapply(df2$rnk, df2$grp, length);N
N_A <- N['A']

# グループごとの順位和
w <- tapply(df2$rnk, df2$grp, sum);w
w_A <- w['A']

# 7つの中から3つを選ぶ組み合わせ数が35であることを確認
choose(nrow(df2),N_A)

# 7つの中から3つを選ぶ組み合わせの一覧
combn(df2$rnk, N_A)

# 順位和のとりうる値たち
W_A <- colSums(combn(df2$rnk, N_A));W_A


# テーブル関数にて度数分布表を作成
tbl2 <- table(W_A);tbl2

# 個数の合計が35であることを確認
sum(tbl2)

# P(W_A <= 9)を計算すると7/35 = 0.2となることを確認
mean(W_A <= w_A)






# --------------------
# p102~: 並び替え検定
# --------------------

# 成績テーブル
df3 <- data.frame(
  score = c(30,20,52,40,50,35)
  , grp =  rep(c('A','B'),each=3)
)


# グループごとの個数
N <- tapply(df3$score, df3$grp, length);N
N_A <- N['A']

# グループごとの平均
xbar <- tapply(df3$score, df3$grp, mean);xbar
xbar_A <- xbar['A']

# 6つの中から3つを選ぶ組み合わせ数が20であることを確認
choose(nrow(df3),N_A)

# 6つの中から3つを選ぶ組み合わせの一覧
combn(df3$score, N_A)

# 順位和のとりうる値たち
Xbar_A <- colMeans(combn(df3$score, N_A));round(Xbar_A,1)


# テーブル関数にて度数分布表を作成
tbl3 <- table(round(Xbar_A,1));tbl3

# 個数の合計が20であることを確認
sum(tbl3)

# P(Xbar_A <= xbar_A)を計算すると5/20 = 0.25となることを確認
mean(Xbar_A <= xbar_A)


# --------------------
# ウィルコクソンの符号付き順位和
# --------------------

# 点数の差
score_diff <- c(-15,-9,0,6,11,20,25);score_diff

# 絶対値の小さな順で並び替える。ただし値が0のものは除外
## work around:
##   1) score_diffの絶対値をorder関数に通して並び替えたときの添字をえる
##   2) その後、値が0のものは除外する
score_diff2 <- score_diff[ order( abs(score_diff) )]
score_diff2 <- score_diff2[ score_diff2 != 0 ];score_diff2

# この順に符号付きの順位を割り当てる
## work around:
##   1) 絶対値でrankを計算し
##   2) sign関数で符号をelementwiseに掛け算する

score_diff3 <- sign(score_diff2) * rank( abs(score_diff2) );score_diff3

# これらのうち正値の合計を検定統計量とする
T_pos <- sum(score_diff3[ score_diff3 > 0 ]);T_pos

# T_posがとりうる値は、
T_all <- sapply(
  seq_along(score_diff3)
  , function(x){ combn(abs(score_diff3), x) |> colSums() }
) |> unlist();table(T_all)

table(T_all) |> sum()

# P(T_all >= T_pos) = 14/64 ~= 0.22
mean(T_all >= T_pos)