11375
|
1 |
{-
|
|
2 |
Glicko2, as described in http://www.glicko.net/glicko/glicko2.pdf
|
|
3 |
-}
|
|
4 |
|
|
5 |
module Main where
|
|
6 |
|
|
7 |
--import Data.Map as Map
|
|
8 |
|
|
9 |
data RatingData = RatingData {
|
|
10 |
ratingValue
|
|
11 |
, rD
|
|
12 |
, volatility :: Double
|
|
13 |
}
|
|
14 |
data GameData = GameData {
|
|
15 |
rating :: RatingData,
|
|
16 |
opponentRating :: RatingData,
|
|
17 |
gameScore :: Double
|
|
18 |
}
|
|
19 |
|
|
20 |
τ, ε :: Double
|
|
21 |
τ = 0.3
|
|
22 |
ε = 0.000001
|
|
23 |
|
|
24 |
g_φ :: Double -> Double
|
|
25 |
g_φ φ = 1 / sqrt (1 + 3 * φ^2 / pi^2)
|
|
26 |
|
11376
|
27 |
calcE :: GameData -> (Double, Double, Double)
|
11375
|
28 |
calcE (GameData oldRating oppRating s) = (
|
|
29 |
1 / (1 + exp (g_φᵢ * (μᵢ - μ)))
|
|
30 |
, g_φᵢ
|
11376
|
31 |
, s
|
11375
|
32 |
)
|
|
33 |
where
|
|
34 |
μ = (ratingValue oldRating - 1500) / 173.7178
|
|
35 |
φ = rD oldRating / 173.7178
|
|
36 |
μᵢ = (ratingValue oppRating - 1500) / 173.7178
|
|
37 |
φᵢ = rD oppRating / 173.7178
|
|
38 |
g_φᵢ = g_φ φᵢ
|
|
39 |
|
|
40 |
|
|
41 |
calcNewRating :: [GameData] -> RatingData
|
|
42 |
calcNewRating [] = undefined
|
11376
|
43 |
calcNewRating games@(GameData oldRating _ _ : _) = RatingData (173.7178 * μ' + 1500) (173.7178 * sqrt φ'sqr) σ'
|
11375
|
44 |
where
|
|
45 |
_Es = map calcE games
|
|
46 |
υ = 1 / sum (map υ_p _Es)
|
11376
|
47 |
υ_p (_Eᵢ, g_φᵢ, _) = g_φᵢ ^ 2 * _Eᵢ * (1 - _Eᵢ)
|
|
48 |
_Δ = υ * part1
|
|
49 |
part1 = sum (map _Δ_p _Es)
|
|
50 |
_Δ_p (_Eᵢ, g_φᵢ, sᵢ) = g_φᵢ * (sᵢ - _Eᵢ)
|
11375
|
51 |
|
|
52 |
μ = (ratingValue oldRating - 1500) / 173.7178
|
|
53 |
φ = rD oldRating / 173.7178
|
|
54 |
σ = volatility oldRating
|
|
55 |
|
|
56 |
a = log (σ ^ 2)
|
|
57 |
f :: Double -> Double
|
|
58 |
f x = exp x * (_Δ ^ 2 - φ ^ 2 - υ - exp x) / 2 / (φ ^ 2 + υ + exp x) ^ 2 - (x - a) / τ ^ 2
|
|
59 |
|
|
60 |
_A = a
|
|
61 |
_B = if _Δ ^ 2 > φ ^ 2 + υ then log (_Δ ^ 2 - φ ^ 2 - υ) else head . dropWhile ((>) 0 . f) . map (\k -> a - k * τ) $ [1 ..]
|
|
62 |
fA = f _A
|
|
63 |
fB = f _B
|
|
64 |
σ' = (\(_A, _, _, _) -> exp (_A / 2)) . head . dropWhile (\(_A, _, _B, _) -> abs (_B - _A) > ε) $ iterate step5 (_A, fA, _B, fB)
|
|
65 |
step5 (_A, fA, _B, fB) = let _C = _A + (_A - _B) * fA / (fB - fA); fC = f _C in
|
|
66 |
if fC * fB < 0 then (_B, fB, _C, fC) else (_A, fA / 2, _C, fC)
|
|
67 |
|
11376
|
68 |
φ'sqr = 1 / (1 / (φ ^ 2 + σ' ^ 2) + 1 / υ)
|
|
69 |
μ' = μ + φ'sqr * part1
|
11375
|
70 |
|
|
71 |
main = undefined
|