diff -r bc7b6aa5d67a -r 7030706266df gameServer/OfficialServer/Glicko2.hs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gameServer/OfficialServer/Glicko2.hs Fri Dec 06 22:20:53 2019 +0100 @@ -0,0 +1,70 @@ +{- + Glicko2, as described in http://www.glicko.net/glicko/glicko2.pdf +-} + +module OfficialServer.Glicko2 where + +data RatingData = RatingData { + ratingValue + , rD + , volatility :: Double + } +data GameData = GameData { + opponentRating :: RatingData, + gameScore :: Double + } + +τ, ε :: Double +τ = 0.2 +ε = 0.000001 + +g_φ :: Double -> Double +g_φ φ = 1 / sqrt (1 + 3 * φ^2 / pi^2) + +calcE :: RatingData -> GameData -> (Double, Double, Double) +calcE oldRating (GameData oppRating s) = ( + 1 / (1 + exp (g_φᵢ * (μᵢ - μ))) + , g_φᵢ + , s + ) + where + μ = (ratingValue oldRating - 1500) / 173.7178 + φ = rD oldRating / 173.7178 + μᵢ = (ratingValue oppRating - 1500) / 173.7178 + φᵢ = rD oppRating / 173.7178 + g_φᵢ = g_φ φᵢ + + +calcNewRating :: RatingData -> [GameData] -> (Int, RatingData) +calcNewRating oldRating [] = (0, RatingData (ratingValue oldRating) (173.7178 * sqrt (φ ^ 2 + σ ^ 2)) σ) + where + φ = rD oldRating / 173.7178 + σ = volatility oldRating + +calcNewRating oldRating games = (length games, RatingData (173.7178 * μ' + 1500) (173.7178 * sqrt φ'sqr) σ') + where + _Es = map (calcE oldRating) games + υ = 1 / sum (map υ_p _Es) + υ_p (_Eᵢ, g_φᵢ, _) = g_φᵢ ^ 2 * _Eᵢ * (1 - _Eᵢ) + _Δ = υ * part1 + part1 = sum (map _Δ_p _Es) + _Δ_p (_Eᵢ, g_φᵢ, sᵢ) = g_φᵢ * (sᵢ - _Eᵢ) + + μ = (ratingValue oldRating - 1500) / 173.7178 + φ = rD oldRating / 173.7178 + σ = volatility oldRating + + a = log (σ ^ 2) + f :: Double -> Double + f x = exp x * (_Δ ^ 2 - φ ^ 2 - υ - exp x) / 2 / (φ ^ 2 + υ + exp x) ^ 2 - (x - a) / τ ^ 2 + + _A = a + _B = if _Δ ^ 2 > φ ^ 2 + υ then log (_Δ ^ 2 - φ ^ 2 - υ) else head . dropWhile ((>) 0 . f) . map (\k -> a - k * τ) $ [1 ..] + fA = f _A + fB = f _B + σ' = (\(_A, _, _, _) -> exp (_A / 2)) . head . dropWhile (\(_A, _, _B, _) -> abs (_B - _A) > ε) $ iterate step5 (_A, fA, _B, fB) + step5 (_A, fA, _B, fB) = let _C = _A + (_A - _B) * fA / (fB - fA); fC = f _C in + if fC * fB < 0 then (_B, fB, _C, fC) else (_A, fA / 2, _C, fC) + + φ'sqr = 1 / (1 / (φ ^ 2 + σ' ^ 2) + 1 / υ) + μ' = μ + φ'sqr * part1