summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorrprecenth <>2021-01-13 13:07:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2021-01-13 13:07:00 (GMT)
commit2750468ec584ec938d92e69d4b200a62442ea9ef (patch)
treef96ef1490dc8dc02af6b1f009f115e76e3d9e884
parente325205dc5b48cd5b468423326092e45d31a0550 (diff)
version 0.3.0.00.3.0.0
-rw-r--r--glicko.cabal20
-rw-r--r--src/Ranking/Glicko/Core.hs178
-rw-r--r--src/Ranking/Glicko/Inference.hs34
-rw-r--r--src/Ranking/Glicko/Types.hs51
-rw-r--r--test/Paper.hs50
-rw-r--r--test/Spec.hs6
6 files changed, 167 insertions, 172 deletions
diff --git a/glicko.cabal b/glicko.cabal
index 5b33d86..35acc79 100644
--- a/glicko.cabal
+++ b/glicko.cabal
@@ -2,7 +2,7 @@
-- documentation, see http://haskell.org/cabal/users-guide/
name: glicko
-version: 0.1.1.1
+version: 0.3.0.0
synopsis: Glicko-2 implementation in Haskell.
description:
Implementation of the rating algorithm Glicko-2 by Professor Mark E. Glickman
@@ -28,14 +28,14 @@ library
Ranking.Glicko.Inference
Ranking.Glicko.Types
build-depends: base >= 4.8 && < 5
- , containers >= 0.5 && < 0.6
+ , containers >= 0.6 && < 0.7
, data-default >= 0.5 && < 0.8
, deepseq >= 1.4 && < 1.5
- , lens >= 4.12 && < 5
, parallel >= 3.2 && < 3.3
- , statistics >= 0.13 && < 0.14
+ , statistics >= 0.15 && < 0.16
hs-source-dirs: src
default-language: Haskell2010
+ default-extensions: DataKinds
test-suite glicko-test
type: exitcode-stdio-1.0
@@ -43,10 +43,10 @@ test-suite glicko-test
main-is: Spec.hs
other-modules: Paper
build-depends: base
- , data-default >= 0.5 && < 0.8
+ , data-default >= 0.5 && < 0.8
, glicko
- , hspec >= 2.1 && < 2.5
- , lens >= 4.12 && < 5
- , QuickCheck >= 2.8 && < 2.10
- ghc-options: -threaded -rtsopts -with-rtsopts=-N -O
- default-language: Haskell2010 \ No newline at end of file
+ , hspec >= 2.7.2 && < 2.8
+ , QuickCheck >= 2.13.2 && < 2.14
+ ghc-options: -threaded -rtsopts -with-rtsopts=-N
+ default-language: Haskell2010
+ default-extensions: DataKinds \ No newline at end of file
diff --git a/src/Ranking/Glicko/Core.hs b/src/Ranking/Glicko/Core.hs
index a38cb55..8486242 100644
--- a/src/Ranking/Glicko/Core.hs
+++ b/src/Ranking/Glicko/Core.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE RecordWildCards #-}
{-|
Module : Ranking.Glicko.Core
License : GPL-3
@@ -9,37 +10,37 @@ old ones.
>>> let ps = compute [] [Match 1 2 1 0] def
>>> ps
-[ Player { _pid = 1
- , _rating = 1662.3108939062977
- , _dev = 290.31896371798047
- , _vol = 5.999967537233814e-2
- , _inactivity = 0
- , _age = 1 }
-, Player { _pid = 2
- , _rating = 1337.6891060937023
- , _dev = 290.31896371798047
- , _vol = 5.999967537233814e-2
- , _inactivity = 0
- , _age = 1 }]
+[ Player { playerId = 1
+ , playerRating = 1662.3108939062977
+ , playerDev = 290.31896371798047
+ , playerVol = 5.999967537233814e-2
+ , playerInactivity = 0
+ , playerAge = 1 }
+, Player { playerId = 2
+ , playerRating = 1337.6891060937023
+ , playerDev = 290.31896371798047
+ , playerVol = 5.999967537233814e-2
+ , playerInactivity = 0
+ , playerAge = 1 }]
>>> compute ps [Match 1 3 0 0] def
-[ Player { _pid = 1
- , _rating = 1623.996484575735
- , _dev = 256.3451684359266
- , _vol = 5.999869083062934e-2
- , _inactivity = 0
- , _age = 2 }
-, Player { _pid = 2
- , _rating = 1337.6891060937023
- , _dev = 290.5060065906196
- , _vol = 5.999967537233814e-2
- , _inactivity = 1
- , _age = 2 }
-, Player { _pid = 3
- , _rating = 1557.6214863132009
- , _dev = 286.9272058793522
- , _vol = 5.999899836136578e-2
- , _inactivity = 0
- , _age = 1 }]
+[ Player { playerId = 1
+ , playerRating = 1623.996484575735
+ , playerDev = 256.3451684359266
+ , playerVol = 5.999869083062934e-2
+ , playerInactivity = 0
+ , playerAge = 2 }
+, Player { playerId = 2
+ , playerRating = 1337.6891060937023
+ , playerDev = 290.5060065906196
+ , playerVol = 5.999967537233814e-2
+ , playerInactivity = 1
+ , playerAge = 2 }
+, Player { playerId = 3
+ , playerRating = 1557.6214863132009
+ , playerDev = 286.9272058793522
+ , playerVol = 5.999899836136578e-2
+ , playerInactivity = 0
+ , playerAge = 1 }]
-}
module Ranking.Glicko.Core
( compute
@@ -51,7 +52,6 @@ import Prelude hiding ((^))
import qualified Prelude as P
import Data.Maybe
-import Control.Lens
import Control.Parallel.Strategies
import Data.Map (Map)
import qualified Data.Map.Strict as Map
@@ -69,47 +69,47 @@ pMap chunkSize f = withStrategy (parListChunk chunkSize rdeepseq) . map f
-- | Computes new ratings from the previous and adds new ones using the
-- specified settings.
-compute :: [Player] -- ^ Input players
- -> [Match] -- ^ Matches played this period
- -> GlickoSettings -- ^ Settings for computing the score values and adding new
- -- players.
- -> [Player] -- ^ Updated player ratings
+compute :: [Player 1] -- ^ Input players
+ -> [Match] -- ^ Matches played this period
+ -> GlickoSettings -- ^ Settings for computing the score values and adding new
+ -- players.
+ -> [Player 1] -- ^ Updated player ratings
compute = compute' map
-- | Same as 'compute' but runs in parallel using the specified chunkSize
-computeP :: Int -> [Player] -> [Match] -> GlickoSettings -> [Player]
+computeP :: Int -> [Player 1] -> [Match] -> GlickoSettings -> [Player 1]
computeP chunkSize = compute' (pMap chunkSize)
-- Update all player ratings
-compute' :: (((PlayerId, Player) -> Player) -> [(PlayerId, Player)] -> [Player])
- -> [Player]
+compute' :: (((PlayerId, Player 2) -> Player 1) -> [(PlayerId, Player 2)] -> [Player 1])
+ -> [Player 1]
-> [Match]
-> GlickoSettings
- -> [Player]
+ -> [Player 1]
compute' map' ps ms settings = map' (newToOld . updater . snd) . Map.toList $ pmap'
- where pmap = Map.fromList $ map (\p -> (_pid p, p)) ps
- pmap' = preprocess pmap ms settings
+ where pmap = Map.fromList $ map (\p -> (playerId p, p)) ps
+ pmap' = fmap oldToNew (preprocess pmap ms settings)
matches = preprocessMatches pmap' ms
updater p = updatePlayer p matches settings
-- Compute new rating for player
-updatePlayer :: Player -> [RatedMatch] -> GlickoSettings -> Player
+updatePlayer :: Player 2 -> [RatedMatch] -> GlickoSettings -> Player 2
updatePlayer p ms GlickoSettings{ tau = tau, scoreFunction = scoreFun }
- | null matches = (dev .~ sqrt (pφ^2 + pσ^2))
- . (inactivity +~ 1)
- . (age +~ 1) $ p
- | otherwise = (dev .~ φ')
- . (rating .~ µ')
- . (vol .~ σ')
- . (inactivity .~ 0)
- . (age +~ 1) $ p
+ | null matches = p { playerDev = sqrt (pφ^2 + pσ^2)
+ , playerInactivity = playerInactivity p + 1
+ , playerAge = playerAge p + 1 }
+ | otherwise = p { playerDev = φ'
+ , playerRating = µ'
+ , playerVol = σ'
+ , playerInactivity = 0
+ , playerAge = playerAge p + 1 }
where -- Initial values for player
- pµ = _rating p
- pφ = _dev p
- pσ = _vol p
+ pµ = playerRating p
+ pφ = playerDev p
+ pσ = playerVol p
-- Values for opponent in match `m`
- µ (_, opp, _, _) = _rating opp
- φ (_, opp, _, _) = _dev opp
+ µ (_, opp, _, _) = playerRating opp
+ φ (_, opp, _, _) = playerDev opp
-- Score value for match
s :: RatedMatch -> Double
s (_,_,sa,sb) = compareScores scoreFun sa sb
@@ -135,14 +135,16 @@ updatePlayer p ms GlickoSettings{ tau = tau, scoreFunction = scoreFun }
-- All matches `p` played in, arranged so that `p` is the first player
matches :: [RatedMatch]
- matches = map swap . filter (\(pla, plb, _, _) -> pla == p || plb == p) $ ms
+ matches = map swap
+ . filter (\(pla, plb, _, _) -> pla == p || plb == p)
+ $ ms
swap :: RatedMatch -> RatedMatch
swap m@(pla, plb, sca, scb)
| pla == p = m
| otherwise = (plb, pla, scb, sca)
-type RatedMatch = (Player, Player, Score, Score)
+type RatedMatch = (Player 2, Player 2, Score, Score)
-- g and E from step 3-4
_g :: Double -> Double
@@ -170,46 +172,46 @@ calcSigma delta φ σ v tau = step a b (f a) (f b)
ε = 0.000001
-- Add new default players where missing
-preprocess :: Map PlayerId Player -> [Match] -> GlickoSettings -> Map PlayerId Player
+preprocess :: Map PlayerId (Player 1)
+ -> [Match]
+ -> GlickoSettings
+ -> Map PlayerId (Player 1)
preprocess ps ms settings =
- Map.map oldToNew
- . Map.union ps
- . Map.fromList
- . map (\i -> (i, defaultPlayer {_pid=i}))
- . Set.toList $ diff
- where playersInMatches = Set.fromList $ (\m -> [_pla m, _plb m]) =<< ms
+ Map.union ps
+ . Map.fromSet (\i -> defaultPlayer { playerId = i })
+ $ playersInMatches `Set.difference` players
+ where playersInMatches = Set.fromList $ (\m -> [matchPlayerA m, matchPlayerB m]) =<< ms
players = Map.keysSet ps
- diff = Set.difference playersInMatches players
- defaultPlayer = Player { _pid = -1
- , _rating = initialRating settings
- , _dev = initialDeviation settings
- , _vol = initialVolatility settings
- , _inactivity = 0
- , _age = 0}
+ defaultPlayer = Player { playerId = -1
+ , playerRating = initialRating settings
+ , playerDev = initialDeviation settings
+ , playerVol = initialVolatility settings
+ , playerInactivity = 0
+ , playerAge = 0}
-- Pull the players into the matches
-preprocessMatches :: Map PlayerId Player -> [Match] -> [RatedMatch]
-preprocessMatches ps = mapMaybe (
- \m -> (,,,)
- <$> Map.lookup (_pla m) ps
- <*> Map.lookup (_plb m) ps
- <*> pure (_sca m)
- <*> pure (_scb m)
- )
+preprocessMatches :: Map PlayerId (Player 2) -> [Match] -> [RatedMatch]
+preprocessMatches ps = mapMaybe f
+ where f m = do
+ pla <- Map.lookup (matchPlayerA m) ps
+ plb <- Map.lookup (matchPlayerB m) ps
+ pure (pla, plb, matchScoreA m, matchScoreB m)
-- | Convert ratings from Glicko to Glicko-2
-oldToNew :: Player -> Player
-oldToNew p@Player{ _rating = r, _dev = d} = p { _rating = (r - 1500) / glicko2Multiplier
- , _dev = d / glicko2Multiplier }
+oldToNew :: Player 1 -> Player 2
+oldToNew p@Player{ playerRating = r, playerDev = d} =
+ p { playerRating = (r - 1500) / glicko2Multiplier
+ , playerDev = d / glicko2Multiplier }
-- | Convert ratings from Glicko-2 to Glicko
-newToOld :: Player -> Player
-newToOld p@Player{ _rating = r, _dev = d} = p { _rating = r*glicko2Multiplier + 1500
- , _dev = d*glicko2Multiplier}
+newToOld :: Player 2 -> Player 1
+newToOld p@Player{ playerRating = r, playerDev = d} =
+ p { playerRating = r * glicko2Multiplier + 1500
+ , playerDev = d * glicko2Multiplier}
glicko2Multiplier :: Double
glicko2Multiplier = 173.7178
-playersToMap :: [Player] -> Map PlayerId Player
-playersToMap = Map.fromList . map (\p -> (_pid p, p))
+playersToMap :: [Player v] -> Map PlayerId (Player v)
+playersToMap = Map.fromList . map (\p -> (playerId p, p))
diff --git a/src/Ranking/Glicko/Inference.hs b/src/Ranking/Glicko/Inference.hs
index 0bfe462..48ce6df 100644
--- a/src/Ranking/Glicko/Inference.hs
+++ b/src/Ranking/Glicko/Inference.hs
@@ -12,19 +12,19 @@ Example usage:
>>> :m + Data.Default
>>> let p1:p2:_ = compute players matches def
>>> p1
-Player { _pid = 1
- , _rating = 1464.0506705393013
- , _dev = 151.51652412385727
- , _vol = 5.9995984286488495e-2
- , _inactivity = 0
- , _age = 1 }
+Player { playerId = 1
+ , playerRating = 1464.0506705393013
+ , playerDev = 151.51652412385727
+ , playerVol = 5.9995984286488495e-2
+ , playerInactivity = 0
+ , playerAge = 1 }
>>> p2
-Player { _pid = 2
- , _rating = 1398.1435582337338
- , _dev = 31.67021528115062
- , _vol = 5.999912372888531e-2
- , _inactivity = 0
- , _age = 1 }
+Player { playerId = 2
+ , playerRating = 1398.1435582337338
+ , playerDev = 31.67021528115062
+ , playerVol = 5.999912372888531e-2
+ , playerInactivity = 0
+ , playerAge = 1 }
>>> predict p1 p2
0.5732533698644847 -- Player 1 has a 57.3% chance of winning a single game.
>>> let Just f = boX 5
@@ -46,12 +46,12 @@ import Statistics.Distribution
import Statistics.Distribution.Normal
-- | Computes the probability that Player A wins against Player B
-predict :: Player -- ^ Player A
- -> Player -- ^ Player B
+predict :: Player 1 -- ^ Player A
+ -> Player 1 -- ^ Player B
-> Double
predict pla plb = cumulative dist (ra - rb)
- where Player { _rating = ra, _dev = da } = oldToNew pla
- Player { _rating = rb, _dev = db } = oldToNew plb
+ where Player { playerRating = ra, playerDev = da } = oldToNew pla
+ Player { playerRating = rb, playerDev = db } = oldToNew plb
dist = normalDistr 0 (1 + da + db)
-- TODO: Check the above ^
@@ -72,7 +72,7 @@ fromBoX = coerce
-- | Same as 'predict', but computes the probability that
-- Player A wins a match played as best-of-X games.
-predictBoX :: BoX -> Player -> Player -> Double
+predictBoX :: BoX -> Player 1 -> Player 1 -> Double
predictBoX n p1 p2 =
sum $ map (\i -> fromInteger ((z + i) `choose` i) * p^w * q^i) [0..z]
where p = predict p1 p2
diff --git a/src/Ranking/Glicko/Types.hs b/src/Ranking/Glicko/Types.hs
index 7e470e9..e49b0de 100644
--- a/src/Ranking/Glicko/Types.hs
+++ b/src/Ranking/Glicko/Types.hs
@@ -6,7 +6,7 @@ Stability : experimental
For examples, see `Ranking.Glicko.Core` and `Ranking.Glicko.Inference`.
-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE KindSignatures #-}
module Ranking.Glicko.Types
( -- * Data types
Player(..)
@@ -14,47 +14,40 @@ module Ranking.Glicko.Types
, PlayerId
, Score
, ScoreFunction(..)
- , GlickoSettings(..)
- -- * Lenses
- -- ** Player
- , pid, rating, dev, vol, inactivity, age
- -- ** Match
- , pla, plb, sca, scb )
+ , GlickoSettings(..) )
where
import Control.DeepSeq
-import Control.Lens
import Data.Default
+import GHC.TypeLits (Nat)
type PlayerId = Int
--- | Data type representing a player's Glicko rating.
---
--- (NOTE: The system assumes Glicko ratings, to convert to Glicko-2
--- , use 'Ranking.Glicko.Core.oldToNew')
-data Player = Player { _pid :: PlayerId -- ^ Player id, can be anything
- , _rating :: Double -- ^ Rating
- , _dev :: Double -- ^ Deviation
- , _vol :: Double -- ^ Volatility
- , _inactivity :: Int -- ^ Inactivity (not part of Glicko-2),
- -- keeps track of the number of rating
- -- updates a player has been inactive.
- , _age :: Int -- ^ Age (not part of Glicko-2),
- -- keeps track of the number of rating
- -- updates since the player was added.
+-- | Data type representing a player's Glicko rating. The type
+-- 'version' is used to differentiate between Glicko ('Player' 1) and
+-- Glicko-2 ('Player' 2).
+data Player (version :: Nat) =
+ Player { playerId :: PlayerId -- ^ Player id, can be anything
+ , playerRating :: Double -- ^ Rating
+ , playerDev :: Double -- ^ Deviation
+ , playerVol :: Double -- ^ Volatility
+ , playerInactivity :: Int -- ^ Inactivity (not part of Glicko-2),
+ -- keeps track of the number of rating
+ -- updates a player has been inactive.
+ , playerAge :: Int -- ^ Age (not part of Glicko-2),
+ -- keeps track of the number of rating
+ -- updates since the player was added.
}
deriving (Show, Eq)
-makeLenses ''Player
-instance NFData Player where
+instance NFData (Player v) where
rnf (Player x1 x2 x3 x4 x5 x6) = rnf (x1, x2, x3, x4, x5, x6)
type Score = Int
-data Match = Match { _pla :: PlayerId
- , _plb :: PlayerId
- , _sca :: Score
- , _scb :: Score}
+data Match = Match { matchPlayerA :: PlayerId
+ , matchPlayerB :: PlayerId
+ , matchScoreA :: Score
+ , matchScoreB :: Score}
deriving (Show, Eq)
-makeLenses ''Match
-- | 'ScoreFunction's are used in 'compute' to evaluate two players performances against
-- eachother. It should obey the following laws,
diff --git a/test/Paper.hs b/test/Paper.hs
index 32a603f..9a1c94e 100644
--- a/test/Paper.hs
+++ b/test/Paper.hs
@@ -2,35 +2,35 @@ module Paper where
import Ranking.Glicko
-players :: [Player]
+players :: [Player 1]
players =
- [ Player { _pid = 1
- , _rating = 1500
- , _dev = 200
- , _vol = 0.06
- , _inactivity = 0
- , _age = 0 }
+ [ Player { playerId = 1
+ , playerRating = 1500
+ , playerDev = 200
+ , playerVol = 0.06
+ , playerInactivity = 0
+ , playerAge = 0 }
- , Player { _pid = 2
- , _rating = 1400
- , _dev = 30
- , _vol = 0.06
- , _inactivity = 0
- , _age = 0 }
+ , Player { playerId = 2
+ , playerRating = 1400
+ , playerDev = 30
+ , playerVol = 0.06
+ , playerInactivity = 0
+ , playerAge = 0 }
- , Player { _pid = 3
- , _rating = 1550
- , _dev = 100
- , _vol = 0.06
- , _inactivity = 0
- , _age = 0 }
+ , Player { playerId = 3
+ , playerRating = 1550
+ , playerDev = 100
+ , playerVol = 0.06
+ , playerInactivity = 0
+ , playerAge = 0 }
- , Player { _pid = 4
- , _rating = 1700
- , _dev = 300
- , _vol = 0.06
- , _inactivity = 0
- , _age = 0 }]
+ , Player { playerId = 4
+ , playerRating = 1700
+ , playerDev = 300
+ , playerVol = 0.06
+ , playerInactivity = 0
+ , playerAge = 0 }]
matches :: [Match]
matches =
diff --git a/test/Spec.hs b/test/Spec.hs
index cbf3c66..9c6ff06 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -15,9 +15,9 @@ main = hspec $ do
describe "Ranking.Glicko.Core" $ do
it "Glicko2 paper test case (http://glicko.net/glicko/glicko2.pdf)" $ do
let p:_ = compute players matches def
- d = _dev p
- r = _rating p
- v = _vol p
+ d = playerDev p
+ r = playerRating p
+ v = playerVol p
r `shouldSatisfy` (`doubleEqual` 1464.0506705393013)
d `shouldSatisfy` (`doubleEqual` 151.51652412385727)
v `shouldSatisfy` (`doubleEqual` 5.9995984286488495e-2)