gameServer/OfficialServer/updateRating.hs
author unc0rr
Thu, 12 Nov 2015 23:38:01 +0300
changeset 11358 55360683db75
child 11359 e6a9528f02f7
permissions -rw-r--r--
Start work on rating calculator
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
11358
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
     1
{-
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
     2
    Glicko2, as described in http://www.glicko.net/glicko/glicko2.pdf
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
     3
-}
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
     4
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
     5
module Main where
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
     6
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
     7
--import Data.Map as Map
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
     8
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
     9
data RatingData = RatingData {
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    10
        ratingValue
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    11
        , rD
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    12
        , volatility :: Double
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    13
    }
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    14
data GameData = GameData {
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    15
        rating :: RatingData,
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    16
        opponentRating :: RatingData,
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    17
        gameScore :: Double
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    18
    }
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    19
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    20
τ, ε :: Double
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    21
τ = 0.3
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    22
ε = 0.000001
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    23
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    24
g_φ :: Double -> Double
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    25
g_φ φ = 1 / sqrt (1 + 3 * φ^2 / pi^2)
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    26
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    27
calcE :: GameData -> (Double, Double)
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    28
calcE (GameData oldRating oppRating s) = (
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    29
    1 / (1 + exp (g_φᵢ * (μᵢ - μ)))
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    30
    , g_φᵢ
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    31
    )
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    32
    where
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    33
        μ = (ratingValue oldRating - 1500) / 173.7178
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    34
        φ = rD oldRating / 173.7178
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    35
        μᵢ = (ratingValue oppRating - 1500) / 173.7178
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    36
        φᵢ = rD oppRating / 173.7178
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    37
        g_φᵢ = g_φ φᵢ
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    38
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    39
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    40
calcNewRating :: [GameData] -> RatingData
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    41
calcNewRating [] = undefined
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    42
calcNewRating games@(GameData oldRating _ _ : _) = undefined
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    43
    where
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    44
        _Es = map calcE games
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    45
        υ = 1 / sum (map υ_p _Es)
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    46
        υ_p (_Eᵢ, g_φᵢ) = g_φᵢ ^ 2 * _Eᵢ * (1 - _Eᵢ)
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    47
        _Δ = υ * sum (map _Δ_p $ zip _Es (map gameScore games))
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    48
        _Δ_p ((_Eᵢ, g_φᵢ), sᵢ) = g_φᵢ * (sᵢ - _Eᵢ)
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    49
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    50
        μ = (ratingValue oldRating - 1500) / 173.7178
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    51
        φ = rD oldRating / 173.7178
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    52
        σ = volatility oldRating
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    53
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    54
        a = log (σ ^ 2)
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    55
        f :: Double -> Double
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    56
        f x = exp x * (_Δ ^ 2 - φ ^ 2 - υ - exp x) / 2 / (φ ^ 2 + υ + exp x) ^ 2 - (x - a) / τ ^ 2
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    57
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    58
        _A = a
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    59
        _B = if _Δ ^ 2 > φ ^ 2 + υ then log (_Δ ^ 2 - φ ^ 2 - υ) else head . dropWhile ((>) 0 . f) . map (\k -> a - k * τ) $ [1 ..]
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    60
        fA = f _A
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    61
        fB = f _B
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    62
        σ' = (\(_A, _, _, _) -> exp (_A / 2)) . head . dropWhile (\(_A, _, _B, _) -> abs (_B - _A) > ε) $ iterate step5 (_A, fA, _B, fB)
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    63
        step5 (_A, fA, _B, fB) = let _C = _A + (_A - _B) * fA / (fB - fA); fC = f _C in
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    64
                                     if fC * fB < 0 then (_B, fB, _C, fC) else (_A, fA / 2, _C, fC)
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    65
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    66
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    67
main = undefined