Some WIP
authorunc0rr
Sat, 14 Nov 2015 17:39:45 +0300
changeset 11380 ff0fa38bdb18
parent 11359 e6a9528f02f7
child 11381 437a60995fe1
child 11405 307832da2756
Some WIP
gameServer/OfficialServer/Glicko2.hs
gameServer/OfficialServer/updateRating.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
--- 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