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.
** imports
: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
** quick tour
*** Cards
Poker.Cards contain the basic and human-friendly Poker types, and Poker.Cards.Storable the newtyped-wrapped, efficiently-stored versions. There are [[https://hackage.haskell.org/package/optics-core][optics-core]] iso's to help convert between the two versions, and [[https://hackage.haskell.org/package/prettyprinter][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 cs
: CardsS {unwrapCardsS = [50,23,34,15,16,22,19]} : Ah7sTh5s6c7h6s
Routines for evaluation of a hand - 7 cards consisting of 2 player cards and 5 community cards - can be found in Poker.HandRank.
*** Hand Ranks
import Poker.HandRank handRank cs pretty (handRank cs)
: TwoPair Seven Six Ace
It is much faster to look up hand rankings then recompute them every time, so a big [[https://hackage.haskell.org/package/vector-0.13.0.0/docs/Data-Vector-Storable.html][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 !! 4301
: 4301 : TwoPair Seven Six Ace : TwoPair Seven Six Ace
The 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.! 32513187
: 32513187 : TwoPair Seven Six Ace
I suspect that the algorithm is a [[https://doisinkidney.com/posts/2021-03-14-hyperfunctions.html][hyperfunction]]...
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)
*** Ranges
A major thematic of the library is that poker strategy is well encapsulated by a 13 by 13 grid representation of a [[https://en.wikipedia.org/wiki/Texas_hold_%27em_starting_hands][starting hand]].
Poker.Range contains the core types for this encapsulation. Under the hood of Range is a [[https://hackage.haskell.org/package/numhask-array][numhask-array]] array which has a nice representable functor instance from [[https://hackage.haskell.org/package/adjunctions][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)
AAp AKs AQs AJs ATs A9s A8s A7s A6s A5s A4s A3s A2s AKo KKp KQs KJs KTs K9s K8s K7s K6s K5s K4s K3s K2s AQo KQo QQp QJs QTs Q9s Q8s Q7s Q6s Q5s Q4s Q3s Q2s AJo KJo QJo JJp JTs J9s J8s J7s J6s J5s J4s J3s J2s ATo KTo QTo JTo TTp T9s T8s T7s T6s T5s T4s T3s T2s A9o K9o Q9o J9o T9o 99p 98s 97s 96s 95s 94s 93s 92s A8o K8o Q8o J8o T8o 98o 88p 87s 86s 85s 84s 83s 82s A7o K7o Q7o J7o T7o 97o 87o 77p 76s 75s 74s 73s 72s A6o K6o Q6o J6o T6o 96o 86o 76o 66p 65s 64s 63s 62s A5o K5o Q5o J5o T5o 95o 85o 75o 65o 55p 54s 53s 52s A4o K4o Q4o J4o T4o 94o 84o 74o 64o 54o 44p 43s 42s A3o K3o Q3o J3o T3o 93o 83o 73o 63o 53o 43o 33p 32s A2o K2o Q2o J2o T2o 92o 82o 72o 62o 52o 42o 32o 22p
Poker.Chart contains chart elements to help visualize Ranges.
import Poker.Range import Poker.Charts writeChartOptions "other/base.svg" baseChart
[[file:other/base.svg]]
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
[[file:other/o2.svg]]
There are two executables included in the library:
** poker-fold-writes
poker-fold-writes executes the various canned data that help speed up computation.
cabal install poker-fold-writes --hvs7
Creates a Storable vector (called hvs7) containing the hand ranking of every 7 card hand.
poker-fold-writes --sims 100000
Writes 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)
1.42 0.68 0.58 0.49 0.44 0.27 0.21 0.19 0.18 0.23 0.22 0.22 0.19 0.41 0.97 0.58 0.49 0.42 0.27 0.16 0.13 0.12 0.10 0.11 0.11 0.11 0.28 0.30 0.65 0.50 0.44 0.28 0.19 0.10 0.09 0.07 0.06 0.07 0.07 0.19 0.21 0.23 0.40 0.48 0.33 0.21 0.14 0.07 0.06 0.05 0.05 0.05 0.12 0.13 0.16 0.21 0.25 0.37 0.29 0.20 0.12 0.08 0.07 0.07 0.07 -0.06 -0.05 -0.02 0.04 0.10 0.09 0.27 0.22 0.16 0.10 0.04 0.04 0.04 -0.12 -0.16 -0.13 -0.09 0.00 0.00 0.04 0.27 0.24 0.17 0.10 0.06 0.05 -0.15 -0.19 -0.22 -0.18 -0.10 -0.07 0.00 -0.00 0.28 0.24 0.18 0.12 0.06 -0.16 -0.20 -0.23 -0.24 -0.18 -0.12 -0.04 0.01 0.01 0.32 0.27 0.20 0.14 -0.11 -0.23 -0.25 -0.25 -0.23 -0.19 -0.11 -0.03 0.04 -0.02 0.30 0.27 0.21 -0.12 -0.22 -0.26 -0.26 -0.23 -0.25 -0.18 -0.10 -0.01 0.03 0.02 0.24 0.19 -0.12 -0.23 -0.25 -0.25 -0.23 -0.25 -0.22 -0.16 -0.07 0.00 -0.03 0.07 0.17 -0.15 -0.23 -0.25 -0.26 -0.23 -0.25 -0.23 -0.22 -0.14 -0.06 -0.07 -0.09 0.12
[[file:other/pixelo9.svg]]
poker-fold-writes --charts
Writes the example charts to file.
This is equivalent to running:
import Poker.Charts writeAllCharts
** poker-fold-speed
poker-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"))
*** hand evaluation speed
poker-fold-speed
: label1 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
*** shuffling
poker-fold-speed --shuffle -n 100000
label1 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 10000
label1 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 -RTS
label1 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 -RTS
label1 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.
*** handRankS
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))]
** origins
Poker AI is my Haskell origin story, and I can trace it back to pokerpirate and a series of posts, such as [[https://izbicki.me/blog/exploiting-the-sit-and-go-game.html][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 [[https://izbicki.me/blog/fast-nearest-neighbor-queries-in-haskell.html][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 [[https://github.com/mikeizbicki/subhask][subhask]], a still remarkable archeological site, full of buried treasure. Another great dig site is [[https://github.com/mikeizbicki/HLearn][HLearn]]; my [[https://hackage.haskell.org/package/perf-0.10.0/docs/Perf-Types.html#t:PerfT][perf]] library is a direct descendent of [[https://github.com/mikeizbicki/HLearn/blob/master/src/HLearn/History.hs#L299][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 [[https://hackage.haskell.org/package/poker-eval][poker-eval]], written almost a decade ago by [[https://hub.darcs.net/Lemmih][Lemmih]]. The library compiles on ghc-9.2.3 without a single modification since publication. As does [[https://github.com/copumpkin/][copumpkin]]'s [[https://hackage.haskell.org/package/vector-mmap][vector-mmap]], virtually unchanged since written in 2010.
Poker AI suffered a technology shock over the course of about a week, celebrated in [[https://www.codingthewheel.com/archives/poker-hand-evaluator-roundup/#2p2][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.
** revolving door
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)
** equivalence classes
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
hvs7 is a vector of hand rankings for 7 card vectors in reverse lexicographic order.
s <- hvs7 l = S.length s l
: 133784560
The 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)
: hand:KdKhKsAcAdAhAs : hand rank index:7451 : hand rank:FourOfAKind Ace King
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))
: hand:2c2d2h2s3c3d3h : hand rank index:7296 : hand rank:FourOfAKind Two Three
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))
: hand:5s6s7d8dTcThQs : hand rank index:3141 : hand rank:OnePair Ten Queen Eight Seven
pretty $ lexiToHR 3141
: OnePair Ten Queen Eight Seven