9 import Database.MySQL.Simple.Result |
9 import Database.MySQL.Simple.Result |
10 import Control.Monad |
10 import Control.Monad |
11 import Control.Exception |
11 import Control.Exception |
12 import System.IO |
12 import System.IO |
13 import qualified Data.Map as Map |
13 import qualified Data.Map as Map |
|
14 import Data.Time.Clock |
14 ------ |
15 ------ |
15 import OfficialServer.Glicko2 |
16 import OfficialServer.Glicko2 |
16 |
17 |
17 |
18 |
18 queryEpochDates = "SELECT epoch, todatetime, todatetime + INTERVAL 1 week FROM rating_epochs WHERE epoch = (SELECT MAX(epoch) FROM rating_epochs)" |
19 queryEpochDates = "SELECT epoch, todatetime, todatetime + INTERVAL 1 week FROM rating_epochs WHERE epoch = (SELECT MAX(epoch) FROM rating_epochs)" |
19 queryPreviousRatings = "SELECT v.userid, v.rating, v.rd, v.volatility FROM rating_values as v WHERE (v.epoch = (SELECT MAX(epoch) FROM rating_epochs))" |
20 queryPreviousRatings = "SELECT v.userid, v.rating, v.rd, v.volatility FROM rating_values as v WHERE (v.epoch = (SELECT MAX(epoch) FROM rating_epochs))" |
20 queryGameResults = |
21 queryGameResults = |
21 "SELECT \ |
22 "SELECT \ |
22 \ p.userid \ |
23 \ p.userid \ |
23 \ , p.place \ |
24 \ , p.place \ |
24 \ , o.userid \ |
|
25 \ , o.place \ |
|
26 \ , COALESCE(vp.rating, 1500) \ |
25 \ , COALESCE(vp.rating, 1500) \ |
27 \ , COALESCE(vp.rd, 350) \ |
26 \ , COALESCE(vp.rd, 350) \ |
28 \ , COALESCE(vp.volatility, 0.06) \ |
27 \ , COALESCE(vp.volatility, 0.06) \ |
29 \ , COALESCE(vo.rating, 1500) \ |
28 \ , COALESCE(vo.rating, 1500) \ |
30 \ , COALESCE(vo.rd, 350) \ |
29 \ , COALESCE(vo.rd, 350) \ |
36 \ JOIN rating_players as o ON (p.gameid = o.gameid AND p.userid <> o.userid AND (p.place = 0 OR (p.place <> o.place))) \ |
35 \ JOIN rating_players as o ON (p.gameid = o.gameid AND p.userid <> o.userid AND (p.place = 0 OR (p.place <> o.place))) \ |
37 \ LEFT OUTER JOIN rating_values as vp ON (vp.epoch = e.epoch AND vp.userid = p.userid) \ |
36 \ LEFT OUTER JOIN rating_values as vp ON (vp.epoch = e.epoch AND vp.userid = p.userid) \ |
38 \ LEFT OUTER JOIN rating_values as vo ON (vo.epoch = e.epoch AND vo.userid = o.userid) \ |
37 \ LEFT OUTER JOIN rating_values as vo ON (vo.epoch = e.epoch AND vo.userid = o.userid) \ |
39 \ GROUP BY p.userid, p.gameid, p.place \ |
38 \ GROUP BY p.userid, p.gameid, p.place \ |
40 \ ORDER BY p.userid" |
39 \ ORDER BY p.userid" |
|
40 insertNewRatings = "INSERT INTO rating_values (userid, epoch, rating, rd, volatility) VALUES (?, ?, ?, ?, ?)" |
|
41 insertNewEpoch = "INSERT INTO rating_epochs (epoch, todatetime) VALUES (?, ?)" |
41 |
42 |
42 --Map Int (RatingData, [GameData]) |
43 mergeRatingData :: Map.Map Int (RatingData, [GameData]) -> [(Int, (RatingData, [GameData]))] -> Map.Map Int (RatingData, [GameData]) |
|
44 mergeRatingData m s = foldr (unc0rry (Map.insertWith mf)) m s |
|
45 where |
|
46 mf (rd, gds) (_, gds2) = (rd, gds ++ gds2) |
|
47 unc0rry f (a, b) c = f a b c |
|
48 |
43 calculateRatings dbConn = do |
49 calculateRatings dbConn = do |
|
50 [(epochNum :: Int, fromDate :: UTCTime, toDate :: UTCTime)] <- query_ dbConn queryEpochDates |
44 initRatingData <- (Map.fromList . map fromDBrating) `fmap` query_ dbConn queryPreviousRatings |
51 initRatingData <- (Map.fromList . map fromDBrating) `fmap` query_ dbConn queryPreviousRatings |
|
52 gameData <- map fromGameResult `fmap` query_ dbConn queryGameResults |
|
53 let mData = map getNewRating . Map.toList $ mergeRatingData initRatingData gameData |
|
54 executeMany dbConn insertNewRatings $ map (toInsert epochNum) mData |
|
55 execute dbConn insertNewEpoch (epochNum + 1, toDate) |
45 return () |
56 return () |
46 |
|
47 where |
57 where |
|
58 toInsert e (i, RatingData r rd v) = (i, e + 1, r, rd, v) |
|
59 getNewRating (a, d) = (a, uncurry calcNewRating d) |
|
60 convPlace :: Int -> Double |
|
61 convPlace 0 = 0.5 |
|
62 convPlace 1 = 1.0 |
|
63 convPlace 2 = 0.0 |
|
64 convPlace _ = error "Incorrect place value" |
48 fromDBrating (a, b, c, d) = (a, (RatingData b c d, [])) |
65 fromDBrating (a, b, c, d) = (a, (RatingData b c d, [])) |
49 |
66 fromGameResult (pid, place, prating, pRD, pvol, orating, oRD, ovol) = |
|
67 (pid, |
|
68 (RatingData prating pRD pvol |
|
69 , [GameData (RatingData orating oRD ovol) $ convPlace place])) |
50 |
70 |
51 |
71 |
52 data DBConnectInfo = DBConnectInfo { |
72 data DBConnectInfo = DBConnectInfo { |
53 dbHost |
73 dbHost |
54 , dbName |
74 , dbName |