Sharp Cards in Haskell: Drawing Cards

Following on from my previous post on dice, in this post I’ll look at the support for cards that I am going to add to the next release of my game-probability library. So, cards: to work out the probability of drawing a particular sequence of cards from a deck of cards, you first need to specify which sequences you are interested in. How might you specify this, in Haskell? Here’s one way:

type DrawSpec card = (Int, [card] -> Bool)

That’s the sequence length paired with a function that decides whether a given sequence of that length is one we are interested in. There are two problems with this solution, though. Firstly, it requires fixing the length of the sequence upfront; we cannot decide how many cards to continue drawing based on the ones we have drawn. Secondly, it needs to be fed all the cards it requires at once, which means we must supply it with each possible permutations of cards separately, which will be quite inefficient.

Iterative Drawing: DrawF

Both of these problems can be solved with a more iterative approach:

data DrawF card = DrawFail | Done | DrawOne (card -> DrawF card)
                  | DrawAny (DrawF card)

So we have several options for the state of a draw: it can be successful, it can have failed, or it can need another card: DrawAny is like DrawOne . const, but can be much more efficient, as we’ll see in a future post. Let’s say we want to specify drawing N cards that are the same:

drawSameF :: Eq card => Int -> DrawF card
drawSameF n = if n <= 0 then DrawFail else DrawOne (drawMatch (n-1))


drawMatchF :: Eq card => Int -> card -> DrawF card
drawMatchF 0 _ = Done
drawMatchF n tgt
  = DrawOne (\x -> if x == tgt then drawMatchF (n-1) tgt else DrawFail)

With these sorts of specifications, we can much more easily narrow down the possibilities. Imagine you have a deck with multiple copies of each of ten distinct cards and you want to know the chance of drawing 5 the same. You can feed all ten to this function and get ten DrawOne results, which can be thought of as ten branches in a search. Then when you feed the ten cards again to each of those branches, only one card will not cause a failure, so you will still have ten branches. And the same the next time. So you will try 10*(10+10+10+10) cards in all: 400. This compares well to the 10^5=10,000 combinations you would trawl through if considering all possible permutations.

You can use this functional-style (hence the F suffix) Draw type to describe all draws relatively easily, using some function like this at the top level to ask for the probability of achieving that draw given a collection of cards:

chance :: [card] -> DrawF card -> Rational

Expanding the draw: DrawM

But there is one slight limitation. Let’s imagine that you want to return some result from the draw; for example, you may want to know what card it was that you drew many of, or you may want to return a count of cards. Currently DrawF has no way to return such a result. But we could add one by adding a value to the Done constructor:

data DrawM card a = DrawFail | Done a | DrawOne (card -> DrawM card a)
                  | DrawAny (DrawM card a)

As you may guess by the new M suffix, and important result of this is that we can make the type a monad. The instance practically writes itself:

instance Monad (DrawM card) where
  return = Done
  (>>=) DrawFail _ = DrawFail
  (>>=) (Done x) k = k x
  (>>=) (DrawAny m) k = DrawAny (m >>= k)
  (>>=) (DrawOne f) k = DrawOne (\x -> f x >>= k)
  fail _ = DrawFail

We use the Done constructor for returning values, and we make DrawFail short-circuit the draw, ignoring anything that comes after. We push the binds for DrawOne and DrawAny inside their constructors. There are several useful helper functions we can define in this new DrawM type:

draw :: DrawM card card
draw = DrawOne return

drawAny :: DrawM card ()
drawAny = DrawAny (return ())

drawWhere :: (card -> Bool) -> DrawM card card
drawWhere f = DrawOne (\x -> if f x then return x else DrawFail)

I couldn’t decide whether Done or return was clearer above, so swap them mentally if that helps. The drawMatch function from earlier goes from recursion to replicate:

drawMatch :: Eq card => Int -> card -> DrawM card ()
drawMatch n tgt = replicateM_ n (drawWhere (== tgt))

I like the monadic interface; drawing cards is inherently a sequence of steps, so seeing it written in do-notation makes it clearer than the nested style of the earlier type.

An Example: Pontoon

As an example, we’ll use Pontoon, a British variant on Blackjack. The general idea is the same as Blackjack (be closest to 21, but not over), with an added rule about five-card tricks (five cards with a total <= 21), which beat any non-Pontoon hand (Pontoon being 21 with two cards). We’ll leave aside the rules on splitting a pair to keep the example short. We’ll start with some quick definitions of a deck of playing cards (some Haskell that could come out of a beginner’s text-book):

data Rank = Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten
  | Jack | Queen | King | Ace
  deriving (Bounded, Enum, Eq, Ord, Show, Read)

data Suit = Clubs | Diamonds | Hearts | Spades
  deriving (Eq, Ord, Show, Read)

data PlayingCard = PlayingCard {rank :: Rank, suit :: Suit}
  deriving (Eq, Ord, Show, Read)

deck :: Cards PlayingCard
deck = makeCards [PlayingCard r s | r <- [minBound .. maxBound],
                                    s <- [Clubs, Diamonds, Hearts, Spades]]

Now we can move on to the Pontoon-specific parts. First we will need a function that calculates the possible totals of a set of cards. Since aces can be low (worth 1) or high (worth 11) at the player’s choice, there are potentially multiple different totals that each hand can have:

values :: [Rank] -> [Int]
values [] = [0]
values (Ace:xs) = concat [[1 + v, 11 + v] | v <- values xs]
values (x:xs)
  | x `elem` [Jack, Queen, King] = map (10 +) (values xs)
  | otherwise = map ((fromEnum x + 2) +) (values xs)

The slightly awkward bit is the fromEnum part; since fromEnum Two == 0, we have to add 2 to get the right value. We can also define a data-type to hold the different non-bust results for a hand in Pontoon:

data Result = StuckOn Int | FiveCardTrick | Pontoon
  deriving (Eq, Ord, Show)

Note that the derived Ord instance will actually give a proper ordering of which hand is best: pontoon beats five-card trick beats the other results which are ordered by their numerical result (higher is better).

Pontoon Draw Strategy

The missing part is now a function to represent drawing cards in Pontoon. We’ll define a function corresponding to a fairly simplistic strategy: while we haven’t reached exactly 21 (or a five-card trick) with our hand, we’ll keep drawing as long as we’re below a constant upper limit (e.g. 15):

drawStrategy :: Int -> DrawM Rank Result
drawStrategy stickMin
  = do firstTwo <- replicateM 2 draw
       if 21 `elem` values firstTwo
         then return Pontoon
         else keepGoing firstTwo
  where
    keepGoing cur
      | all (> 21) totals = badHand -- Bust!
      | length cur == 5 = return FiveCardTrick
      | 21 `elem` totals = return $ StuckOn 21
      | any (< stickMin) totals = do {c <- draw; keepGoing (c:cur)}
      | otherwise = return $ StuckOn (maximum $ filter (<= 21) totals)
      where
        totals = values cur

To begin with, we draw two cards. If we can immediately achieve 21, that’s Pontoon and we stop. Otherwise we consider whether to keep drawing. We then have five choices listed in order (the guards of the inner function). If every possible total is above 21, we’re bust (badHand = DrawFail). If we have five cards (and aren’t bust), we have a five-card trick and we stop. If we’ve otherwise hit 21, we have a normal 21 with either three or four cards. The final two guards cover our decision: if we’re below our upper limit we keep drawing, and otherwise we stick with the best total we can manage that’s 21 or under.

So that fairly neatly lays out all the possibilities involved in drawing a hand of Pontoon. Now that we have this specification, we can calculate some odds. I’ll show the code and results here, but I will return to how the probabilities are calculated in my next post (to avoid this one growing too long):

main :: IO ()
main = do print $ to3dp <$> chanceMapOn rank deck (optional $ drawStrategy 14)
          print $ to3dp <$> chanceMapOn rank deck (optional $ drawStrategy 16)
          print $ to3dp <$>
            compareEvent (eventDrawOn rank deck (optional $ drawStrategy 14))
                         (eventDrawOn rank deck (optional $ drawStrategy 16))
  where
    to3dp :: Rational -> String
    to3dp x = printf "%.3f" (fromRational x :: Double)

The optional function effectively maps successful draws into Just values and failed draws (i.e. bust) into Nothing; see the notes at the end of this post if you want more detail. This code will print three lines (which I’ve re-flowed below): the first will have a map from result to probability (which by that point will be a String) when we draw with less than 14, and the second will be the same when we draw with less than 16; the third will give the probability of the first strategy producing a worse, equal or better result than the second:

fromList
  [(Nothing,"0.086"), (Just (StuckOn 14),"0.125"), (Just (StuckOn 15),"0.122"),
   (Just (StuckOn 16),"0.114"), (Just (StuckOn 17),"0.110"),
   (Just (StuckOn 18),"0.101"), (Just (StuckOn 19),"0.095"),
   (Just (StuckOn 20),"0.135"), (Just (StuckOn 21),"0.050"),
   (Just FiveCardTrick,"0.013"), (Just Pontoon,"0.048")]

fromList
  [(Nothing,"0.216"),
   (Just (StuckOn 16),"0.132"), (Just (StuckOn 17),"0.128"),
   (Just (StuckOn 18),"0.119"), (Just (StuckOn 19),"0.113"),
   (Just (StuckOn 20),"0.152"), (Just (StuckOn 21),"0.069"),
   (Just FiveCardTrick,"0.022"), (Just Pontoon,"0.048")]

fromList [(LT,"0.485"), (EQ,"0.097"), (GT,"0.418")]

So even though we can see from the first two sections that the first strategy (drawing again when less than 14) is much less likely to leave you bust (the Nothing outcome), we can see from the third section that in general it is more likely to lose (the LT outcome) against the second strategy (drawing again when less than 16) than win (the GT outcome). That’s a useful result, from what I hope is relatively readable code!

In the next post, we’ll take a look at how the probabilities are calculated.

---

Notes

• The DrawM monad is a little reminiscent of iteratees, with all chunks being size 1. Generally, iteratees are designed to receive chunks of data as they become available. What this work does is take a DrawM item and supply with it many different possible next inputs to see what happens. I don’t know if much has been done with iteratees in this vein: it is somewhat like fuzzing iteratees to see what happens with different data.
• This work looks at permutations of cards rather than combinations. Obviously looking at combinations could be much faster since there are a lot less of them (factorial in the number of cards drawn). Permutations is the more general case, and allows for testing based on the sequence of cards. In the Pontoon example, the sequencing and choice of drawing more is vital. In other scenarios, it isn’t needed, and examining all permutations merely adds computational overhead: win some, lose some.
• The Pontoon example combines two aspects: one is the rules on scoring and stopping, and the other is the strategy for when to draw more. This is primarily convenience for the example: it would not be hard to alter the function to not take the stickMin parameter, and instead take a function that replaces the entire any (< stickMin) totals guard, thus parameterising the function by the user-defined strategy.
• The optional call in the example uses the Alternative instance for DrawM card, which allows choice between draws to be expressed, and is given here:

  instance Alternative (DrawM card) where
    empty = DrawFail
    (<|>) DrawFail x = x
    (<|>) (Done x) _ = Done x
    (<|>) (DrawAny m) (DrawAny n) = DrawAny $ m <|> n
    (<|>) (DrawOne f) (DrawOne g) = DrawOne $ \x -> f x <|> g x
    (<|>) (DrawAny m) (DrawOne g) = DrawOne $ \x -> m <|> g x
    (<|>) (DrawOne f) (DrawAny n) = DrawOne $ \x -> f x <|> n
    -- Done or DrawFail on RHS:
    (<|>) (DrawAny m) n = DrawAny $ m <|> n
    (<|>) (DrawOne f) n = DrawOne $ \x -> f x <|> n
  
  

  The top few cases are straightforward: the empty choice is to fail, choosing between failure and anything will be anything, and choosing between success and anything will be success — the docs for Alternative don’t specify this, but I always take the operator to be left-biased. If we choose between DrawAny and DrawOne, we do need to know what card is next because the DrawOne needs to know. However, in all the other cases, neither side cares what the card is, so we can stick with DrawAny.