# Composition in Trick-Taking Card Games

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 `Card`

s,
`Suit`

s and `Rank`

s to `String`

s, equality predicates for all three types and,
in case of `Rank`

s, 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^{1}. 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 `Ordering`

s 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 `Comparison`

s act on
`Card`

s.

```
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^{2} 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 `Comparison`

s 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^{3}. 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*^{4}).

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 ^{5}*, 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!