裏 RjpWiki

Julia ときどき R, Python によるコンピュータプログラム,コンピュータ・サイエンス,統計学

Julia に翻訳--128 ボンフェローニ, ホルム,シェイファー,ホランド・コペンハーバー,平均値の多重比較

2021年03月26日 | ブログラミング

#==========
Julia の修行をするときに,いろいろなプログラムを書き換えるのは有効な方法だ。
以下のプログラムを Julia に翻訳してみる。

ボンフェローニの方法による平均値の多重比較
ホルムの方法による平均値の多重比較
シェイファーの方法による平均値の多重比較
ホランド・コペンハーバーの方法による平均値の多重比較
http://aoki2.si.gunma-u.ac.jp/R/Bonferroni.html

ファイル名: bonferroni.jl  関数名: bonferroni

翻訳するときに書いたメモ

==========#

using Statistics, Rmath, Combinatorics, Printf

function bonferroni(data, group; alpha = 0.05, method = "Bonferroni") # "Holm", "Shaffer", "Holland-Copenhaver"
    index, n = table(group)
    a = length(n)
    k = binomial(a, 2)
    m = [mean(data[group .== g]) for g in index]
    v = [var(data[group .== g]) for g in index]
    phi = length(data) - a
    V = sum((n .- 1) .* v) / phi
    pair = combinations(1:a, 2)
    t  = [abs(m[i] - m[j]) / sqrt(V / n[i] + V / n[j]) for (i, j) in pair]
    P = pt.(t, phi, false) .* 2
    pairs  = [i for i in pair]
    result2 = hcat(pairs, t, P);
    if method == "Bonferroni"
        Pthreshold = repeat([alpha / k], k)
        judge = (P .<= Pthreshold) .+ 0
    else
        result2 = result2[sortperm(result2[:, 3]), :]
        if method != "Holm" && a > 9
            error("Too many groups Use Holm")
            method = "Holm"
        end
        if method == "Holm"
            Pthreshold = alpha ./ (k:-1:1)
        else
            tbl = vcat([3, 1, 1, 6, repeat([3], 3), 2, 1, 10, repeat([6], 4),
                        4, 4:-1:1, 15, repeat([10], 5), repeat([7], 3),
                        6, 4, 4:-1:1, 21, repeat([15], 6), repeat([11], 4),
                        10, 9, 7, 7:-1:1, 28, repeat([21], 7), repeat([16], 5),
                        15, 13, 13:-1:1, 36, repeat([28], 8), repeat([22], 6),
                        21, repeat([18], 3), 16, 16, 15, 13, 13:-1:1]...)
            h = tbl[(a * (a - 1) * (a - 2) ÷ 6):((a ^ 3 - a) ÷ 6 - 1)]
            Pthreshold = method == "Shaffer" ? alpha ./ h : 1 .- (1 - alpha) .^ (1 ./ h)
        end
        judge = (cumprod(result2[:, 3] .<= Pthreshold) .!= 0) .+ 0
        if method == "Holm" || method == "Shaffer" || method == "Holland-Copenhaver"
            minpos = argmin(judge)
            if judge[minpos] == 0
                judge[minpos:k] .= 2
            end
        end
    end
    judge2 = [["not significant", "significant", "suspended"][j+1] for j in judge]
    result2 = hcat(result2, Pthreshold, judge2)
    @printf(" pair  %7s  %12s  %12s  %7s\n", "t value", "p value", "p threshold", "judge")
    for i = 1:k
         @printf("%2d:%2d  %7.5f  %12.7g  %12.7g  %7s\n",
                 result2[i, 1][1], result2[i, 1][2], result2[i, 2],
                 result2[i, 3], Pthreshold[i], judge2[i])
    end
    Dict(:alpha => alpha, :noftests => k, :result2 => result2)
end

function table(x) # indices が少ないとき
    indices = sort(unique(x))
    counts = zeros(Int, length(indices))
    for i in indexin(x, indices)
        counts[i] += 1
    end
    return indices, counts
end

data = [
  10.7, 9.7, 8.5, 9.4, 8.8, 8.4, 10.6,
  8.1, 8.3, 8.7, 6.9, 5.7, 9.5, 6.7,
  7.9, 7.5, 7.4, 9.2, 5.7, 8.3, 9.7,
  6.2, 7.1, 5.5, 4.7, 6.3, 6.9, 7.5
]
group = vcat([repeat([i], 7) for i = 1:4]...)

bonferroni(data, group) # method = "Bonferroni"
# pair  t value       p value   p threshold    judge
# 1: 2  2.83517   0.009148816   0.008333333  not significant
# 1: 3  2.41686    0.02362029   0.008333333  not significant
# 1: 4  5.08935  3.315126e-05   0.008333333  significant
# 2: 3  0.41830     0.6794449   0.008333333  not significant
# 2: 4  2.25419    0.03358738   0.008333333  not significant
# 3: 4  2.67249    0.01331927   0.008333333  not significant

bonferroni(data, group, method = "Holm")
# pair  t value       p value   p threshold    judge
# 1: 4  5.08935  3.315126e-05   0.008333333  significant
# 1: 2  2.83517   0.009148816          0.01  significant
# 3: 4  2.67249    0.01331927        0.0125  suspended
# 1: 3  2.41686    0.02362029    0.01666667  suspended
# 2: 4  2.25419    0.03358738         0.025  suspended
# 2: 3  0.41830     0.6794449          0.05  suspended

bonferroni(data, group, method = "Shaffer")
# pair  t value       p value   p threshold    judge
# 1: 4  5.08935  3.315126e-05   0.008333333  significant
# 1: 2  2.83517   0.009148816    0.01666667  significant
# 3: 4  2.67249    0.01331927    0.01666667  significant
# 1: 3  2.41686    0.02362029    0.01666667  suspended
# 2: 4  2.25419    0.03358738         0.025  suspended
# 2: 3  0.41830     0.6794449          0.05  suspended

bonferroni(data, group, method = "Holland-Copenhaver")
# pair  t value       p value   p threshold    judge
# 1: 4  5.08935  3.315126e-05   0.008512445  significant
# 1: 2  2.83517   0.009148816    0.01695243  significant
# 3: 4  2.67249    0.01331927    0.01695243  significant
# 1: 3  2.41686    0.02362029    0.01695243  suspended
# 2: 4  2.25419    0.03358738    0.02532057  suspended
# 2: 3  0.41830     0.6794449          0.05  suspended

コメント
  • X
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする

Julia に翻訳--127 シェッフェ法,平均値の線形比較

2021年03月26日 | ブログラミング

#==========
Julia の修行をするときに,いろいろなプログラムを書き換えるのは有効な方法だ。
以下のプログラムを Julia に翻訳してみる。

シェッフェの方法による平均値の線形比較
http://aoki2.si.gunma-u.ac.jp/R/scheffe.html

ファイル名: scheffe.jl  関数名: scheffe

翻訳するときに書いたメモ

かなりスイスイ書けるようになってきた。

==========#

using Rmath

function scheffe(n, m, u, g1, g2; conflevel = 0.95)
    all(length(n) == length(m) == length(u) &&
        all(n .> 1) &&
        all(u .> 0) &&
        all(floor.(n) .== n) &&
        all(floor.(g1) .== g1) &&
        all(floor.(g2) .== g2)) || error("parameter error")
    ng = length(n)
    k1 = ng - 1
    nc = sum(n)
    dfw = nc - ng
    Vw = sum(u .* (n .- 1)) / dfw
    n1 = length(g1)
    n2 = length(g2)
    g0 = collect(1:ng)
    g0 = [i for i in g0 if !(i in g1)]
    g0 = [i for i in g0 if !(i in g2)]
    n0 = ng - n1 - n2
    weight = vcat([repeat([i], j)
                   for (i, j) in zip([1 / n1, - 1 / n2, 0], [n1, n2, n0])]...)
    weight = weight[sortperm(vcat([g1, g2, g0]...))]
    theta = sum(weight .* m)
    Vtheta = Vw * sum(weight .^ 2 ./ n)
    confint = theta .- [1, - 1] *
        sqrt(k1 * qf(1 - conflevel, k1, dfw, false) * Vtheta)
    F0 = theta ^ 2 / k1 / Vtheta
    p = pf(F0, k1, dfw, false)
    println("theta = $theta,  V(theta) = $Vtheta")
    println("F = $F0,  df1 = $k1,  df2 = $dfw,  p value = $p")
    println("$(100conflevel) percent confidence interval = $confint")
    Dict(:theta => theta, :Vtheta => Vtheta, :F => F0,
        :df1 => k1, :df2 => dfw, :pvalue => p, :confint => confint)
end

n = [8, 11, 22, 6];
m = [135.83, 160.49, 178.35, 188.06];
sd = [19.59, 12.28, 15.01, 9.81];

scheffe(n, m, sd .^ 2, 1:2, 3:4)
# theta = -35.04499999999997,  V(theta) = 23.40938365266032
# F = 17.488030202230846,  df1 = 3,  df2 = 43,  p value = 1.435044718014149e-7
# 95.0 percent confidence interval = [-49.1218509474347, -20.968149052565245]

scheffe(n, m, sd .^ 2, 1:3, 4)
# theta = -29.836666666666673,  V(theta) = 42.81362201961475
# F = 6.9310236305159085,  df1 = 3,  df2 = 43,  p value = 0.000658278780876043
# 95.0 percent confidence interval = [-48.87379807609931, -10.799535257234034]

コメント
  • X
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする

Julia に翻訳--126 テューキー法,平均値の線形比較

2021年03月26日 | ブログラミング

#==========
Julia の修行をするときに,いろいろなプログラムを書き換えるのは有効な方法だ。
以下のプログラムを Julia に翻訳してみる。

テューキーの方法による平均値の線形比較
http://aoki2.si.gunma-u.ac.jp/R/tukey2.html

ファイル名: tlc.jl  関数名: tlc

翻訳するときに書いたメモ

Rmath の ptukey(),qtukey() にバグがある
lower_tail = false を指定すると NaN を返す。
回避策としては,
ptukey(q, nmeans, df, false)

1 - ptukey(q, nmeans, df)
とする。

qtukey(p, nmeans, df, false)

qtukey(1-p, nmeans, df)
とする。

==========#

using Rmath

function tlc(n, m, u, g1, g2; conflevel = 0.95)
    all(length(n) == length(m) == length(u) &&
            all(n .> 1) &&
            all(u .> 0) &&
            all(floor.(n) .== n) &&
            all(n .== n[1]) &&
            all(floor.(g1) .== g1) &&
            all(floor.(g2) .== g2)) || error("parameter error")
    ng = length(n)
    nc = sum(n)
    dfw = nc - ng
    Vw = sum(u .* (n .- 1)) / dfw
    n1 = length(g1)
    n2 = length(g2)
    g0 = collect(1:ng)
    g0 = [i for i in g0 if !(i in g1)]
    g0 = [i for i in g0 if !(i in g2)]
    n0 = ng - n1 - n2
    weight = vcat([repeat([i], j)
                   for (i, j) in zip([1 / n1, - 1 / n2, 0], [n1, n2, n0])]...)
    weight = weight[sortperm(vcat([g1, g2, g0]...))]
    theta = sum(weight .* m)
    sq = sqrt(Vw / n[1])
    q = qtukey(conflevel, ng, dfw)
    p = 1 - ptukey(abs(theta / sq), ng, dfw)
    confint = theta .- [1, - 1] * q * sq
    println("theta = $theta, a = $ng, df = $dfw, pvalue = $p")
    println("$(100conflevel) percent confidence interval: $confint")
    Dict(:theta => theta, :a => ng, :df => dfw,
         :pvalue => p, :confint => confint)
end

n = repeat([20], 5)
m = [35.6, 32.7, 29.4, 27.9, 25.7]
u = [5.6, 4.6, 4.9, 3.7, 2.5]

tlc(n, m, u, 1:3, 4:5)
# theta = 5.766666666666664, a = 5, df = dfw, pvalue = 4.640164918967571e-10
# 95.0 percent confidence interval: [3.951633188914924, 7.581700144418404]

tlc(n, m, u, 1:2, 4:5)
# theta = 7.350000000000007, a = 5, df = dfw, pvalue = 4.6348025417586314e-10
# 95.0 percent confidence interval: [5.534966522248267, 9.165033477751747]

コメント
  • X
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする

Julia に翻訳--125 ウィリアムズ法,平均値の多重比較

2021年03月26日 | ブログラミング

#==========
Julia の修行をするときに,いろいろなプログラムを書き換えるのは有効な方法だ。
以下のプログラムを Julia に翻訳してみる。

ウィリアムズの方法による平均値の多重比較
http://aoki2.si.gunma-u.ac.jp/R/Williams.html

ファイル名: williams.jl  関数名: williams

翻訳するときに書いたメモ

p 値は求めない

==========#

using Statistics, Rmath

function williams(data, group; method = "up") # or method = "down"
    func = method == "down" ? minimum : maximum
    index, ni = table(group)
    sumi = [sum(data[group .== g]) for g in index]
    meani = [mean(data[group .== g]) for g in index]
    vi = [var(data[group .== g]) for g in index]
    a = length(ni)
    phie = sum(ni) - a
    ve = sum((ni .- 1) .* vi) / phie
    t = [(func(cumsum(reverse(sumi[2:p])) ./
          cumsum(reverse(ni[2:p]))) .- meani[1]) /
          sqrt(ve * (1 / ni[1] + 1 / ni[p])) for p = a:-1:2]
    println("phi.e = $phie")
    println("t = $t")
    Dict(:phie => phie, :t => method == "down" ? -t : t)
end

function table(x) # indices が少ないとき
    indices = sort(unique(x))
    counts = zeros(Int, length(indices))
    for i in indexin(x, indices)
        counts[i] += 1
    end
    return indices, counts
end

data = [
    415, 380, 391, 413, 372, 359, 401,
    387, 378, 359, 391, 362, 351, 348,
    357, 379, 401, 412, 392, 356, 366,
    361, 351, 378, 332, 318, 344, 315,
    299, 308, 323, 351, 311, 285, 297
];
group = [repeat([i], 7) for i = 1:5]
group = vcat(group...)

williams(data, group, method = "down")
# phi.e = 30
# t = [-7.076037814702816, -4.217674245029326, -1.4164779467493078, -1.9690949035528496]

コメント
  • X
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする

Julia に翻訳--124 ダネット法,平均値の多重比較

2021年03月26日 | ブログラミング

#==========
Julia の修行をするときに,いろいろなプログラムを書き換えるのは有効な方法だ。
以下のプログラムを Julia に翻訳してみる。

ダネットの方法による平均値の多重比較
http://aoki2.si.gunma-u.ac.jp/R/dunnett.html

ファイル名: dunnett.jl  関数名: dunnett

翻訳するときに書いたメモ

mvtnorm の pmvt 関数は Julia にはないので,RCall で R を呼び出して計算させる。

==========#

using Statistics, Rmath, RCall, Printf

function dunnett(data, group)
    index, ni = table(group)
    a = length(ni)
    n = length(data)
    mi = [mean(data[group .== g]) for g in index]
    vi = [var(data[group .== g]) for g in index]
    Vw = sum(vi .* (ni .- 1)) / (n .- a)
    rho = getrho(ni)
    t = (abs.(mi .- mi[1]) ./ sqrt.(Vw .* (1 ./ ni .+ 1 / ni[1])))[2:a]
    p = pdunnett.(t, a, n - a, rho)
    p = vcat([float.(p[i]) for i = 1:a-1]...)
    @printf(" pair  %7s  %12s\n", "t value", "p value")
    for i = 1:a-1
        @printf("%2d:%2d  %7.5f  %12.7g\n", 1, i+1, t[i], p[i])
    end
    Dict(:t => t, :pvalue =>p)
end

func(x, y, ni1) = sqrt(x / (x + ni1) * y / (y + ni1))

function getrho(ni)
    k = length(ni)
    rho = func.(ni, transpose(ni), ni[1])
    [rho[i, i] = 0 for i =1:k]
    sum(rho[2:k, 2:k]) / (k - 2) / (k - 1)
end

function pdunnett(x, a, df, r)
    R"""
    library(mvtnorm)
    corr = diag($a - 1)
    corr[lower.tri(corr)] = $r
    1 - pmvt(lower = -$x, upper = $x, delta = numeric($a - 1), df = $df,
             corr = corr, abseps = 0.0001)[1]
    """
end

function table(x) # indices が少ないとき
    indices = sort(unique(x))
    counts = zeros(Int, length(indices))
    for i in indexin(x, indices)
        counts[i] += 1
    end
    return indices, counts
end

data = [
  14, 15, 14, 16, 15, 17, 17,
  17, 16, 17, 16, 15, 18, 19, 15,
  18, 19, 20, 19, 17, 17,
  20, 21, 19, 20, 19, 22, 20,
  19, 20, 19, 17, 17, 17, 18 ]

group = [repeat([i], count) for (i, count) in enumerate([7, 8, 6, 7, 7])]
group = vcat(group...)

dunnett(data, group)

# pair  t value       p value
# 1: 2  1.85409     0.2156511
# 1: 3  4.18754  0.0008677534
# 1: 4  7.07368  1.02906e-07
# 1: 5  4.07273   0.001131645

コメント
  • X
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする

Julia に翻訳--123 テューキー法,平均値の対比較

2021年03月26日 | ブログラミング

#==========
Julia の修行をするときに,いろいろなプログラムを書き換えるのは有効な方法だ。
以下のプログラムを Julia に翻訳してみる。

テューキーの方法による平均値の対比較
http://aoki2.si.gunma-u.ac.jp/R/tukey.html

ファイル名: tukey.jl  関数名: tukey

翻訳するときに書いたメモ

Rmath の ptukey() にもバグがある
lower_tail = false を指定すると NaN を返す。
回避策としては,
ptukey(q, nmeans, df, false)

1 - ptukey(q, nmeans, df)
とする。

二重配列(リスト)を平坦化するには,vcat(A...) を使う。

==========#

using Statistics, Combinatorics, Rmath, Printf

function tukey(data, group; method = "Tukey") # or method = "Games-Howell"
    indices, n = table(group)
    a = length(n)
    npairs = binomial(a, 2)
    phie = sum(n) - a
    Mean = [mean(data[group .== g]) for g in indices]
    Variance = [var(data[group .== g]) for g in indices]
    pair = combinations(1:a, 2)
    if method == "Tukey"
        ve = sum((n .- 1) .* Variance) / phie
        t = [abs(Mean[i] - Mean[j]) / sqrt(ve * (1 / n[i] + 1 / n[j])) for (i, j) in pair]
        p = 1 .- ptukey.(t .* sqrt(2), a, phie)#, false)
        @printf(" pair  %7s  %7s\n", "t value", "p value")
        for (i, (j, k)) in enumerate(pair)
            @printf("%2d:%2d  %7.5f  %7.5f\n", j, k, t[i], p[i])
        end
        Dict(:t => t, :pvalue => p, :phi => phie, :v => ve)
    else
        t = [ts0(Mean[i], Variance[i], n[i], Mean[j], Variance[j], n[j]) for (i, j) in pair]
        df = [dfs0(Variance[i], n[i], Variance[j], n[j]) for (i, j) in pair]
        p = 1 .- ptukey.(t .* sqrt(2), a, df) #, false)
        @printf(" pair  %7s  %9s  %7s\n", "t value", "df", "p value")
        for (i, (j, k)) in enumerate(pair)
            @printf("%2d:%2d  %7.5f  %9.5f  %7.5f\n", j, k, t[i], df[i], p[i])
        end
        Dict(:t => t, :df => df, :pvalue => p)
    end
end

ts0(mi, vi, ni, mj, vj, nj) = abs(mi - mj) / sqrt(vi / ni + vj / nj)

dfs0(vi, ni, vj, nj) = (vi / ni + vj / nj) ^ 2 /
                       ((vi / ni)^2 / (ni - 1) + (vj / nj)^2 / (nj - 1))

function table(x) # indices が少ないとき
    indices = sort(unique(x))
    counts = zeros(Int, length(indices))
    for i in indexin(x, indices)
        counts[i] += 1
    end
    return indices, counts
end

data = [
  14., 15, 14, 16, 15, 17, 17,
  17, 16, 17, 16, 15, 18, 19, 15,
  18, 19, 20, 19, 17, 17,
  20, 21, 19, 20, 19, 22, 20,
  19, 20, 19, 17, 17, 17, 18
];

group = [repeat([i], count) for (i, count) in enumerate([7, 8, 6, 7, 7])]
group = vcat(group...)

tukey(data, group)
# pair  t value  p value
# 1: 2  1.85409  0.36302
# 1: 3  4.18754  0.00198
# 1: 4  7.07368  0.00000
# 1: 5  4.07273  0.00269
# 2: 3  2.53703  0.10906
# 2: 4  5.45158  0.00006
# 2: 5  2.35220  0.15676
# 3: 4  2.60863  0.09414
# 3: 5  0.27459  0.99868
# 4: 5  3.00096  0.03978

tukey(data, group, method = "Games-Howell")
# pair  t value         df  p value
# 1: 2  1.72859   12.97639  0.45125
# 1: 3  4.21141   10.84628  0.01043
# 1: 4  7.50517   11.65358  0.00007
# 1: 5  4.08185   11.97449  0.01084
# 2: 3  2.43499   11.69245  0.17285
# 2: 4  5.48706   12.78706  0.00087
# 2: 5  2.24124   12.99984  0.22492
# 3: 4  2.83393   10.14001  0.10023
# 3: 5  0.28228   10.70743  0.99838
# 4: 5  3.26970   11.80872  0.04412

コメント
  • X
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする

PVアクセスランキング にほんブログ村

PVアクセスランキング にほんブログ村