# HG changeset patch # User unc0rr # Date 1447511985 -10800 # Node ID ff0fa38bdb18e54141d23836062b1bef111253f1 # Parent e6a9528f02f754a103f7e3554763c1b32f767b5a Some WIP diff -r e6a9528f02f7 -r ff0fa38bdb18 gameServer/OfficialServer/Glicko2.hs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gameServer/OfficialServer/Glicko2.hs Sat Nov 14 17:39:45 2015 +0300 @@ -0,0 +1,66 @@ +{- + 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.3 +ε = 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] -> RatingData +calcNewRating oldRating [] = oldRating +calcNewRating oldRating 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 diff -r e6a9528f02f7 -r ff0fa38bdb18 gameServer/OfficialServer/updateRating.hs --- a/gameServer/OfficialServer/updateRating.hs Fri Nov 13 21:17:40 2015 +0300 +++ b/gameServer/OfficialServer/updateRating.hs Sat Nov 14 17:39:45 2015 +0300 @@ -1,71 +1,84 @@ -{- - Glicko2, as described in http://www.glicko.net/glicko/glicko2.pdf --} - +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} module Main where ---import Data.Map as Map +import Data.Maybe +import Data.TConfig +import qualified Data.ByteString.Char8 as B +import Database.MySQL.Simple +import Database.MySQL.Simple.QueryResults +import Database.MySQL.Simple.Result +import Control.Monad +import Control.Exception +import System.IO +import qualified Data.Map as Map +------ +import OfficialServer.Glicko2 + -data RatingData = RatingData { - ratingValue - , rD - , volatility :: Double - } -data GameData = GameData { - rating :: RatingData, - opponentRating :: RatingData, - gameScore :: Double +queryEpochDates = "SELECT epoch, todatetime, todatetime + INTERVAL 1 week FROM rating_epochs WHERE epoch = (SELECT MAX(epoch) FROM rating_epochs)" +queryPreviousRatings = "SELECT v.userid, v.rating, v.rd, v.volatility FROM rating_values as v WHERE (v.epoch = (SELECT MAX(epoch) FROM rating_epochs))" +queryGameResults = + "SELECT \ + \ p.userid \ + \ , p.place \ + \ , o.userid \ + \ , o.place \ + \ , COALESCE(vp.rating, 1500) \ + \ , COALESCE(vp.rd, 350) \ + \ , COALESCE(vp.volatility, 0.06) \ + \ , COALESCE(vo.rating, 1500) \ + \ , COALESCE(vo.rd, 350) \ + \ , COALESCE(vo.volatility, 0.06) \ + \ FROM \ + \ (SELECT epoch, todatetime FROM rating_epochs WHERE epoch = (SELECT MAX(epoch) FROM rating_epochs)) as e \ + \ JOIN rating_games as g ON (g.time BETWEEN e.todatetime AND e.todatetime + INTERVAL 1 WEEK - INTERVAL 1 SECOND) \ + \ JOIN rating_players as p ON (p.gameid = g.id) \ + \ JOIN rating_players as o ON (p.gameid = o.gameid AND p.userid <> o.userid AND (p.place = 0 OR (p.place <> o.place))) \ + \ LEFT OUTER JOIN rating_values as vp ON (vp.epoch = e.epoch AND vp.userid = p.userid) \ + \ LEFT OUTER JOIN rating_values as vo ON (vo.epoch = e.epoch AND vo.userid = o.userid) \ + \ GROUP BY p.userid, p.gameid, p.place \ + \ ORDER BY p.userid" + +--Map Int (RatingData, [GameData]) +calculateRatings dbConn = do + initRatingData <- (Map.fromList . map fromDBrating) `fmap` query_ dbConn queryPreviousRatings + return () + + where + fromDBrating (a, b, c, d) = (a, (RatingData b c d, [])) + + + +data DBConnectInfo = DBConnectInfo { + dbHost + , dbName + , dbLogin + , dbPassword :: B.ByteString } -τ, ε :: Double -τ = 0.3 -ε = 0.000001 - -g_φ :: Double -> Double -g_φ φ = 1 / sqrt (1 + 3 * φ^2 / pi^2) - -calcE :: GameData -> (Double, Double, Double) -calcE (GameData oldRating 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_φ φᵢ +cfgFileName :: String +cfgFileName = "hedgewars-server.ini" -calcNewRating :: [GameData] -> RatingData -calcNewRating [] = undefined -calcNewRating games@(GameData oldRating _ _ : _) = RatingData (173.7178 * μ' + 1500) (173.7178 * sqrt φ'sqr) σ' +readServerConfig :: ConnectInfo -> IO ConnectInfo +readServerConfig ci = do + cfg <- readConfig cfgFileName + return $ ci{ + connectHost = value "dbHost" cfg + , connectDatabase = value "dbName" cfg + , connectUser = value "dbLogin" cfg + , connectPassword = value "dbPassword" cfg + } where - _Es = map calcE 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 + value n c = fromJust2 n $ getValue n c + fromJust2 n Nothing = error $ "Missing config entry " ++ n + fromJust2 _ (Just a) = a - a = log (σ ^ 2) - f :: Double -> Double - f x = exp x * (_Δ ^ 2 - φ ^ 2 - υ - exp x) / 2 / (φ ^ 2 + υ + exp x) ^ 2 - (x - a) / τ ^ 2 +dbConnectionLoop mySQLConnectionInfo = + Control.Exception.handle (\(e :: SomeException) -> hPutStrLn stderr $ show e) $ + bracket + (connect mySQLConnectionInfo) + close + calculateRatings - _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 - -main = undefined +main = readServerConfig defaultConnectInfo >>= dbConnectionLoop