This article was written as part of the Advent of Haskell 2020, be sure to check it out for other cool Haskell content!

A trick-taking game is a genre of (primarily) card games. Play revolves around rounds, in which each player plays exactly one card. The player who played the highest card wins the round, or trick.

On the surface these games seem to possess imperative core, processing well-defined actions once after the other. In this blog post we dive a bit deeper into the implementation of determining trick winners, and discover a neat application of composition to solve this problem, using Haskell and its standard library.

Hearts

We consider concrete games, increasing in complexity, starting with Hearts. Hearts is played with a 52-card deck of four suits (Clubs, Spades, Hearts, Diamonds) and thirteen ranks (from highest to lowest: A-K-Q-J-10-9-…-3-2).

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

data Rank = Two | Three | Four | .. | Jack | Queen | King | Ace
  deriving (Show, Eq, Ord)

data Card = Card { getSuit :: Suit, getRank :: Rank }
  deriving (Show, Eq)

The deriving clauses cause Haskell to automatically derive some boilerplate functions for us. This includes the show function for converting Cards, Suits and Ranks to Strings, equality predicates for all three types and, in case of Ranks, an ordering such that we have Two < Three < .. < Ace. We can verify that this works using ghci.

Main> :l Cards.hs
*Cards> aceOfSpades = Card Spades Ace
*Cards> aceOfSpades
Card Spades Ace
*Cards> twoOfDiamonds = Card Diamonds Two
*Cards> aceOfSpades == twoOfDiamonds
False
*Cards> aceOfSpades == aceOfSpades
True
*Cards> Two < Three
True

To determine the winner of a trick, we first inspect the suit which was led, i.e. played first. The highest card of that suit wins. Programatically this corresponds to choosing the maximum of a list, for which Haskell has the aptly named maximum function in its standard library. The maximum function requires that the type of elements of the list has Ord instance, i.e. is orderable. Unfortunately this is not the case: the ordering we choose depends on the suit that led, there is no global ordering we can apply to every Hearts trick. Haskell allows us to use a custom ordering function in this case, and the function maximumBy ordFunc computes the maximum using ordFunc as underlying ordering.

The comparison function ordFunc must take two list elements and return a value of type Ordering, where Ordering can be LT (for less), EQ (for equal) or GT (for greater).

import Data.Foldable
import Data.Ord

heartsCompare :: Suit -> Card -> Card -> Ordering
heartsCompare lead (Card s1 r1) (Card s2 r2)
  | s1 == lead && s2 == lead = r1 `compare` r2
  | s1 == lead && s2 != lead = GT
  | s1 != lead && s2 == lead = LT
  | otherwise = undefined  -- neither c1 nor c2 have the leading suit,
                           -- we cannot compare these two cards

trickWinner :: [Card] -> Card
trickWinner (lead:rest) =
  maximumBy (heartsCompare $ getSuit lead) $ lead:rest

Mathematically inclined readers will notice two things: Firstly, the Haskell Ord type class models a total order, which means that it assumes that any two cards are comparable. The Hearts ordering function we constructed however is actually a partial order, since we cannot compare two cards of different suits. This is not a problem however: Our ordering is always defined if the leading suit is played in a trick, and this is, by definition of leading suit, always the case.

Secondly, the ordering suspiciously looks like a lexicographic (partial) ordering: first we compare suits, and the “higher” suit wins¹. If the suits are equal then we move on to ranks. Lexical composition on orderings returns the first decisive (i.e. non EQ) ordering, or EQ if both are equal.

lexicalComp :: Ordering -> Ordering -> Ordering
lexicalComp EQ o2 = o2
lexicalComp o1 _  = o1

Looking a bit closer we can see two interesting properties of the lexicalComp function: It is associative, and it has a neutral element (EQ).

-- the function is associative
> lexicalComp (lexicalComp a b) c) == lexicalComp a (lexicalComp b c)

-- the function has a left and right identity element
> lexicalComp EQ x == x == lexicalComp x EQ

Thus lexical composition of Orderings forms a Monoid with identity element EQ. This instance is available in Haskell’s standard library, so we can shorten our definition somewhat.

import Data.Monoid ((<>))

lexicalComp = (<>)  -- used infix like a <> b

Using this idea we can simplify our definition of heartsCompare. Note that the cases which previously were undefined are now defined, however as argued before it does not matter much how we decide in these cases.

suitCompare :: Suit -> Suit -> Suit -> Ordering
suitCompare lead = comparing (== lead)

rankCompare :: Rank -> Rank -> Ordering
rankCompare = compare

heartsCompare :: Suit -> Card -> Card -> Ordering
heartsCompare lead c1 c2 = suitCompare lead (getSuit c1) (getSuit c2)
                        <> rankCompare      (getRank c1) (getRank c2)

We have separated comparison of suit and rank and combine the results using abstractions provided by the Haskell standard library. Instead of combining the results we can also combine the comparison functions themselves, by defining a newtype for Comparison functions.

newtype Comparison a = Comparison { getComparison :: a -> a -> Ordering }

-- we can combine any two ordering functions, as long as
-- they compare the same elements
instance Monoid (Comparison a) where
  mappend f g = Comparison $ \x y -> (getComparison f) x y <> (getComparison g) x y
  mempty = Comparison $ \x y -> EQ

We would like to use this comparison on the above definition of heartsComparison.

suitComparison :: Suit -> Comparison Suit
suitComparison lead = Comparison $ comparing (== lead)

rankComparison :: Comparison Rank
rankComparison = Comparison compare

-- type error! `suitCompare` is of type `Comparison Suit` and
-- `rankCompare` is of type `Comparison Rank`
badHeartsComparison :: Suit -> Comparison Card
badHeartsComparison lead c1 c2 = suitComparison lead <> rankComparison

This, however, is a type error: The comparisons have different types, so we cannot combine them. Instead, we have to ensure that both Comparisons act on Cards.

suitCardComparison :: Suit -> Comparison Card
suitCardComparison lead = Comparison $ \c1 c2 ->
  comparing (== lead) (getSuit c1) (getSuit c2)

rankCardComparison :: Comparison Card
rankCardComparison = Comparison $ \c1 c2 ->
  compare (getRank c1) (getRank c2)

verboseHeartsComparison :: Suit -> Comparison Card
verboseHeartsComparison lead c1 c2 = suitCardComparison lead
                                  <> rankCardComparison

These definitions are verbose and repetitive, since all we did was to apply an extra function prior to applying the comparison function. Also both definitions look similar, so let us extract the functionality into a new function mystery.

mystery :: (Card -> a) -> Comparison a -> Comparison Card
mystery f c = Comparison $ \c1 c2 -> (getComparison c) (f c1) (f c2)

-- now we can express suitCardComparison and rankCardComparison more succinctly
suitCardComparison lead = mystery getSuit suitComparison
rankCardComparison      = mystery getRank rankComparison

We can abstract mystery even further, by replacing Card with a type parameter b. The resulting type looks almost like the definition of a Functor, with flipped arrows!

fmap    :: (a -> b) ->          f a ->          f b
mystery :: (b -> a) -> Comparison a -> Comparison b
mystery f c = Comparison $ \c1 c2 -> (getComparison c) (f c1) (f c2)

Indeed, Comparison is what the literature calls a contravariant functor, which is related to the (covariant) Functor. The terms co- and contravariant come from the definitions of the mapping function: A type is called covariant when it preserves the direction of the mapping function (going from a -> b to f a -> f b), while a contravariant reverses the direction of the arrow (going from b -> a to f a -> f b. There is a lot of literature available² for the theoretical background for interested readers, we will not go into further detail here.

class Functor f where
  fmap      :: (a -> b) -> f a -> f b

class Contravariant f where
  contramap :: (b -> a) -> f a -> f b

The abstractions Covariant and Comparison we invented before are part of Haskell’s standard library, including the Monoid instance of Comparison. They can found in the Data.Functor.Contravariant module.

import Data.Functor.Contravariant

-- Data.Functor.Contravariant defines defaultComparison for us
--defaultComparison = Comparison compare

suitComparison :: Suit -> Comparison Suit
suitComparison lead = Comparison $ comparing (== lead)

heartsComparison :: Suit -> Comparison Card
heartsComparison lead = contramap getSuit $ suitComparison lead
                     <> contramap getRank $ defaultComparison    

trickWinner :: [Card] -> Card
trickWinner (lead:rest) =
  maximumBy (getComparison . heartsComparison . getSuit $ lead) $ lead:rest

When I first read about contravariant functors I had troubles imagining where these might come in handy, but hopefully this example demonstrates their usefulness.

Other Trick-taking games

This seems like an overly complicated solution if we are only interested in implementing the Hearts card game. However, this abstraction proves very useful if we turn to other trick-taking games, which have more complicated rules. Let’s look at Skat next, one of my favorite trick-taking games. Skat is played with three players and a 32-card deck, consisting of the same suits as Hearts, however only using cards of rank seven and up.

There is a variety of possible game modes, each with different orderings to score the tricks. The typical the so-called Farbspiel, in which all Buben (jacks) and all colors of a specific suit are trump cards. The jacks have an ordering based on suits, from highest to lowest: Clubs-Spades-Hearts-Diamonds. Trump cards always win a trick, and if multiple trumps are played in the same trick then the highest one wins. If no trump is played, then the trick is scored as it is in Hearts: The highest card of the leading suit wins the trick.

Notably, the suit cards are ranked A-10-K-Q-9-8-7, with 10 between ace and king. The jacks are omitted since they belong to the trump cards. Let’s first define the skatRank comparison.

import Data.List (elemIndex)

-- If `a` is an instance of the `Ord` typeclass,
-- then we can also order elements of type `Maybe a`
-- using
--   compare Nothing (Just x) = LT
highTen :: Comparison Rank
highTen = contramap (`elemIndex` skatRanks) defaultComparison 
  where
    skatRanks = [Seven, Eight, Nine, Queen, King, Ten, Ace]

compareSkatRank :: Comparison Card
compareSkatRank = contramap getRank highTen

The function highTen captures the anomaly in the Skat ranking, namely that Ten is the second-highest ranked card of a suit. We can use the same technique as above to rank the suits when comparing the suits of two jacks.

suitOrder :: Comparison Suit
suitOrder = contramap (`elemIndex` rankedSuits) defaultComparison 
  where
    rankedSuits = [Diamonds, Hearts, Spades, Clubs]

compareSuits :: Comparison Card
compareSuits = contramap getSuit suitOrder

Finally we can combine the two Comparisons above to determine the winner of a trick in a Farbspiel. To do this we consider a lexicographical composition of three orderings: First we compare both cards according to the jack-comparison rules. A jack wins against a non-jack and if both cards are jacks we compare using the defined suitOrder. Then we compare the trumps on both sides. Again trump always wins against non-trump, and if both are trumps then we need to consider the skatRank order. Finally if neither of these is true then we use the same algorithm as in the Hearts game, awarding the trick to the highest card of the leading suit.

-- generalization of suitComparison, useful when we only care
-- about a particular subset of values (e.g. one suit, one rank, etc.)
when :: (Card -> Bool) -> Comparison Card -> Comparison Card
when f cmp = Comparison aux
  where
    aux x y
      | f x && f y = getComparison cmp x y
      | otherwise = comparing f x y

whenSuit s cmp = when ((==) s . getSuit) cmp
whenRank r cmp = when ((==) r . getRank) cmp

farbspiel :: Suit -> Suit -> Comparison Card
farbspiel trump lead =
     (whenRank Jack  compareSuits)
  <> (whenSuit trump compareSkatRank)
  <> (whenSuit lead  compareSkatRank)

Now we can easily use our powerful combinators to implement the Grand variant, in which there is no trump suit, only the jacks are trumps.

-- in a grand only the four jacks are trumps
grand :: Suit -> Comparison Card
grand lead =
     (whenRank Jack compareSuits)
  <> (whenSuit lead compareSkatRank)

Even different rankings are not a problem: In the so called Nullspiel no trumps exist, and the cards are sorted as they are in the Hearts game. The player’s goal is to ensure that he does not win a trick.

nullspiel :: Suit -> Comparison Card
nullspiel = heartsComparison

This example highlights the use of composition very well: Instead of writing one large comparison function per card game we can combine four simple ones using the powerful abstractions in the Haskell standard library.

Bonus game: Doppelkopf

Lastly, let’s take a short look at another one of my favorite games: Doppelkopf. Doppelkopf is special since it is not played with one, but two sets of cards, with the same suits as before and ranks 9-J-Q-K-10-A³. Most Doppelkopf games are scored similar to a Farbspiel where Diamonds are trump, with some extra trumps: all jacks and all queens are trumps, with the queens ranked higher than the jacks, and both queens and jacks being ordered by the same suitOrder as before. The two tens of hearts are the two highest trumps, and are called Dullen (sg. Dulle⁴).

To uniquely determine a trick winner now, we also need to know who played which card, since the same card may be present twice. The official tournament rules state: If the highest card is present twice, then the first card played wins.

firstWins = Comparison $ \x y -> GT

dokoTournamentRules :: Suit -> Comparison Card
dokoTournamentRules lead =
     (when (== Card Hearts Ten) firstWins)
  <> (whenRank Queen $ compareSuits <> firstWins)
  <> (whenRank Jack  $ compareSuits <> firstWins)
  <> (whenSuit Diamonds $ compareSkatRank <> firstWins)
  <> (whenSuit lead     $ compareSkatRank <> firstWins)

dokoTrickWinner :: [(Card, Player)] -> (Card, Player)
dokoTrickWinner (c@(lead, player):rest) =
  maximumBy (getComparison $ contramap fst (dokoTournamentRules $ getSuit lead)) $ c:rest

Doppelkopf has more variants than any other card game I know of, ranging from slight alterations to total game changers. The most common variant we play with concerns the ten of hearts, in which the second ten of hearts beats the first. This sounds like a complete headache to model, however using the abstractions we developed for Skat already modeling Doppelkopf is child’s play.

firstWins  = Comparison $ \x y -> GT
secondWins = Comparison $ \x y -> LT

secondHeartsTenWins :: Suit -> Comparison Card
secondHeartsTenWins lead =
     (when (== Card Hearts Ten) secondWins)
  <> (whenRank Queen $ compareSuits <> firstWins)
  <> (whenRank Jack  $ compareSuits <> firstWins)
  <> (whenSuit Diamonds $ compareSkatRank <> firstWins)
  <> (whenSuit lead     $ compareSkatRank <> firstWins)

Another variant is called Schweinchen⁵, which the player having both Diamond Aces must announce. Both Diamond Aces then become the highest trumps. Even playing with the piglet rule, some games may not feature piglets at all, in which case the Diamond Aces are not special.

withSchweinchen :: Comparison Card -> Comparison Card
withSchweinchen normalComparison =
     when (== Card Diamond Ace) firstWins
  <> normalComparison

Drawbacks

I want to point out some drawbacks of this approach. The Ord typeclass models total orderings, and this ordering is not total, only partial. The comparisons we created may not work with minimums or other ordering functions, for example. Arguably, a new type class PartialOrd would be cleaner, including an “incomparible” comparison result in PartialOrdering. To my knowledge, these are not available in the standard library sadly, although there exists an implementation in the lattices package.

Conclusion

We have developed an abstraction for modelling trick-taking games. In the process, we (re)discovered concepts from the Haskell standard library. Hopefully, this post helped you in understanding these concepts and their applications. If you have any questions or comments feel free to reach out to me via my public inbox.

Thanks for sticking with me, now go play some card games!