glicko 0.1.1.1 → 0.3.0.0

raw patch · 6 files changed

+166/−171 lines, 6 filesdep −lensdep ~QuickCheckdep ~containersdep ~hspecPVP ok

version bump matches the API change (PVP)

Dependencies removed: lens

Dependency ranges changed: QuickCheck, containers, hspec, statistics

API changes (from Hackage documentation)

Files

• glicko.cabal +9/−9
• src/Ranking/Glicko/Core.hs +90/−88
• src/Ranking/Glicko/Inference.hs +17/−17
• src/Ranking/Glicko/Types.hs +22/−29
• test/Paper.hs +25/−25
• test/Spec.hs +3/−3

@@ -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 @@                        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 @@   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+                     , 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

@@ -1,3 +1,4 @@+{-# LANGUAGE RecordWildCards #-} {-| Module      : Ranking.Glicko.Core License     : GPL-3@@ -9,37 +10,37 @@  >>> 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 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 @@  -- | 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 @@          -- 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 @@ ε = 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))

@@ -12,19 +12,19 @@ >>> :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.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 @@  -- | 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

@@ -6,7 +6,7 @@  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 @@        , 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,

@@ -2,35 +2,35 @@  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 =

@@ -15,9 +15,9 @@   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)