{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}

-- | A range of Hole cards.
module Poker.Range
  ( Freq (..),
    Range (..),
    rangeFromList,
    getDecisionFreqRange,
    holdingRangeToShapedRange,
    addHoleToShapedRange,
  )
where

import Data.Bool (bool)
import Data.Map (Map)
import qualified Data.Map.Strict as Map
#if MIN_VERSION_prettyprinter(1,7,0)
import Prettyprinter
#else
import Data.Text.Prettyprint.Doc
#endif
import Poker.Cards

-- $setup
-- >>> :set -XTypeApplications
-- >>> :set -XOverloadedStrings
-- >>> import Poker.Cards
-- >>> import Poker.Range

-- | A frequency is an unevaluated ratio that indicates how often a decision was
-- made. For example, the value Freq (12, 34) indicates that out of the 34
-- people who faced this decision, 12 chose to make this decision.
data Freq = Freq !Int !Int
  deriving (Int -> Freq -> ShowS
[Freq] -> ShowS
Freq -> String
(Int -> Freq -> ShowS)
-> (Freq -> String) -> ([Freq] -> ShowS) -> Show Freq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Freq] -> ShowS
$cshowList :: [Freq] -> ShowS
show :: Freq -> String
$cshow :: Freq -> String
showsPrec :: Int -> Freq -> ShowS
$cshowsPrec :: Int -> Freq -> ShowS
Show, Freq -> Freq -> Bool
(Freq -> Freq -> Bool) -> (Freq -> Freq -> Bool) -> Eq Freq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Freq -> Freq -> Bool
$c/= :: Freq -> Freq -> Bool
== :: Freq -> Freq -> Bool
$c== :: Freq -> Freq -> Bool
Eq)

instance Monoid Freq where
  mempty :: Freq
mempty = Int -> Int -> Freq
Freq Int
0 Int
0

instance Semigroup Freq where
  (Freq Int
l1 Int
r1) <> :: Freq -> Freq -> Freq
<> (Freq Int
l2 Int
r2) = Int -> Int -> Freq
Freq (Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l2) (Int
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r2)

-- | A simple wrapper around a 'Map' that uses different instances
-- for Semigroup. 'Range'\'s 'Semigroup' instance combines values at the same keys with '<>'
-- (unlike the 'Map' 'Semigroup' instance from @containers@).
--
-- Note that the 'Range'\'s internal 'Map' is strict.
newtype Range a b = Range
  {Range a b -> Map a b
_range :: Map a b}
  deriving (ReadPrec [Range a b]
ReadPrec (Range a b)
Int -> ReadS (Range a b)
ReadS [Range a b]
(Int -> ReadS (Range a b))
-> ReadS [Range a b]
-> ReadPrec (Range a b)
-> ReadPrec [Range a b]
-> Read (Range a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Ord a, Read a, Read b) => ReadPrec [Range a b]
forall a b. (Ord a, Read a, Read b) => ReadPrec (Range a b)
forall a b. (Ord a, Read a, Read b) => Int -> ReadS (Range a b)
forall a b. (Ord a, Read a, Read b) => ReadS [Range a b]
readListPrec :: ReadPrec [Range a b]
$creadListPrec :: forall a b. (Ord a, Read a, Read b) => ReadPrec [Range a b]
readPrec :: ReadPrec (Range a b)
$creadPrec :: forall a b. (Ord a, Read a, Read b) => ReadPrec (Range a b)
readList :: ReadS [Range a b]
$creadList :: forall a b. (Ord a, Read a, Read b) => ReadS [Range a b]
readsPrec :: Int -> ReadS (Range a b)
$creadsPrec :: forall a b. (Ord a, Read a, Read b) => Int -> ReadS (Range a b)
Read, Range a b -> Range a b -> Bool
(Range a b -> Range a b -> Bool)
-> (Range a b -> Range a b -> Bool) -> Eq (Range a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Range a b -> Range a b -> Bool
/= :: Range a b -> Range a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Range a b -> Range a b -> Bool
== :: Range a b -> Range a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Range a b -> Range a b -> Bool
Eq, Int -> Range a b -> ShowS
[Range a b] -> ShowS
Range a b -> String
(Int -> Range a b -> ShowS)
-> (Range a b -> String)
-> ([Range a b] -> ShowS)
-> Show (Range a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Range a b -> ShowS
forall a b. (Show a, Show b) => [Range a b] -> ShowS
forall a b. (Show a, Show b) => Range a b -> String
showList :: [Range a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Range a b] -> ShowS
show :: Range a b -> String
$cshow :: forall a b. (Show a, Show b) => Range a b -> String
showsPrec :: Int -> Range a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Range a b -> ShowS
Show)

-- | Make a Range form a list.
rangeFromList :: Ord a => [(a, b)] -> Range a b
rangeFromList :: [(a, b)] -> Range a b
rangeFromList = Map a b -> Range a b
forall a b. Map a b -> Range a b
Range (Map a b -> Range a b)
-> ([(a, b)] -> Map a b) -> [(a, b)] -> Range a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> Map a b
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

-- | >>> mempty @(Range Hole Freq)
-- Range {_range = fromList []}
instance (Ord a, Monoid b) => Monoid (Range a b) where
  mempty :: Range a b
mempty = Map a b -> Range a b
forall a b. Map a b -> Range a b
Range Map a b
forall k a. Map k a
Map.empty

-- |
-- >>> let left = rangeFromList [("55p" :: ShapedHole, Freq 1 3)]
-- >>> let right = rangeFromList [("55p", Freq 10 32)]
-- >>> left <> right
-- Range {_range = fromList [(Pair Five,Freq 11 35)]}
instance (Ord a, Monoid b) => Semigroup (Range a b) where
  Range Map a b
x <> :: Range a b -> Range a b -> Range a b
<> Range Map a b
y = Map a b -> Range a b
forall a b. Map a b -> Range a b
Range (Map a b -> Range a b) -> Map a b -> Range a b
forall a b. (a -> b) -> a -> b
$ Map a b
x Map a b -> Map a b -> Map a b
`uniRange` Map a b
y
    where
      uniRange :: Map a b -> Map a b -> Map a b
uniRange = (b -> b -> b) -> Map a b -> Map a b -> Map a b
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith b -> b -> b
forall a. Semigroup a => a -> a -> a
(<>)

instance (Pretty a, Pretty b) => Pretty (Range a b) where
  pretty :: Range a b -> Doc ann
pretty Range a b
ran =
    let m :: [(a, b)]
m = Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map a b -> [(a, b)]) -> Map a b -> [(a, b)]
forall a b. (a -> b) -> a -> b
$ Range a b -> Map a b
forall a b. Range a b -> Map a b
_range Range a b
ran
        prettyValues :: Doc ann
prettyValues =
          (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith (Doc ann -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
surround Doc ann
forall ann. Doc ann
comma) ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
            ((a, b) -> Doc ann) -> [(a, b)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
c, b
i) -> a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
c Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> b -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty b
i) [(a, b)]
m
     in Doc ann
forall ann. Doc ann
lbrace Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
prettyValues Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
rbrace

-- | Converts a 'Range' from key to action, to a 'Range' from key to decision
-- frequency, given a predicate that returns 'True' if the action matched the
-- decision.
getDecisionFreqRange ::
  Foldable f => (b -> Bool) -> Range a (f b) -> Range a Freq
getDecisionFreqRange :: (b -> Bool) -> Range a (f b) -> Range a Freq
getDecisionFreqRange b -> Bool
p (Range Map a (f b)
m) =
  Map a Freq -> Range a Freq
forall a b. Map a b -> Range a b
Range (Map a Freq -> Range a Freq) -> Map a Freq -> Range a Freq
forall a b. (a -> b) -> a -> b
$ (f b -> Freq) -> Map a (f b) -> Map a Freq
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((b -> Freq) -> f b -> Freq
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\b
v -> Int -> Int -> Freq
Freq (Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
0 Int
1 (Bool -> Int) -> Bool -> Int
forall a b. (a -> b) -> a -> b
$ b -> Bool
p b
v) Int
1)) Map a (f b)
m

-- | Convert from a 'Range' of hole cards to a 'Range' of 'ShapedHole'.
holdingRangeToShapedRange :: Monoid v => Range Hole v -> Range ShapedHole v
holdingRangeToShapedRange :: Range Hole v -> Range ShapedHole v
holdingRangeToShapedRange (Range Map Hole v
r) =
  Map ShapedHole v -> Range ShapedHole v
forall a b. Map a b -> Range a b
Range (Map ShapedHole v -> Range ShapedHole v)
-> Map ShapedHole v -> Range ShapedHole v
forall a b. (a -> b) -> a -> b
$ (v -> v -> v)
-> (Hole -> ShapedHole) -> Map Hole v -> Map ShapedHole v
forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith v -> v -> v
forall a. Semigroup a => a -> a -> a
(<>) Hole -> ShapedHole
holeToShapedHole Map Hole v
r

-- | Add a singleton 'Hole' hand to a 'Range' of 'ShapedHole'.
addHoleToShapedRange :: Num a => a -> Hole -> Range ShapedHole a -> Range ShapedHole a
addHoleToShapedRange :: a -> Hole -> Range ShapedHole a -> Range ShapedHole a
addHoleToShapedRange a
n Hole
comb (Range Map ShapedHole a
r) =
  Map ShapedHole a -> Range ShapedHole a
forall a b. Map a b -> Range a b
Range (Map ShapedHole a -> Range ShapedHole a)
-> Map ShapedHole a -> Range ShapedHole a
forall a b. (a -> b) -> a -> b
$ (Maybe a -> Maybe a)
-> ShapedHole -> Map ShapedHole a -> Map ShapedHole a
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a) -> (Maybe a -> a) -> Maybe a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
0 (a -> a -> a
forall a. Num a => a -> a -> a
+ a
n)) (Hole -> ShapedHole
holeToShapedHole Hole
comb) Map ShapedHole a
r