{-|
Module      : Ranking.Glicko.Types
License     : GPL-3
Maintainer  : prillan91@gmail.com
Stability   : experimental

For examples, see `Ranking.Glicko.Core` and `Ranking.Glicko.Inference`.
-}
{-# LANGUAGE KindSignatures #-}
module Ranking.Glicko.Types
       ( -- * Data types
         Player(..)
       , Match(..)
       , PlayerId
       , Score
       , ScoreFunction(..)
       , GlickoSettings(..) )
       where

import           Control.DeepSeq
import           Data.Default
import           GHC.TypeLits (Nat)

type PlayerId = Int
-- | 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 { Player version -> PlayerId
playerId         :: PlayerId -- ^ Player id, can be anything
         , Player version -> Double
playerRating     :: Double   -- ^ Rating
         , Player version -> Double
playerDev        :: Double   -- ^ Deviation
         , Player version -> Double
playerVol        :: Double   -- ^ Volatility
         , Player version -> PlayerId
playerInactivity :: Int      -- ^ Inactivity (not part of Glicko-2),
                                        -- keeps track of the number of rating
                                        -- updates a player has been inactive.
         , Player version -> PlayerId
playerAge        :: Int      -- ^ Age (not part of Glicko-2),
                                        -- keeps track of the number of rating
                                        -- updates since the player was added.
                     }
  deriving (PlayerId -> Player version -> ShowS
[Player version] -> ShowS
Player version -> String
(PlayerId -> Player version -> ShowS)
-> (Player version -> String)
-> ([Player version] -> ShowS)
-> Show (Player version)
forall a.
(PlayerId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
forall (version :: Nat). PlayerId -> Player version -> ShowS
forall (version :: Nat). [Player version] -> ShowS
forall (version :: Nat). Player version -> String
showList :: [Player version] -> ShowS
$cshowList :: forall (version :: Nat). [Player version] -> ShowS
show :: Player version -> String
$cshow :: forall (version :: Nat). Player version -> String
showsPrec :: PlayerId -> Player version -> ShowS
$cshowsPrec :: forall (version :: Nat). PlayerId -> Player version -> ShowS
Show, Player version -> Player version -> Bool
(Player version -> Player version -> Bool)
-> (Player version -> Player version -> Bool)
-> Eq (Player version)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (version :: Nat). Player version -> Player version -> Bool
/= :: Player version -> Player version -> Bool
$c/= :: forall (version :: Nat). Player version -> Player version -> Bool
== :: Player version -> Player version -> Bool
$c== :: forall (version :: Nat). Player version -> Player version -> Bool
Eq)

instance NFData (Player v) where
  rnf :: Player v -> ()
rnf (Player PlayerId
x1 Double
x2 Double
x3 Double
x4 PlayerId
x5 PlayerId
x6) = (PlayerId, Double, Double, Double, PlayerId, PlayerId) -> ()
forall a. NFData a => a -> ()
rnf (PlayerId
x1, Double
x2, Double
x3, Double
x4, PlayerId
x5, PlayerId
x6)

type Score = Int
data Match = Match { Match -> PlayerId
matchPlayerA :: PlayerId
                   , Match -> PlayerId
matchPlayerB :: PlayerId
                   , Match -> PlayerId
matchScoreA :: Score
                   , Match -> PlayerId
matchScoreB :: Score}
  deriving (PlayerId -> Match -> ShowS
[Match] -> ShowS
Match -> String
(PlayerId -> Match -> ShowS)
-> (Match -> String) -> ([Match] -> ShowS) -> Show Match
forall a.
(PlayerId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Match] -> ShowS
$cshowList :: [Match] -> ShowS
show :: Match -> String
$cshow :: Match -> String
showsPrec :: PlayerId -> Match -> ShowS
$cshowsPrec :: PlayerId -> Match -> ShowS
Show, Match -> Match -> Bool
(Match -> Match -> Bool) -> (Match -> Match -> Bool) -> Eq Match
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Match -> Match -> Bool
$c/= :: Match -> Match -> Bool
== :: Match -> Match -> Bool
$c== :: Match -> Match -> Bool
Eq)

-- | 'ScoreFunction's are used in 'compute' to evaluate two players performances against
-- eachother. It should obey the following laws,
--
--
-- prop>  0 <= compareScores x y
-- prop>  1 >= compareScores x y
-- prop>  compareScores x y == 1 - compareScores y x
--
--
-- The default implementation is
--
-- @
-- \\s1 s2 -> case s1 \`compare\` s2 of
--             LT -> 0
--             EQ -> 0.5
--             GT -> 1
-- @
newtype ScoreFunction = ScoreFunction { ScoreFunction -> PlayerId -> PlayerId -> Double
compareScores :: Score -> Score -> Double }
instance Default ScoreFunction where
  def :: ScoreFunction
def = (PlayerId -> PlayerId -> Double) -> ScoreFunction
ScoreFunction ((PlayerId -> PlayerId -> Double) -> ScoreFunction)
-> (PlayerId -> PlayerId -> Double) -> ScoreFunction
forall a b. (a -> b) -> a -> b
$ \PlayerId
s1 PlayerId
s2 -> case PlayerId
s1 PlayerId -> PlayerId -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` PlayerId
s2 of
    Ordering
LT -> Double
0
    Ordering
EQ -> Double
0.5
    Ordering
GT -> Double
1
instance Show ScoreFunction where
  show :: ScoreFunction -> String
show ScoreFunction
_ = String
"{score function}"

-- | Provides the 'Ranking.Glicko.Core.compute' function with parameters.
-- See <http://glicko.net/glicko/glicko2.pdf> for an explanation.
--
-- (NOTE: 'scoreFunction' is not a part of Glicko-2)
--
-- The default settings are as defined in the above paper.
data GlickoSettings = GlickoSettings
  { GlickoSettings -> Double
initialRating     :: Double
  , GlickoSettings -> Double
initialDeviation  :: Double
  , GlickoSettings -> Double
initialVolatility :: Double
  , GlickoSettings -> Double
tau               :: Double
  , GlickoSettings -> ScoreFunction
scoreFunction     :: ScoreFunction}
  deriving PlayerId -> GlickoSettings -> ShowS
[GlickoSettings] -> ShowS
GlickoSettings -> String
(PlayerId -> GlickoSettings -> ShowS)
-> (GlickoSettings -> String)
-> ([GlickoSettings] -> ShowS)
-> Show GlickoSettings
forall a.
(PlayerId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlickoSettings] -> ShowS
$cshowList :: [GlickoSettings] -> ShowS
show :: GlickoSettings -> String
$cshow :: GlickoSettings -> String
showsPrec :: PlayerId -> GlickoSettings -> ShowS
$cshowsPrec :: PlayerId -> GlickoSettings -> ShowS
Show

instance Default GlickoSettings where
  def :: GlickoSettings
def = GlickoSettings :: Double
-> Double -> Double -> Double -> ScoreFunction -> GlickoSettings
GlickoSettings
      { initialRating :: Double
initialRating     = Double
1500
      , initialDeviation :: Double
initialDeviation  = Double
350
      , initialVolatility :: Double
initialVolatility = Double
0.06
      , tau :: Double
tau = Double
0.5
      , scoreFunction :: ScoreFunction
scoreFunction = ScoreFunction
forall a. Default a => a
def}