# Composition in Trick-Taking Card Games

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> twoOfDiamonds = Card Diamonds Two
False
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
| otherwise = undefined  -- neither c1 nor c2 have the leading suit,
-- we cannot compare these two cards

trickWinner :: [Card] -> Card
``````

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 wins1. 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

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

heartsCompare :: Suit -> Card -> Card -> Ordering
<> 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

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

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
<> 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 available2 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

heartsComparison :: Suit -> Comparison Card
<> contramap getRank \$ defaultComparison

trickWinner :: [Card] -> Card
``````

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
(whenRank Jack  compareSuits)
<> (whenSuit trump 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
(whenRank Jack compareSuits)
``````

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-A3. 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. Dulle4).

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
(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)
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
(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 Schweinchen5, 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!

## Articles from blogs I follow

### Record your Linux Desktop with ffmpeg and slop to any format

This two-line shell script allows you to record a region of your linux desktop to a video file, or a `.gif`, using `slop` and `ffmpeg`. I use it often when a screenshot is not enough, or when you need to explain a sequence of events to someone.

via Raymii.org on

### What's cooking on SourceHut? March 2021

Hi! Another month of development has passed, and I’m here to fill you in on what’s new. Another 686 signups this month has brought us to 21,041 users. As always, I’ll be counting on you to make the new users feel at home, please be patient with them and help…

via Blogs on Sourcehut on

### Status update, March 2021

After the brief illusion of spring, this morning meets us with a cold apartment indoors and fierce winds outdoors. Today concludes a productive month, mainly for the secret project and for sourcehut, but also marked by progress in some smaller projects as we…

via Drew DeVault's blog on