A Haskell poker library experimenting with speed, static analysis & strategy.
The library is in an active development phase, nothing is guaranteed to stay in place, and there is no centralised API.
One way to approach the library and appreciate the state of development is to have a good look around this org file. All the code is runnable in an emacs environment (and you can always cut and paste the code to elsewhere if this doesn’t suit).
There are also doctests everywhere so it’s relatively easy to find your way.
:r
:set prompt " > "
:set -Wno-type-defaults
:set -Wno-name-shadowing
:set -XOverloadedStrings
import Poker.Card
import Poker.Card.Storable
import Poker.HandRank
import Poker.Range
import Poker.Random
import Poker.Lexico
import Poker.Charts
import Chart hiding (Range)
import Data.FormatN
import Optics.Core
import Prettyprinter
import qualified Data.Text as Text
import qualified Data.Map.Strict as Map
import qualified Data.Vector.Storable as S
import Data.Functor.Rep
putStrLn "ok"Ok, 8 modules loaded. ok
Poker.Cards contain the basic and human-friendly Poker types, and Poker.Cards.Storable the newtyped-wrapped, efficiently-stored versions. There are optics-core iso’s to help convert between the two versions, and prettyprinter is used to render it all nicely when you need to see results.
import Poker.Card
import Poker.Card.Storable
import Optics.Core
import Prettyprinter
cs' = [Card Ace Hearts,Card Seven Spades,Card Ten Hearts,Card Five Spades,Card Six Clubs, Card Seven Hearts,Card Six Spades]
cs = review cardsI cs'
cs
pretty csRoutines for evaluation of a hand - 7 cards consisting of 2 player cards and 5 community cards - can be found in Poker.HandRank.
import Poker.HandRank
handRank cs
pretty (handRank cs)It is much faster to look up hand rankings then recompute them every time, so a big Data.Vector.Storable is used to hold the indexed results.
To install the vector:
cabal install --force
poker-fold-writes --hvs7… and to use it …
s <- hvs7
lookupHRUnsorted s cs
pretty $ lexiToHR (lookupHRUnsorted s cs)
pretty $ allHandRanks !! 4301The hand rankings are held in reverse lexicographical position order using Knuth’s revolving door R algorithm which makes it just a little bit fancy. From Poker.Lexico:
cs & unwrapCardsS & sort & toLexiPosR 52 7 :: Int
pretty $ lexiToHR $ s S.! 32513187I suspect that the algorithm is a hyperfunction…
-- | Given a reverse lexicographic position, what was the combination?
--
-- >>> (\xs -> xs == fmap (fromLexiPosR 5 2 . toLexiPosR 5 2) xs) (combinations 2 [0..4])
-- True
--
fromLexiPosR :: Int -> Int -> Int -> [Int]
fromLexiPosR n k p = go (n - 1) k ((binom n k - 1) - p) []
where
go n' k' p' xs =
bool
( bool
(go (n' - 1) k' p' xs)
(go (n' - 1) (k' - 1) (p' - binom n' k') (n' : xs))
(p' >= binom n' k')
)
xs
(length xs == k)A major thematic of the library is that poker strategy is well encapsulated by a 13 by 13 grid representation of a starting hand.
Poker.Range contains the core types for this encapsulation. Under the hood of Range is a numhask-array array which has a nice representable functor instance from adjunctions. Using tabulate can be confusing at first, but it tends to lead to quite simple code pipelines.
import Control.Category ((>>>))
import Prettyprinter.Render.Text (renderStrict)
pretty $ (tabulate (pretty >>> layoutCompact >>> renderStrict) :: Range Text)
Poker.Chart contains chart elements to help visualize Ranges.
import Poker.Range
import Poker.Charts
writeChartOptions "other/base.svg" baseChart
The percentage chance of winning heads-up given each starting hand looks somewhat like this:
(Just m) <- readSomeRanges
let o2 = m Map.! "o2"
writeChartOptions "other/o2.svg" $ percentChart o2
There are two executables included in the library:
poker-fold-writes executes the various canned data that help speed up computation.
cabal install
poker-fold-writes --hvs7Creates a Storable vector (called hvs7) containing the hand ranking of every 7 card hand.
poker-fold-writes --sims 100000Writes results of simulations for various ranges, accessed via readSomeRanges.
(Just m) <- readSomeRanges
let o2 = m Map.! "o2"
let o9 = m Map.! "o9"
The expected value change for each starting hand, from a heads-up, 2 player table to a full, 9 player table, expressed in big blinds.
pretty $ lpad 5 . fixed (Just 2) <$> ((\o o' -> (o' * 9 - o * 2)) <$> o2 <*> o9)
poker-fold-writes --chartsWrites the example charts to file.
This is equivalent to running:
import Poker.Charts
writeAllChartspoker-fold-speed contains performance results and testing routines.
To hack this in emacs:
(setq haskell-process-args-cabal-repl '("poker-fold:exe:poker-fold-speed"))poker-fold-speedlabel1 label2 results
:
handRank time 1.44e4 handRank afap time 1.33e4 handRank ffap time 5.23e6 handRank f| time 5.35e6 handRank |f time 1.36e4 handRank |f| time 6.46e6
poker-fold-speed --shuffle -n 100000label1 label2 results rvi - list time 2.40e-1 rvi - list f time 1.87e2 rvi - single time 5.43e1 rvi - single f time 5.53e1 rvil - single time 2.78e3 rviv - list time 6.00e-4 rviv - list f time 1.04e4 rviv - single time 1.58e3 rviv - single f time 2.75e3
poker-fold-speed --shuffle -n 10000label1 label2 results rvi - list time 2.46e-1 rvi - list f time 2.01e2 rvi - single time 5.54e1 rvi - single f time 5.41e1 rvil - single time 3.03e3 rviv - list time 6.00e-4 rviv - list f time 1.36e4 rviv - single time 2.95e3 rviv - single f time 4.10e3
Creating a list of random variates stays lazy as perf is WHNF in the output. Forcing the list fixes this. For a single rvi, the output is computed, and force being added is probably creating an intermediary.
rvil is a list version of rviv.
poker-fold-speed --shuffle -n 10000 --allocation +RTS -T -RTSlabel1 label2 results rvi - list allocation 0 rvi - list f allocation 5.21e2 rvi - single allocation 0 rvi - single f allocation 0 rvil - single allocation 3.39e3 rviv - list allocation 0 rviv - list f allocation 4.13e4 rviv - single allocation 7.69e3 rviv - single f allocation 7.68e3
poker-fold-speed --shuffle -n 100000 --allocation +RTS -T -RTSlabel1 label2 results rvi - list allocation 0 rvi - list f allocation 5.43e2 rvi - single allocation 0 rvi - single f allocation 1.88e1 rvil - single allocation 3.49e3 rviv - list allocation 0 rviv - list f allocation 4.13e4 rviv - single allocation 7.60e3 rviv - single f allocation 7.60e3
Something allocated to the heap for rvi - single, forced, harming performance.
import Data.Bifunctor
:t count
fmap (fmap (bimap getSum ((/10000.0) . fromIntegral))) $ execPerfT ((,) <$> count <*> time) $ handRankS_P 10000:
count :: Measure IO (Sum Int)
fromList [("flushS",(10000,1709.5718)),("kindS",(9239,1160.7222)),("ranksSet",(9703,1324.894)),("straightS",(9703,421.3668))]
Poker AI is my Haskell origin story, and I can trace it back to pokerpirate and a series of posts, such as Exploiting the sit-and-go that came out, way back in the day, that were often referred to. Years later, I looked up Mike’s work and came across Fast Nearest Neighbour Queries in Haskell.
Mike’s paper and code kicked the arse out of anything else that people were using, back in the day. I like fast. I speedrun megabase Factorio for relaxation. For some people, min-maxing stuff is like knitting.
Down the rabbit hole, I spent some time in subhask, a still remarkable archeological site, full of buried treasure. Another great dig site is HLearn; my perf library is a direct descendent of History Monad I stumbled across. Mike was kind of winding things down by that stage, and it never made it to Hackage. I learnt about how you could just turn stuff off with execStateT, and there are guarantees of zero cost.
I think the library is the fastest open-source, 7-card Hold’em evaluator within a factor of 1.
Since many of you have a rough idea of the play, here’s the main hand value compute:
handRank :: Cards -> HandRank
handRank cs =
fromMaybe
(kind (toRanks cs))
( flush cs
<|> straight (ranksSet cs)
)It’s slightly more efficient to check for flushes, drop down to a straight check transforming ranks to a set, and then dealing with kinded hands (the collective term for 4-of-a-kind, 2-pair and so on). This replaces about eleventy million lines of bit-shifting wizardry that you can explore via poker-eval, written almost a decade ago by Lemmih. The library compiles on ghc-9.2.3 without a single modification since publication. As does copumpkin’s vector-mmap, virtually unchanged since written in 2010.
Poker AI suffered a technology shock over the course of about a week, celebrated in The Great Poker Hand Evaluator Roundup — Coding the Wheel (It’s a highly entertaining read). It was realised that lookup tables beat raw computation and that was that for any need to improve evaluation.
One social outcome of this disruption was that future poker AI development went closed-shop, into poker trainers and HUDs, and this is why I add the open-source tag to my claim.
-- | Given a reverse lexicographic position, what was the combination?
--
-- >>> (\xs -> xs == fmap (fromLexiPosR 5 2 . toLexiPosR 5 2) xs) (combinations 2 [0..4])
-- True
--
fromLexiPosR :: Int -> Int -> Int -> [Int]
fromLexiPosR n k p = go (n - 1) k ((binom n k - 1) - p) []
where
go n' k' p' xs =
bool
( bool
(go (n' - 1) k' p' xs)
(go (n' - 1) (k' - 1) (p' - binom n' k') (n' : xs))
(p' >= binom n' k')
)
xs
(length xs == k)Hole cards start off as a set of 52 * 51 possibilities, but Suit information is neutral in hold’em, so equivalance classes of Hole hands narrow down to 169 possibilities.
hvs7 is a vector of hand rankings for 7 card vectors in reverse lexicographic order.
s <- hvs7
l = S.length s
lThe first element of the vector corresponds to:
hand0 = fromLexiPosR 52 7 0 & fmap fromIntegral & S.fromList & CardsS
"hand:" <> pretty hand0
"hand rank index:" <> pretty (s S.! 0)
"hand rank:" <> pretty (lexiToHR $ s S.! 0)And the last element corresponds to:
hand1 = fromLexiPosR 52 7 (l-1) & fmap fromIntegral & S.fromList & CardsS
"hand:" <> pretty hand1
"hand rank index:" <> pretty (s S.! (l-1))
"hand rank:" <> pretty (lexiToHR $ s S.! (l-1))And the one hundred millionth
handb = fromLexiPosR 52 7 (100000000-1) & fmap fromIntegral & S.fromList & CardsS
"hand:" <> pretty handb
"hand rank index:" <> pretty (s S.! (100000000-1))
"hand rank:" <> pretty (lexiToHR $ s S.! (100000000-1))pretty $ lexiToHR 3141