module Poker.Holdem.Simulate
(
Player(..)
, Game(..)
, simulate
) where
import Data.Random (RVar, RandomSource, runRVar)
import Control.Monad.State
import Data.List (transpose)
import Data.Random.Source.DevRandom (DevRandom (DevRandom))
import Poker.Deck
import qualified Poker.Deck as Deck (shuffle)
import Poker.Holdem
import Poker.Holdem.Evaluate (HandRank, evaluate)
data Player = Player
{
Player -> Maybe Card
card1 :: Maybe Card
, Player -> Maybe Card
card2 :: Maybe Card
}
data Game = Game
{
Game -> [Player]
players :: [Player]
, Game -> Maybe Flop
flop :: Maybe Flop
, Game -> Maybe Turn
turn :: Maybe Turn
, Game -> Maybe Street
street :: Maybe Street
}
simulate :: (RandomSource m DevRandom) =>
Int
-> Game
-> m [Double]
simulate :: Int -> Game -> m [Double]
simulate Int
n Game
game = do
[[Double]]
gameHands <- Int -> m [Double] -> m [[Double]]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (m [Double] -> m [[Double]]) -> m [Double] -> m [[Double]]
forall a b. (a -> b) -> a -> b
$ Game -> m [Double]
forall (m :: * -> *).
RandomSource m DevRandom =>
Game -> m [Double]
simulateWinners Game
game
[Double] -> m [Double]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Double] -> m [Double]) -> [Double] -> m [Double]
forall a b. (a -> b) -> a -> b
$ ([Double] -> Double) -> [[Double]] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ((Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Double -> Double) -> ([Double] -> Double) -> [Double] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum) ([[Double]] -> [[Double]]
forall a. [[a]] -> [[a]]
transpose [[Double]]
gameHands)
dealtCards :: Game -> [Card]
dealtCards :: Game -> [Card]
dealtCards Game{[Player]
Maybe Street
Maybe Turn
Maybe Flop
street :: Maybe Street
turn :: Maybe Turn
flop :: Maybe Flop
players :: [Player]
street :: Game -> Maybe Street
turn :: Game -> Maybe Turn
flop :: Game -> Maybe Flop
players :: Game -> [Player]
..} = let playerCards :: [Card]
playerCards = (Player -> [Card]) -> [Player] -> [Card]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Player -> [Card]
dealtHands [Player]
players
dealtHands :: Player -> [Card]
dealtHands (Player Maybe Card
Nothing Maybe Card
Nothing) = []
dealtHands (Player (Just Card
c1) Maybe Card
Nothing) = [Card
c1]
dealtHands (Player Maybe Card
Nothing (Just Card
c2)) = [Card
c2]
dealtHands (Player (Just Card
c1) (Just Card
c2)) = [Card
c1, Card
c2]
flopCards :: [Card]
flopCards = case Maybe Flop
flop of
(Just (Flop Card
c1 Card
c2 Card
c3)) -> [Card
c1, Card
c2, Card
c3]
Maybe Flop
_ -> []
turnCard :: [Card]
turnCard = case Maybe Turn
turn of
(Just (Turn Card
c)) -> [Card
c]
Maybe Turn
_ -> []
streetCard :: [Card]
streetCard = case Maybe Street
street of
(Just (Street Card
c)) -> [Card
c]
Maybe Street
_ -> []
in [Card]
playerCards [Card] -> [Card] -> [Card]
forall a. [a] -> [a] -> [a]
++ [Card]
flopCards [Card] -> [Card] -> [Card]
forall a. [a] -> [a] -> [a]
++ [Card]
turnCard [Card] -> [Card] -> [Card]
forall a. [a] -> [a] -> [a]
++ [Card]
streetCard
completeHands :: Game -> StateT Deck Maybe [[Card]]
completeHands :: Game -> StateT Deck Maybe [[Card]]
completeHands Game{[Player]
Maybe Street
Maybe Turn
Maybe Flop
street :: Maybe Street
turn :: Maybe Turn
flop :: Maybe Flop
players :: [Player]
street :: Game -> Maybe Street
turn :: Game -> Maybe Turn
flop :: Game -> Maybe Flop
players :: Game -> [Player]
..} = do
[Hole]
playersCards <- (Player -> StateT Deck Maybe Hole)
-> [Player] -> StateT Deck Maybe [Hole]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Player -> StateT Deck Maybe Hole
getPlayersCards [Player]
players
(Community (Flop Card
c3 Card
c4 Card
c5) (Turn Card
c6) (Street Card
c7)) <- Maybe Flop
-> Maybe Turn -> Maybe Street -> StateT Deck Maybe Community
getCommunityCards Maybe Flop
flop Maybe Turn
turn Maybe Street
street
[[Card]] -> StateT Deck Maybe [[Card]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Card
c1, Card
c2, Card
c3, Card
c4, Card
c5, Card
c6, Card
c7] | (Hole Card
c1 Card
c2) <- [Hole]
playersCards]
getPlayersCards :: Player -> StateT Deck Maybe Hole
getPlayersCards :: Player -> StateT Deck Maybe Hole
getPlayersCards Player
player = do
Deck
deck <- StateT Deck Maybe Deck
forall s (m :: * -> *). MonadState s m => m s
get
([Card]
cards, Deck
deck') <- Maybe ([Card], Deck) -> StateT Deck Maybe ([Card], Deck)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Maybe ([Card], Deck) -> StateT Deck Maybe ([Card], Deck))
-> Maybe ([Card], Deck) -> StateT Deck Maybe ([Card], Deck)
forall a b. (a -> b) -> a -> b
$ Int -> Deck -> Maybe ([Card], Deck)
draw1 (Player -> Int
forall p. Num p => Player -> p
neededCards Player
player) Deck
deck
Deck -> StateT Deck Maybe ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Deck
deck'
Hole -> StateT Deck Maybe Hole
forall (m :: * -> *) a. Monad m => a -> m a
return (Player -> [Card] -> Hole
hole Player
player [Card]
cards)
where neededCards :: Player -> p
neededCards (Player Maybe Card
Nothing Maybe Card
Nothing) = p
2
neededCards (Player (Just Card
_) Maybe Card
Nothing) = p
1
neededCards (Player Maybe Card
Nothing (Just Card
_)) = p
1
neededCards (Player (Just Card
_) (Just Card
_)) = p
0
hole :: Player -> [Card] -> Hole
hole (Player (Just Card
c1) (Just Card
c2)) [] = Card -> Card -> Hole
Hole Card
c1 Card
c2
hole (Player (Just Card
c1) Maybe Card
Nothing) [Card
c2] = Card -> Card -> Hole
Hole Card
c1 Card
c2
hole (Player Maybe Card
Nothing (Just Card
c2)) [Card
c1] = Card -> Card -> Hole
Hole Card
c1 Card
c2
hole (Player Maybe Card
Nothing Maybe Card
Nothing) [Card
c1, Card
c2] = Card -> Card -> Hole
Hole Card
c1 Card
c2
hole Player
_ [Card]
_ = Hole
forall a. HasCallStack => a
undefined
getCommunityCards :: Maybe Flop -> Maybe Turn -> Maybe Street -> StateT Deck Maybe Community
Maybe Flop
Nothing Maybe Turn
_ Maybe Street
_ = do
Deck
deck <- StateT Deck Maybe Deck
forall s (m :: * -> *). MonadState s m => m s
get
([Card
c1, Card
c2, Card
c3, Card
c4, Card
c5], Deck
deck') <- Maybe ([Card], Deck) -> StateT Deck Maybe ([Card], Deck)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Maybe ([Card], Deck) -> StateT Deck Maybe ([Card], Deck))
-> Maybe ([Card], Deck) -> StateT Deck Maybe ([Card], Deck)
forall a b. (a -> b) -> a -> b
$ Int -> Deck -> Maybe ([Card], Deck)
draw1 Int
5 Deck
deck
Deck -> StateT Deck Maybe ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Deck
deck'
Community -> StateT Deck Maybe Community
forall (m :: * -> *) a. Monad m => a -> m a
return (Flop -> Turn -> Street -> Community
Community (Card -> Card -> Card -> Flop
Flop Card
c1 Card
c2 Card
c3) (Card -> Turn
Turn Card
c4) (Card -> Street
Street Card
c5))
getCommunityCards (Just (Flop Card
c1 Card
c2 Card
c3)) Maybe Turn
Nothing Maybe Street
_ = do
Deck
deck <- StateT Deck Maybe Deck
forall s (m :: * -> *). MonadState s m => m s
get
([Card
c4, Card
c5], Deck
deck') <- Maybe ([Card], Deck) -> StateT Deck Maybe ([Card], Deck)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Maybe ([Card], Deck) -> StateT Deck Maybe ([Card], Deck))
-> Maybe ([Card], Deck) -> StateT Deck Maybe ([Card], Deck)
forall a b. (a -> b) -> a -> b
$ Int -> Deck -> Maybe ([Card], Deck)
draw1 Int
2 Deck
deck
Deck -> StateT Deck Maybe ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Deck
deck'
Community -> StateT Deck Maybe Community
forall (m :: * -> *) a. Monad m => a -> m a
return (Flop -> Turn -> Street -> Community
Community (Card -> Card -> Card -> Flop
Flop Card
c1 Card
c2 Card
c3) (Card -> Turn
Turn Card
c4) (Card -> Street
Street Card
c5))
getCommunityCards (Just (Flop Card
c1 Card
c2 Card
c3)) (Just(Turn Card
c4)) Maybe Street
Nothing = do
Deck
deck <- StateT Deck Maybe Deck
forall s (m :: * -> *). MonadState s m => m s
get
([Card
c5], Deck
deck') <- Maybe ([Card], Deck) -> StateT Deck Maybe ([Card], Deck)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Maybe ([Card], Deck) -> StateT Deck Maybe ([Card], Deck))
-> Maybe ([Card], Deck) -> StateT Deck Maybe ([Card], Deck)
forall a b. (a -> b) -> a -> b
$ Int -> Deck -> Maybe ([Card], Deck)
draw1 Int
1 Deck
deck
Deck -> StateT Deck Maybe ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Deck
deck'
Community -> StateT Deck Maybe Community
forall (m :: * -> *) a. Monad m => a -> m a
return (Flop -> Turn -> Street -> Community
Community (Card -> Card -> Card -> Flop
Flop Card
c1 Card
c2 Card
c3) (Card -> Turn
Turn Card
c4) (Card -> Street
Street Card
c5))
getCommunityCards (Just (Flop Card
c1 Card
c2 Card
c3)) (Just(Turn Card
c4)) (Just (Street Card
c5)) = do
Community -> StateT Deck Maybe Community
forall (m :: * -> *) a. Monad m => a -> m a
return (Flop -> Turn -> Street -> Community
Community (Card -> Card -> Card -> Flop
Flop Card
c1 Card
c2 Card
c3) (Card -> Turn
Turn Card
c4) (Card -> Street
Street Card
c5))
playerHands :: Game -> RVar [[Card]]
playerHands :: Game -> RVar [[Card]]
playerHands Game
game = do
Deck
deck <- Deck -> RVar Deck
Deck.shuffle (Game -> Deck
gameDeck Game
game)
case StateT Deck Maybe [[Card]] -> Deck -> Maybe [[Card]]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Game -> StateT Deck Maybe [[Card]]
completeHands Game
game) Deck
deck of
(Just [[Card]]
cards) -> [[Card]] -> RVar [[Card]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Card]]
cards
Maybe [[Card]]
_ -> [[Card]] -> RVar [[Card]]
forall (m :: * -> *) a. Monad m => a -> m a
return []
gameDeck :: Game -> Deck
gameDeck :: Game -> Deck
gameDeck Game
game = [Card] -> Deck -> Deck
remove (Game -> [Card]
dealtCards Game
game) Deck
stdDeck
winners :: [HandRank] -> [Bool]
winners :: [HandRank] -> [Bool]
winners [HandRank]
scores = (HandRank -> Bool) -> [HandRank] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (HandRank -> HandRank -> Bool
forall a. Eq a => a -> a -> Bool
== HandRank
minRank) [HandRank]
scores where
minRank :: HandRank
minRank = [HandRank] -> HandRank
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [HandRank]
scores
averageScore :: [Bool] -> [Double]
averageScore :: [Bool] -> [Double]
averageScore [Bool]
winnerList = (Bool -> Double) -> [Bool] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\Bool
x -> if Bool
x then Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numWinners else Double
0) [Bool]
winnerList where
numWinners :: Int
numWinners = [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) [Bool]
winnerList)
simulateOne :: (RandomSource m DevRandom) => Game -> m [([Card], HandRank)]
simulateOne :: Game -> m [([Card], HandRank)]
simulateOne Game
game = do
[[Card]]
cards <- RVar [[Card]] -> DevRandom -> m [[Card]]
forall (m :: * -> *) s a. RandomSource m s => RVar a -> s -> m a
runRVar (Game -> RVar [[Card]]
playerHands Game
game) DevRandom
DevRandom
let scores :: [HandRank]
scores = ([Card] -> HandRank) -> [[Card]] -> [HandRank]
forall a b. (a -> b) -> [a] -> [b]
map [Card] -> HandRank
evaluate' [[Card]]
cards
[([Card], HandRank)] -> m [([Card], HandRank)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([([Card], HandRank)] -> m [([Card], HandRank)])
-> [([Card], HandRank)] -> m [([Card], HandRank)]
forall a b. (a -> b) -> a -> b
$ [[Card]] -> [HandRank] -> [([Card], HandRank)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Card]]
cards [HandRank]
scores
where evaluate' :: [Card] -> HandRank
evaluate' [Card
c1, Card
c2, Card
c3, Card
c4, Card
c5, Card
c6, 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]
_ = HandRank
forall a. HasCallStack => a
undefined
simulateWinners :: (RandomSource m DevRandom) => Game -> m [Double]
simulateWinners :: Game -> m [Double]
simulateWinners Game
game = do
[HandRank]
scores <- (([Card], HandRank) -> HandRank)
-> [([Card], HandRank)] -> [HandRank]
forall a b. (a -> b) -> [a] -> [b]
map ([Card], HandRank) -> HandRank
forall a b. (a, b) -> b
snd ([([Card], HandRank)] -> [HandRank])
-> m [([Card], HandRank)] -> m [HandRank]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Game -> m [([Card], HandRank)]
forall (m :: * -> *).
RandomSource m DevRandom =>
Game -> m [([Card], HandRank)]
simulateOne Game
game
let gameWinners :: [Bool]
gameWinners = [HandRank] -> [Bool]
winners [HandRank]
scores
[Double] -> m [Double]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Double] -> m [Double]) -> [Double] -> m [Double]
forall a b. (a -> b) -> a -> b
$ [Bool] -> [Double]
averageScore [Bool]
gameWinners