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

    18 τ = 0.3

    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 

    38 calcNewRating :: RatingData -> [GameData] -> RatingData

    39 calcNewRating oldRating [] = oldRating

    40 calcNewRating oldRating games = RatingData (173.7178 * μ' + 1500) (173.7178 * sqrt φ'sqr) σ'

    41     where

    42         _Es = map (calcE oldRating) games

    43         υ = 1 / sum (map υ_p _Es)

    44         υ_p (_Eᵢ, g_φᵢ, _) = g_φᵢ ^ 2 * _Eᵢ * (1 - _Eᵢ)

    45         _Δ = υ * part1

    46         part1 = sum (map _Δ_p _Es)

    47         _Δ_p (_Eᵢ, g_φᵢ, sᵢ) = g_φᵢ * (sᵢ - _Eᵢ)

    48 

    49         μ = (ratingValue oldRating - 1500) / 173.7178

    50         φ = rD oldRating / 173.7178

    51         σ = volatility oldRating

    52 

    53         a = log (σ ^ 2)

    54         f :: Double -> Double

    55         f x = exp x * (_Δ ^ 2 - φ ^ 2 - υ - exp x) / 2 / (φ ^ 2 + υ + exp x) ^ 2 - (x - a) / τ ^ 2

    56 

    57         _A = a

    58         _B = if _Δ ^ 2 > φ ^ 2 + υ then log (_Δ ^ 2 - φ ^ 2 - υ) else head . dropWhile ((>) 0 . f) . map (\k -> a - k * τ) $ [1 ..]

    59         fA = f _A

    60         fB = f _B

    61         σ' = (\(_A, _, _, _) -> exp (_A / 2)) . head . dropWhile (\(_A, _, _B, _) -> abs (_B - _A) > ε) $ iterate step5 (_A, fA, _B, fB)

    62         step5 (_A, fA, _B, fB) = let _C = _A + (_A - _B) * fA / (fB - fA); fC = f _C in

    63                                      if fC * fB < 0 then (_B, fB, _C, fC) else (_A, fA / 2, _C, fC)

    64 

    65         φ'sqr = 1 / (1 / (φ ^ 2 + σ' ^ 2) + 1 / υ)

    66         μ' = μ + φ'sqr * part1