Sub RunBTM()
'Bradley-Terry Modelで強さをもとめる

'定数
Dim N As Integer
Dim K As Integer
Dim TK As Integer

'配列
Dim win(10) As Double
Dim lose(10) As Double
Dim rank(10) As Double
Dim rank1(10) As Double
Dim tn(10, 10) As Integer
Dim r(10) As Double
Dim x(10, 10) As Integer

'カウンタ
Dim i As Integer
Dim j As Integer
Dim t As Integer

'データ
Dim tmp As String
Dim err As Integer
Dim order1 As Integer
Dim maxval As Double
Dim L2 As Double
Dim L1 As Double
Dim L0 As Double
Dim likelihood As Double
Dim dof As Integer
Dim pvalue As Double

'データ入力
Do
    err = 0
    Do
        tmp = InputBox("参加人数を入力してください", "人数", 10)
        err = 0
        If tmp = "" Then
            MsgBox "数字を入力してください", 16, "入力エラー"
            err = 1
        End If
    Loop While err = 1
    N = tmp
    err = 0
    If N < 0 Or N > 10 Then
        MsgBox "入力範囲がちがいます", 16, "入力エラー"
        err = 1
    End If
Loop While err = 1

'プレイヤー名
Cells(N + 8, 1).Value = "名前"
For i = 1 To N
    Cells(N + 8 + i, 1).Value = Cells(1 + i, 1).Value
Next
    
'勝数
Cells(N + 8, 2).Value = "勝数"
For i = 1 To N
    For j = 1 To N
        If i <> j Then
            win(i) = win(i) + Cells(i + 1, j + 1).Value
        End If
    Next
    Cells(N + 8 + i, 2).Value = win(i)
Next

'敗数
Cells(N + 8, 3).Value = "敗数"
For j = 1 To N
    For i = 1 To N
        If i <> j Then
            lose(j) = lose(j) + Cells(i + 1, j + 1).Value
        End If
    Next
    Cells(N + 8 + j, 3).Value = lose(j)
Next

'勝率
Cells(N + 8, 4).Value = "勝率"
For i = 1 To N
    Cells(N + 8 + i, 4).Value = win(i) / (win(i) + lose(i))
Next

'順位１
Cells(N + 8, 5).Value = "順位(1)"
For i = 1 To N
    order1 = 1
    maxval = 0
    maxval = Cells(N + 8 + i, 4).Value
    For j = 1 To N
        If i <> j Then
            If Cells(N + 8 + j, 4).Value > maxval Then
                order1 = order1 + 1
            End If
        End If
    Next
    Cells(N + 8 + i, 5).Value = order1
Next

'対戦数
For i = 1 To N
    For j = 1 To N
        tn(i, j) = Cells(i + 1, j + 1).Value + Cells(j + 1, i + 1).Value
    Next
Next
    
'初期値
K = 50
TK = N * K

For i = 1 To N
    rank(i) = K
Next
    
For i = 1 To N
    For j = 1 To N
        If i <> j Then
            r(i) = r(i) + tn(i, j) / (rank(i) + rank(j))
        End If
    Next
    rank1(i) = win(i) / r(i)
Next
    
'繰り返し
For t = 1 To 20
    For i = 1 To N
        r(i) = 0
        For j = 1 To N
            r(i) = r(i) + rank1(j)
        Next
        rank(i) = TK * rank1(i) / r(i)
    Next

    For i = 1 To N
        r(i) = 0
        For j = 1 To N
            If i <> j Then
                r(i) = r(i) + tn(i, j) / (rank(i) + rank(j))
            End If
        Next
        rank1(i) = win(i) / r(i)
    Next
Next

'結果表示
Cells(N + 8, 6) = "強さ"
For i = 1 To N
    Cells(N + 8 + i, 6).Value = rank(i)
Next

'順位２
Cells(N + 8, 7).Value = "順位(2)"
For i = 1 To N
    order1 = 1
    maxval = 0
    maxval = rank(i)
    For j = 1 To N
        If i <> j Then
            If rank(j) > maxval Then
                order1 = order1 + 1
            End If
        End If
    Next
    Cells(N + 8 + i, 7).Value = order1
Next

'尤度比検定
'L1
For i = 1 To N
    L1 = L1 + win(i) * Log(rank(i))
    For j = i + 1 To N
        L1 = L1 - tn(i, j) * Log(rank(i) + rank(j))
    Next
Next

'L0
For i = 1 To N
    For j = 1 To N
        x(i, j) = x(i, j) + Cells(i + 1, j + 1).Value
    Next
Next
    
For i = 1 To N
    For j = 1 To N
        If i <> j Then
            L0 = L0 + x(i, j) * Log(x(i, j))
        End If
    Next
    For j = i + 1 To N
        L0 = L0 - tn(i, j) * Log(tn(i, j))
    Next
Next
    
'L2
For i = 1 To N
    For j = i + 1 To N
        L2 = L2 - tn(i, j) * Log(2)
    Next
Next

'モデルの適合度検定
Cells(N + 3, 1).Value = "尤度比(1)"
likelihood = 2 * (L0 - L1)
Cells(N + 3, 2).Value = likelihood

Cells(N + 4, 1).Value = "自由度(1)"
dof = (N - 1) * (N - 2) / 2
Cells(N + 4, 2).Value = dof

Cells(N + 5, 1).Value = "P値(1)"
Cells(N + 5, 2).Select
ActiveCell.FormulaR1C1 = "=CHIDIST(R[-2]C,R[-1]C)"
pvalue = Cells(N + 5, 2).Value

Cells(N + 6, 1).Value = "モデル"
If pvalue > 0.05 Then
    Cells(N + 6, 2).Value = "有効"
Else
    Cells(N + 6, 2).Value = "無効"
End If

'強さの均等性検定
Cells(N + 3, 4).Value = "尤度比(2)"
likelihood = 2 * (L1 - L2)
Cells(N + 3, 5).Value = likelihood

Cells(N + 4, 4).Value = "自由度(2)"
dof = (N - 1)
Cells(N + 4, 5).Value = dof

Cells(N + 5, 4).Value = "P値(2)"
Cells(N + 5, 5).Select
ActiveCell.FormulaR1C1 = "=CHIDIST(R[-2]C,R[-1]C)"
pvalue = Cells(N + 5, 5).Value

Cells(N + 6, 4).Value = "強さ"
If pvalue > 0.05 Then
    Cells(N + 6, 5).Value = "均等"
Else
    Cells(N + 6, 5).Value = "不均等"
End If

End Sub