Полозов Андрей Анатольевич

Макрос в Excel для расчета системы линейных уравнений при определении рейтинга в личном первенстве по баскетболу

Sub РАСЧЕТ_Rt()
Dim m(1 To 100, 1 To 100), n(1 To 100, 1 To 100), b1(1 To 100), b2(1 To 100), SSS(1 To 100), c(1 To 100) As Double
Dim A(1 To 100, 1 To 100), b(1 To 100), R(1 To 100, 1 To 100), L(1 To 100, 1 To 100), Y(1 To 100), X(1 To 100)  As Double
Dim Z(100), P(100) As Double, Npa, Nek, Nce, Nlo As Integer
Dim PaIp(1 To 100), EkIn(1 To 100), CeIt(1 To 100), EtLo(1 To 100), Del(1 To 100, 4), Otkl(1 To 100), Xcp1, Xcp2, NomerIg(100), Familia(100), Zkp(20), Pkp(20) As Variant
Nig = Cells(1, 18): Nn = Cells(2, 18)
For i = 1 To Nn
For j = 1 To 12
m(i, j) = Cells(i, j)
Next j, i
For i = 1 To Nig
NomerIg(i) = Cells(i + 4, 15)
Familia(i) = Cells(i + 4, 16)
Next i
For i = 1 To Nn
For j = 1 To 10
For k = 1 To 10
If j < 6 And k < 6 Then A(m(i, j), m(i, k)) = A(m(i, j), m(i, k)) + m(i, 11) + m(i, 12)
If j > 5 And k > 5 Then A(m(i, j), m(i, k)) = A(m(i, j), m(i, k)) + m(i, 11) + m(i, 12)
If j 5 Then A(m(i, j), m(i, k)) = A(m(i, j), m(i, k)) - m(i, 11) - m(i, 12)
If j > 5 And k < 6 Then A(m(i, j), m(i, k)) = A(m(i, j), m(i, k)) - m(i, 11) - m(i, 12)
Next k, j, i

For i = 1 To Nig
For j = 1 To Nig
If i j Then A(i, j) = A(i, j) / A(i, i)
Next j
A(i, i) = 1: c(i) = 1
Next i

For Ct = 1 To Nn
For i = 1 To Nig
For j = 1 To 10
If m(Ct, j) = i And j < 6 Then
b1(m(Ct, j)) = b1(m(Ct, j)) + m(Ct, 11): b2(m(Ct, j)) = b2(m(Ct, j)) + m(Ct, 12)
End If
If m(Ct, j) = i And j > 5 Then
b1(m(Ct, j)) = b1(m(Ct, j)) + m(Ct, 12): b2(m(Ct, j)) = b2(m(Ct, j)) + m(Ct, 11)
End If
Next j, i, Ct
For i = 1 To Nig
b(i) = 1000 * (b1(i) - b2(i)) / (b1(i) + b2(i))
Next
For j = 1 To Nig
A(Nig, j) = 1 / Nig
Next
b(Nig) = 2200


For t = 1 To Nig
L(t, 1) = A(t, 1)
R(1, t) = A(1, t) / A(1, 1)
Next t
Y(1) = b(1) / A(1, 1)
For t = 2 To Nig
R(t, t) = 1
j = 2
Do
L(t, j) = A(t, j)
R(t, j) = 0
For k = 1 To j - 1
L(t, j) = L(t, j) - L(t, k) * R(k, j)
Next
j = j + 1
Loop Until j > t
R(t, t) = 1
Do
L(t, j) = 0
R(t, j) = A(t, j)
Y(t) = b(t)
For k = 1 To t - 1
R(t, j) = R(t, j) - L(t, k) * R(k, j)
Y(t) = Y(t) - L(t, k) * Y(k)
Next
R(t, j) = R(t, j) / L(t, t)
Y(t) = Y(t) / L(t, t)
j = j + 1
Loop Until j > Nig
Next
X(Nig) = Y(Nig)
For t = Nig - 1 To 1 Step -1
X(t) = Y(t)
For k = t + 1 To Nig
X(t) = X(t) - R(t, k) * X(k)
Next
Next

For i = 1 To Nig
For j = 1 To Nig
If i j And X(i) < X(j) Then c(i) = c(i) + 1
Next j, i

' считаем ожидаемый счет игры
For i = 1 To Nn
SSa = SSa + m(i, 11) + m(i, 12)
Next i
SSa = SSa / Nn

For i = 1 To Nn
Rtcr1 = 0: Rtcr2 = 0
Xcp1 = (X(m(i, 1)) + X(m(i, 2)) + X(m(i, 3)) + X(m(i, 4)) + X(m(i, 5))) / 5
Xcp2 = (X(m(i, 6)) + X(m(i, 7)) + X(m(i, 8)) + X(m(i, 9)) + X(m(i, 10))) / 5
For j = 1 To 10
If j < 6 Then Rtcr1 = Rtcr1 + (X(m(i, j)) / Xcp1) * X(m(i, j))
If j > 5 Then Rtcr2 = Rtcr2 + (X(m(i, j)) / Xcp2) * X(m(i, j))
Next j
Rtcr1 = Rtcr1 / 4: Rtcr2 = Rtcr2 / 4
If m(i, 11) + m(i, 12) > 0 Then Z(i) = ((m(i, 11) + m(i, 12)) * (Rtcr1 - Rtcr2 + 1000)) / 2000
If m(i, 11) + m(i, 12) = 0 Then Z(i) = (SSa * (Rtcr1 - Rtcr2 + 1000)) / 2000
If m(i, 11) + m(i, 12) > 0 Then P(i) = (m(i, 11) + m(i, 12)) * (1000 - (Rtcr1 - Rtcr2)) / 2000
If m(i, 11) + m(i, 12) = 0 Then P(i) = (SSa) * (1000 - (Rtcr1 - Rtcr2)) / 2000
Next i

For i = 1 To Nn
'Cells(i, 13) = Z(i): Cells(i, 14) = P(i)
Next i

For i = 1 To Nig
'PaIp(Cells(i + 4, 15)) = Cells(i + 4, 18):
'EkIn(Cells(i + 4, 15)) = Cells(i + 4, 19)
'CeIt(Cells(i + 4, 15)) = Cells(i + 4, 20):
'EtLo(Cells(i + 4, 15)) = Cells(i + 4, 21)
Next i

For i = 1 To Nn
Npa = 0: Nek = 0: Nce = 0: Nlo = 0
Otkl(i) = ((m(i, 11) - Z(i)) + (P(i) - m(i, 12)))
For j = 1 To 10
If j < 6 And PaIp(m(i, j)) = 1 Then Npa = Npa + 1:
If j > 5 And PaIp(m(i, j)) = 1 Then Npa = Npa - 1
If j < 6 And EkIn(m(i, j)) = 1 Then Nek = Nek + 1:
If j > 5 And EkIn(m(i, j)) = 1 Then Nek = Nek - 1
If j < 6 And CeIt(m(i, j)) = 1 Then Nce = Nce + 1:
If j > 5 And CeIt(m(i, j)) = 1 Then Nce = Nce - 1
If j < 6 And EtLo(m(i, j)) = 1 Then Nlo = Nlo + 1:
If j > 5 And EtLo(m(i, j)) = 1 Then Nlo = Nlo - 1
Next j
Del(i, 1) = 1000 * Npa / 10: Del(i, 2) = 1000 * Nek / 10
Del(i, 3) = 1000 * Nce / 10: Del(i, 4) = 1000 * Nlo / 10
Next i

For i = 1 To Nn
'Cells(i, 25) = Del(i, 1): Cells(i, 26) = Del(i, 2): Cells(i, 27) = Del(i, 3): Cells(i, 28) = Del(i, 4)
'Cells(i, 24) = Otkl(i)
Next i
' посчитаем разность если бы распределение было бы равномерным
For i = 1 To Nig
Sts = Sts + b1(i) + b2(i)
Next i
Sts = Sts / Nig
For i = 1 To Nig
Zkp(i) = (Sts + (Sts * (X(i) - 2200) / 1000)) / 2: Pkp(i) = Sts - Zkp(i)
Next i


For i = 1 To Nig
Cells(c(i) + 4, 18) = c(i)
Cells(c(i) + 4, 19) = Familia(i)
Cells(c(i) + 4, 20) = X(i):
Cells(c(i) + 4, 21) = b1(i)
Cells(c(i) + 4, 22) = b2(i)
Cells(c(i) + 4, 23) = Zkp(i)
Cells(c(i) + 4, 24) = Pkp(i)
Next i

End Sub

Полозов, А.А. Система  рейтинга  в игровых   видах   спорта и единоборствах:  Монография. Екатеринбург: Изд-во УГТУ-УПИ, 1995. 110 с.
Полозов, А.А. Рейтинг в спорте: вчера, сегодня, завтра / А.А.Полозов. – М.:Советский спорт, 2007 – 316с.
www.polozov.nemi-ekb.ru