{-# LANGUAGE DerivingVia #-}
module Poker.Holdem.Evaluate
(
HandRank(..)
, evaluate
, evaluateHand
)
where
import Data.Array.Base (unsafeAccumArray, unsafeAt)
import qualified Data.Array.Unboxed as Array
import Data.Bits (shift, (.&.), (.|.))
import Data.Ord
import Poker.Deck
import Poker.Holdem
import qualified Poker.Holdem.Table.DP as Holdem
import qualified Poker.Holdem.Table.Flush as Holdem
import qualified Poker.Holdem.Table.NoFlush as Holdem
import qualified Poker.Holdem.Table.Suit as Holdem
newtype HandRank = HandRank Int deriving newtype (HandRank -> HandRank -> Bool
(HandRank -> HandRank -> Bool)
-> (HandRank -> HandRank -> Bool) -> Eq HandRank
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HandRank -> HandRank -> Bool
$c/= :: HandRank -> HandRank -> Bool
== :: HandRank -> HandRank -> Bool
$c== :: HandRank -> HandRank -> Bool
Eq, Int -> HandRank -> ShowS
[HandRank] -> ShowS
HandRank -> String
(Int -> HandRank -> ShowS)
-> (HandRank -> String) -> ([HandRank] -> ShowS) -> Show HandRank
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HandRank] -> ShowS
$cshowList :: [HandRank] -> ShowS
show :: HandRank -> String
$cshow :: HandRank -> String
showsPrec :: Int -> HandRank -> ShowS
$cshowsPrec :: Int -> HandRank -> ShowS
Show, ReadPrec [HandRank]
ReadPrec HandRank
Int -> ReadS HandRank
ReadS [HandRank]
(Int -> ReadS HandRank)
-> ReadS [HandRank]
-> ReadPrec HandRank
-> ReadPrec [HandRank]
-> Read HandRank
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HandRank]
$creadListPrec :: ReadPrec [HandRank]
readPrec :: ReadPrec HandRank
$creadPrec :: ReadPrec HandRank
readList :: ReadS [HandRank]
$creadList :: ReadS [HandRank]
readsPrec :: Int -> ReadS HandRank
$creadsPrec :: Int -> ReadS HandRank
Read)
deriving newtype (Integer -> HandRank
HandRank -> HandRank
HandRank -> HandRank -> HandRank
(HandRank -> HandRank -> HandRank)
-> (HandRank -> HandRank -> HandRank)
-> (HandRank -> HandRank -> HandRank)
-> (HandRank -> HandRank)
-> (HandRank -> HandRank)
-> (HandRank -> HandRank)
-> (Integer -> HandRank)
-> Num HandRank
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> HandRank
$cfromInteger :: Integer -> HandRank
signum :: HandRank -> HandRank
$csignum :: HandRank -> HandRank
abs :: HandRank -> HandRank
$cabs :: HandRank -> HandRank
negate :: HandRank -> HandRank
$cnegate :: HandRank -> HandRank
* :: HandRank -> HandRank -> HandRank
$c* :: HandRank -> HandRank -> HandRank
- :: HandRank -> HandRank -> HandRank
$c- :: HandRank -> HandRank -> HandRank
+ :: HandRank -> HandRank -> HandRank
$c+ :: HandRank -> HandRank -> HandRank
Num)
deriving Eq HandRank
Eq HandRank
-> (HandRank -> HandRank -> Ordering)
-> (HandRank -> HandRank -> Bool)
-> (HandRank -> HandRank -> Bool)
-> (HandRank -> HandRank -> Bool)
-> (HandRank -> HandRank -> Bool)
-> (HandRank -> HandRank -> HandRank)
-> (HandRank -> HandRank -> HandRank)
-> Ord HandRank
HandRank -> HandRank -> Bool
HandRank -> HandRank -> Ordering
HandRank -> HandRank -> HandRank
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HandRank -> HandRank -> HandRank
$cmin :: HandRank -> HandRank -> HandRank
max :: HandRank -> HandRank -> HandRank
$cmax :: HandRank -> HandRank -> HandRank
>= :: HandRank -> HandRank -> Bool
$c>= :: HandRank -> HandRank -> Bool
> :: HandRank -> HandRank -> Bool
$c> :: HandRank -> HandRank -> Bool
<= :: HandRank -> HandRank -> Bool
$c<= :: HandRank -> HandRank -> Bool
< :: HandRank -> HandRank -> Bool
$c< :: HandRank -> HandRank -> Bool
compare :: HandRank -> HandRank -> Ordering
$ccompare :: HandRank -> HandRank -> Ordering
$cp1Ord :: Eq HandRank
Ord via (Down Int)
evaluateHand :: Hand -> HandRank
evaluateHand :: Hand -> HandRank
evaluateHand (Hand (Hole Card
c1 Card
c2) (Community (Flop Card
c3 Card
c4 Card
c5) (Turn Card
c6) (Street Card
c7))) =
Card -> Card -> Card -> Card -> Card -> Card -> Card -> HandRank
evaluate Card
c1 Card
c2 Card
c3 Card
c4 Card
c5 Card
c6 Card
c7
evaluate ::
Card
-> Card
-> Card
-> Card
-> Card
-> Card
-> Card
-> HandRank
evaluate :: Card -> Card -> Card -> Card -> Card -> Card -> Card -> HandRank
evaluate (Card Int
c1) (Card Int
c2) (Card Int
c3) (Card Int
c4) (Card Int
c5) (Card Int
c6) (Card Int
c7) =
if Int -> Int
Holdem.suitsLookup Int
hash Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then
Int -> HandRank
HandRank (Int -> HandRank) -> Int -> HandRank
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int
handleFlush Int
c1 Int
c2 Int
c3 Int
c4 Int
c5 Int
c6 Int
c7 Int
hash
else
Int -> HandRank
HandRank (Int -> HandRank) -> Int -> HandRank
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int
handleNonFlush Int
c1 Int
c2 Int
c3 Int
c4 Int
c5 Int
c6 Int
c7
where
hash :: Int
hash = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int
suitHash Int
c1 Int
c2 Int
c3 Int
c4 Int
c5 Int
c6 Int
c7
suitHash :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int
suitHash :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int
suitHash Int
c1 Int
c2 Int
c3 Int
c4 Int
c5 Int
c6 Int
c7 =
let b1 :: Int
b1 = UArray Int Int
suitBit UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
c1
b2 :: Int
b2 = UArray Int Int
suitBit UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
c2
b3 :: Int
b3 = UArray Int Int
suitBit UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
c3
b4 :: Int
b4 = UArray Int Int
suitBit UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
c4
b5 :: Int
b5 = UArray Int Int
suitBit UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
c5
b6 :: Int
b6 = UArray Int Int
suitBit UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
c6
b7 :: Int
b7 = UArray Int Int
suitBit UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
c7
in Int
b1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b6 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b7
hashQuinary :: Array.UArray Int Int -> Int
hashQuinary :: UArray Int Int -> Int
hashQuinary UArray Int Int
q = Int -> Int -> Int -> Int
go Int
7 Int
0 Int
0
where
go :: Int -> Int -> Int -> Int
go Int
k Int
i Int
s
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
13 = Int
s
| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Int
s
| Bool
otherwise =
let sum' :: Int
sum' = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ UArray Int Int -> Int -> Int -> Int
Holdem.dpLookup UArray Int Int
q Int
i Int
k
k' :: Int
k' = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- (UArray Int Int
q UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
i)
i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in Int -> Int -> Int -> Int
go Int
k' Int
i' Int
sum'
handleFlush :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int
handleFlush :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int
handleFlush Int
c1 Int
c2 Int
c3 Int
c4 Int
c5 Int
c6 Int
c7 Int
hash =
let
suitBinary :: Array.UArray Int Int
suitBinary :: UArray Int Int
suitBinary = (Int -> Int -> Int)
-> Int -> (Int, Int) -> [(Int, Int)] -> UArray Int Int
forall (a :: * -> * -> *) e i e'.
(IArray a e, Ix i) =>
(e -> e' -> e) -> e -> (i, i) -> [(Int, e')] -> a i e
unsafeAccumArray Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.|.) Int
0 (Int
0, Int
3) [
(Int
c1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3, UArray Int Int
rankBit UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
c1),
(Int
c2 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3, UArray Int Int
rankBit UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
c2),
(Int
c3 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3, UArray Int Int
rankBit UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
c3),
(Int
c4 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3, UArray Int Int
rankBit UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
c4),
(Int
c5 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3, UArray Int Int
rankBit UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
c5),
(Int
c6 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3, UArray Int Int
rankBit UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
c6),
(Int
c7 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3, UArray Int Int
rankBit UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
c7)]
idx :: Int
idx = UArray Int Int
suitBinary UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` (Int -> Int
Holdem.suitsLookup Int
hash Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
in Int -> Int
Holdem.flushLookup Int
idx
handleNonFlush :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int
handleNonFlush :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int
handleNonFlush Int
c1 Int
c2 Int
c3 Int
c4 Int
c5 Int
c6 Int
c7 =
let
idxs :: [(Int, Int)]
idxs :: [(Int, Int)]
idxs = [ (Int
c1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` (-Int
2), Int
1),
(Int
c2 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` (-Int
2), Int
1),
(Int
c3 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` (-Int
2), Int
1),
(Int
c4 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` (-Int
2), Int
1),
(Int
c5 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` (-Int
2), Int
1),
(Int
c6 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` (-Int
2), Int
1),
(Int
c7 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` (-Int
2), Int
1)
]
quinary :: Array.UArray Int Int
quinary :: UArray Int Int
quinary = (Int -> Int -> Int)
-> Int -> (Int, Int) -> [(Int, Int)] -> UArray Int Int
forall (a :: * -> * -> *) e i e'.
(IArray a e, Ix i) =>
(e -> e' -> e) -> e -> (i, i) -> [(Int, e')] -> a i e
unsafeAccumArray Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 (Int
0, Int
12) [(Int, Int)]
idxs
hash :: Int
hash = UArray Int Int -> Int
hashQuinary UArray Int Int
quinary
in Int -> Int
Holdem.noFlushLookup Int
hash
rankBit :: Array.UArray Int Int
rankBit :: UArray Int Int
rankBit = (Int, Int) -> [Int] -> UArray Int Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
Array.listArray (Int
0, Int
51)
[ Int
0x1, Int
0x1, Int
0x1, Int
0x1,
Int
0x2, Int
0x2, Int
0x2, Int
0x2,
Int
0x4, Int
0x4, Int
0x4, Int
0x4,
Int
0x8, Int
0x8, Int
0x8, Int
0x8,
Int
0x10, Int
0x10, Int
0x10, Int
0x10,
Int
0x20, Int
0x20, Int
0x20, Int
0x20,
Int
0x40, Int
0x40, Int
0x40, Int
0x40,
Int
0x80, Int
0x80, Int
0x80, Int
0x80,
Int
0x100, Int
0x100, Int
0x100, Int
0x100,
Int
0x200, Int
0x200, Int
0x200, Int
0x200,
Int
0x400, Int
0x400, Int
0x400, Int
0x400,
Int
0x800, Int
0x800, Int
0x800, Int
0x800,
Int
0x1000, Int
0x1000, Int
0x1000, Int
0x1000
]
suitBit :: Array.UArray Int Int
suitBit :: UArray Int Int
suitBit =
(Int, Int) -> [Int] -> UArray Int Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
Array.listArray (Int
0,Int
51)
[ Int
0x1, Int
0x8, Int
0x40, Int
0x200,
Int
0x1, Int
0x8, Int
0x40, Int
0x200,
Int
0x1, Int
0x8, Int
0x40, Int
0x200,
Int
0x1, Int
0x8, Int
0x40, Int
0x200,
Int
0x1, Int
0x8, Int
0x40, Int
0x200,
Int
0x1, Int
0x8, Int
0x40, Int
0x200,
Int
0x1, Int
0x8, Int
0x40, Int
0x200,
Int
0x1, Int
0x8, Int
0x40, Int
0x200,
Int
0x1, Int
0x8, Int
0x40, Int
0x200,
Int
0x1, Int
0x8, Int
0x40, Int
0x200,
Int
0x1, Int
0x8, Int
0x40, Int
0x200,
Int
0x1, Int
0x8, Int
0x40, Int
0x200,
Int
0x1, Int
0x8, Int
0x40, Int
0x200
]