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