{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
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
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)
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)
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
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
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
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
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
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