gameServer/OfficialServer/updateRating.hs
author unc0rr
Fri, 13 Nov 2015 21:17:40 +0300
changeset 11359 e6a9528f02f7
parent 11358 55360683db75
child 11380 ff0fa38bdb18
permissions -rw-r--r--
Finish formula implementation
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
11359
e6a9528f02f7 Finish formula implementation
unc0rr
parents: 11358
diff changeset
    27
calcE :: GameData -> (Double, Double, Double)
11358
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_φᵢ
11359
e6a9528f02f7 Finish formula implementation
unc0rr
parents: 11358
diff changeset
    31
    , s
11358
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    32
    )
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    33
    where
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    34
        μ = (ratingValue oldRating - 1500) / 173.7178
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    35
        φ = rD oldRating / 173.7178
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    36
        μᵢ = (ratingValue oppRating - 1500) / 173.7178
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    37
        φᵢ = rD oppRating / 173.7178
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    38
        g_φᵢ = g_φ φᵢ
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    39
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    40
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    41
calcNewRating :: [GameData] -> RatingData
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    42
calcNewRating [] = undefined
11359
e6a9528f02f7 Finish formula implementation
unc0rr
parents: 11358
diff changeset
    43
calcNewRating games@(GameData oldRating _ _ : _) = RatingData (173.7178 * μ' + 1500) (173.7178 * sqrt φ'sqr) σ'
11358
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    44
    where
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    45
        _Es = map calcE games
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    46
        υ = 1 / sum (map υ_p _Es)
11359
e6a9528f02f7 Finish formula implementation
unc0rr
parents: 11358
diff changeset
    47
        υ_p (_Eᵢ, g_φᵢ, _) = g_φᵢ ^ 2 * _Eᵢ * (1 - _Eᵢ)
e6a9528f02f7 Finish formula implementation
unc0rr
parents: 11358
diff changeset
    48
        _Δ = υ * part1
e6a9528f02f7 Finish formula implementation
unc0rr
parents: 11358
diff changeset
    49
        part1 = sum (map _Δ_p _Es)
e6a9528f02f7 Finish formula implementation
unc0rr
parents: 11358
diff changeset
    50
        _Δ_p (_Eᵢ, g_φᵢ, sᵢ) = g_φᵢ * (sᵢ - _Eᵢ)
11358
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    51
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    52
        μ = (ratingValue oldRating - 1500) / 173.7178
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    53
        φ = rD oldRating / 173.7178
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    54
        σ = volatility oldRating
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    55
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    56
        a = log (σ ^ 2)
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    57
        f :: Double -> Double
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    58
        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
    59
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    60
        _A = a
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    61
        _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
    62
        fA = f _A
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    63
        fB = f _B
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    64
        σ' = (\(_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
    65
        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
    66
                                     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
    67
11359
e6a9528f02f7 Finish formula implementation
unc0rr
parents: 11358
diff changeset
    68
        φ'sqr = 1 / (1 / (φ ^ 2 + σ' ^ 2) + 1 / υ)
e6a9528f02f7 Finish formula implementation
unc0rr
parents: 11358
diff changeset
    69
        μ' = μ + φ'sqr * part1
11358
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    70
55360683db75 Start work on rating calculator
unc0rr
parents:
diff changeset
    71
main = undefined