A Whirlwind Tour of Combinatorial Games in Haskell
March 17, 2014 / haskell, cgt, retroactive
Combinatorial games are an interesting class of games where two players take turns to make a move. In these games, both players have perfect information about the state of the game and there is no element of chance. In ‘normal play’, the winner is declared when the other player is unable to move.
Even games that don’t exactly match these conditions can be analysed using techniques from combinatorial game theory, including chess and Go, and the pen-and-paper game Dots and Boxes.
The simplest way of thinking of these games is as a set of moves for the player Left, and a set of moves for the player Right. When a player chooses an option from their set, this new position can be considered another game. This gives us a tree-like structure:
data Game = Game { leftMoves :: [Game], rightMoves :: [Game] }
We write { L | R }
for the game where Left can choose a move from
L
, and Right can choose a move from R. For example, we have the zero
game, where neither player has any moves they can make: zero = { | }
= Game [] [] zero
In this game, if it’s Left’s turn, he loses. If it’s Right’s turn, he loses. So this game encompases the idea of both players having 0 turns remaining.
Here’s the next simplest game, one = { zero | }
= Game [zero] [] one
Now, if it’s Left’s turn, he can move to the zero game. If it’s Right’s turn, he loses straight away. In this game, Left has one move’s advantage on Right. Similarly, we can define two:
= Game [one] [] two
Now Left has a two move advantage on Right. If we want to classify the different outcomes a game can have, we find there are only four options:
- Left can always win, no matter who starts
- Right can always win, no matter who starts
- The second player can always win
- The first player can always win
We will write these four options as G > 0
, G < 0
, G = 0
, G || 0
.
It’s clear that zero = 0
and one > 0
. We can combine these classes as
usual. For example, G >= 0
means Left can always win if he’s the
second player, and in G <= 0
Right can always win if he’s the second
player.
These two predicates are easy to implement. If G >= 0
, Left can
always win as second player and Right has no good opening move. A good
opening move for Right is a position in R
that right could win,
i.e. a position r <= 0
. The definition is similar for G <= 0
, giving
mutually recursive definitions:
gteqZero :: Game -> Bool
lteqZero :: Game -> Bool
= not . any lteqZero . rightMoves
gteqZero = not . any gteqZero . leftMoves
lteqZero
-- gteqZero zero ==> True
-- lteqZero zero ==> True
-- gteqZero one ==> True
-- lteqZero one ==> False
These are guaranteed to terminate (as long as our games are finite), as at every step we are looking at a smaller game. From these we can easily build the others:
= gteqZero g && lteqZero g
eqZero g = gteqZero g && not (lteqZero g)
gtZero g = not (gteqZero g) && lteqZero g
ltZero g
= not (gteqZero g) && not (lteqZero g) fuzzyZero g
The last case is strange. We have a game G
where neither G >= 0
nor
G <= 0
! This corresponds to G || 0
from above, and we say G
is fuzzy to
0. We can find such a game easily: ∗ = { zero | zero }
. This game
clearly does not correspond to a number.
= Game [zero] [zero]
star
-- fuzzyZero star ==> True
Arithmetic and Ordering
Now we consider the sum of two games. In the game G + H
, a player has
the choice of which component they wish to move in. For example, Left
can choose one of the L
moves in G
, leaving H
the same, or one of the
L
moves in H
, leaving G
the same.
instance Num Game where
+ h = Game left right
g where left = map (+ h) (leftMoves g) ++ map (g +) (leftMoves h)
= map (+ h) (rightMoves g) ++ map (g +) (rightMoves h) right
We are also ready to negate games. In -G
, Right can make all the moves
Left could, and vice versa. This is just like spinning the board in
chess.
negate g = Game (map negate $ rightMoves g) (map negate $ leftMoves g)
With these operations, games form an abelian group. Following the
pattern earlier, converting from integers to games is easy. We have
n = { n-1 | }
. If we are given a negative number, we can just negate the
positive game.
fromInteger i | i == 0 = zero
| i > 0 = Game [fromInteger (i-1)] []
| i < 0 = negate $ fromInteger (-i)
* h = undefined -- This is possible to define for some games
g abs g = undefined
signum g = undefined
This arithmetic now lets us define equality in a natural way. Two games are equal if their difference is 0.
instance Eq Game where
== h = eqZero (g - h) g
As we would hope, G = G
for every game. Let’s think about why this
is. G = G
is defined as to G - G = 0
, i.e., G + (-G) = 0
. If the
first player makes a move in G
, the second player can immediately
reply with the same move in -G
. No matter what move the first player
makes, the second has a response in the other component. This can
continue until the first player runs out of options and loses, meaning
G + (-G) = 0
.
We’re ready to show 1 + 1 = 2
:
-- one + one == two ==> True
-- zero + one == one ==> True
-- two + two == two ==> False
We see arithmetic behaves as you expect. What about ∗
from earlier?
-- star + star == zero ==> True
This seems strange at first, but makes sense when we think about how
∗ + ∗
would be played. The first player plays in one of the ∗
,
moving it to 0. The other player is then free to play in the other ∗
, leaving
0 + 0 = 0
, so the first player loses. The first player losing is how
we defined G = 0
, so indeed we get ∗ + ∗ = 0
.
We can also compare games with each other. We have to cheat here
because Ord is intended for total orders, but from ∗ || 0
it is clear
we can’t always put an order on two games.
instance Ord Game where
< h = ltZero (g - h)
g > h = gtZero (g - h)
g <= h = lteqZero (g - h)
g >= h = gteqZero (g - h)
g
|| h = fuzzyZero (g - h) g
Now let’s consider the game G = { 0 | 1 }
. What do we know about it?
= Game [zero] [one]
half -- half > 0 ==> True
-- half < 1 ==> True
We might guess that this game is 1/2
. We can check:
-- half + half == 1 ==> True
And so it is. We could also find a game representing 1/4
:
= Game [zero] [half]
fourth -- fourth + fourth + fourth + fourth == 1 ==> True
Continuing like this we can construct every dyadic rational,
i.e. rationals where the denominator is a power of two. The idea is,
2p+1 / 2^n = { p / 2^(n-1) | (p+1) / 2^(n-1) }
, so we’re
constructing dyadic rationals out of simpler ones. It turns out that
every real number can be written as a(n often infinite) game. To see
how this is possible, notice that the dyadic rationals are dense in
the reals, and we can squeeze every number between two infinite
sequences of dyadic rationals. For example,
2/3 = { 0, 1/2, 5/8, 21/32 ... | ... 43/64, 11/16, 3/4, 1 }
The only reals with finite representations are the dyadic rationals, so we’ll stick with those. Again we’re going to cheat and use Fractional, even though games in general do not have well defined division.
powerOf2 :: (Integral a) => a -> Bool
| n == 0 = True
powerOf2 n | n == 1 = True
| even n = powerOf2 (n `div` 2)
| otherwise = False
dyadic :: Rational -> Bool
= powerOf2 . denominator
dyadic
instance Fractional Game where
fromRational r | denominator r == 1 = fromInteger (numerator r)
| dyadic r = Game [left] [right]
| otherwise = error "Cannot convert non-dyadic Rational to Game"
where newNumerator = (numerator r - 1) `div` 2
= denominator r `div` 2
newDenominator = fromRational (newNumerator % newDenominator)
left = fromRational ((newNumerator + 1) % newDenominator) right
Checking that this works:
-- fromRational (1%4) == fourth ==> True
If you step back, it’s incredible that these games, with such a simple definition, contain all the real numbers and much more besides.
If we’re given a game, we might like to know if it represents a
number. The conditions for this are quite easy; a game is a number if
all its Left and Right options are numbers, and also every Left option
is <
every Right option.
isNumber :: Game -> Bool
Game left right) = all isNumber left
isNumber (&& all isNumber right
&& all (\l -> all (l<) right ) left
-- isNumber zero ==> True
-- isNumber one ==> True
-- isNumber (fromRational (3%8)) ==> True
-- isNumber star ==> False
Non-Numbers
It’s time to go back and look at some strange infinitesimal games.
Let’s consider G = { 0 | ∗ }
, written ↑
. ↑
is clearly positive, as
Left always wins. To see this, note that if Left moves first, he moves
to zero and Right loses. If Right moves first, he has to move to star,
where Left can move to zero and make him lose again. There is of
course an equivalent game, ↓
for Right.
= Game [zero] [star]
up = Game [star] [zero] -- = -up
down
-- up > 0 ==> True
-- down < 0 ==> True
-- isNumber up ==> False
-- isNumber down ==> False
Just how positive is ↑
?
-- up < 1 ==> True
-- up < fromRational (1%2) ==> True
-- up < fromRational (1%4) ==> True
-- up < fromRational (1%8) ==> True
-- up < fromRational (1%16) ==> True
Not very positive. It turns out ↑
is smaller than every positive
number. We can add ↑
to itself as many times as we like and it will
still be infinitesimally small.
↑ > 0
, but how does it compare to ∗
?
-- up > star ==> False
-- up || star ==> True
-- down || star ==> True
∗
’s fuzziness includes both ↑
and ↓
. How about two copies of ↑
?
-- (up + up) > star ==> True
-- (down + down) < star ==> True
So ↑+↑, written ⇑, is no longer confused with ∗.
So far, the games we’ve been considering are all infinitesimally close
to an actual number, as ∗
and all multiples of ↑
are infinitesimally
close to 0. This need not be the case in general, as can be seen in
the game G = { 1 | -1 }
.
= Game [1] [-1] switch
This game is known as a switch game, and is written ±1
. Both players
are desperate to play in this game, as the result for them is much
better than if the other player makes their move first. Compare this
with G = { -1 | 1 } = 0
, where both players would rather not move as
it just makes them one move closer to a loss.
±1
turns out to be fuzzy with all games between -1
and 1
.
-- switch < 2 ==> True
-- switch || 1 ==> True
-- switch || 0 ==> True
-- switch || -1 ==> True
-- switch > -2 ==> True
This makes sense, as if you add ±1
to any game in that range, the
outcome is still determined by whoever gets to play in ±1
first. For
values outside that range, ±1
isn’t enough to tip the scales in the
other player’s favour. For example, ±1 + 2
is still a win for Left,
even if Right goes first and plays ±1
to -1
.
An important class of games is that of all ‘impartial’ games. These are games where both players have the same set of moves they can make. In other words, ‘spinning the board’ has no effect and the result is the same position. One nice example of an impartial game is the game of Nim.
In the game of Nim, the state of the game is represented as a few
piles of chips. A valid move is one that removes some chips from a
single pile. Say we had the piles [2, 4, 5]
, then a valid move could
be to [2, 4, 2]
, reducing the pile of 5 to 2. First let’s represent a
single Nim pile as a game. From a pile of size n, either player can
move to any pile of size less than n. Of course, if the pile has size
0, neither player can do anything. That suggests the following
definition.
nim :: Int -> Game
0 = zero
nim = Game options options
nim n where options = map nim [0..n-1]
The value corresponding to ‘nim n’ is denoted ∗n
, and is called a
nimber. All nimbers (except 0) are fuzzy, as the first player can take
the whole pile and win. Now to build a full Nim position, we just sum
up the values of the individual piles.
nimPiles :: [Int] -> Game
= sum . map nim nimPiles
It’s an amazing fact that every impartial game is equivalent to some
nimber. In particular, the sum of two nimbers is another nimber. We
might hope that this addition works like normal addition, but that’s
not the case. This is obvious when adding a nimber to itself, as
impartial games are their own inverses, meaning two copies of any
nimber sum to zero. We do have that ∗1 + ∗2 = ∗3
:
-- nim 1 + nim 2 == nim 3 ==> True
But because ∗n = -∗n
we can add ∗1
to both sides and get ∗2 = ∗3 + ∗1
.
-- nim 1 + nim 3 == nim 2 ==> True
Nimber-addition turns out to have a XOR like structure, where powers of two in each summand cancel out.
nimPlus :: Int -> Int -> Int
= a `xor` b
nimPlus a b
-- 1 `nimPlus` 3 ==> 2
Even more impressive is that you can define a product on nimbers, meaning impartial games form a field.
Simplifying Games
One issue we’ve skimmed over is that there are lots of different ways
of representing a single game. For example, { 1 | } = { 0, 1 | } = 2
-- Game [one] [] == two ==> True
-- Game [zero, one] [] == two ==> True
We’ve really been using equivalence classes of games. For example, the ‘zero game’ in our abelian group is really the equivalence class of all games equal to zero.
The games we’ve been dealing with have mostly been ‘short’ games; there are only finitely many positions the game can be in. Thankfully, every short game has a unique normal form, the simplest representation of the game. To get to this normal form, two simplifications are used:
The first is removing ‘dominated’ options. Looking back at { 0, 1 | }
,
Left has no reason to ever move to 0 when the better move 1 is
available. In general, if Left has A and B
as options, and A <= B
,
then A
can be removed without changing the value of the game. We have
to be careful here, it’s not a matter of just choosing the ‘maximum’
options, because some moves could be fuzzy with others.
unbeaten :: (a -> a -> Bool) -> [a] -> [a]
= []
unbeaten p [] :xs) = if any (p x) rest then
unbeaten p (x
restelse
: filter (not . flip p x) rest
x where rest = unbeaten p xs
removeDominated :: Game -> Game
= Game left right
removeDominated g where left = unbeaten (<=) (leftMoves g)
= unbeaten (>=) (rightMoves g) right
The other way of simplifying games is by removing ‘reversible’ moves. If Left has a move where Right’s response gives a position better for Right than the original game, then Left’s move is called reversible. If Left decides to make that move, he must anticipate that Right will reverse it into that position that is better for him. We can bypass these and let Left jump straight to what he would do after that.
lReversible :: Game -> Game -> [Game]
= maybe [gl] leftMoves (find (<= g) (rightMoves gl))
lReversible g gl
rReversible :: Game -> Game -> [Game]
= maybe [gr] rightMoves (find (>= g) (leftMoves gr))
rReversible g gr
anyReversible :: Game -> Bool
= any (<= g) (concatMap rightMoves (leftMoves g)) Prelude.|| any (>= g) (concatMap leftMoves (rightMoves g))
anyReversible g
bypassReversible :: Game -> Game
= Game left right
bypassReversible g where left = concatMap (lReversible g) (leftMoves g)
= concatMap (rReversible g) (rightMoves g) right
Now, to simplify a game, we just combine the two operations, then apply the simplification to all of the subgames. We need to repeatedly check for reversible moves, as each round of simplification could expose new ones.
simplifyTop :: Game -> Game
= removeDominated . until (not . anyReversible) (bypassReversible . removeDominated)
simplifyTop
simplify :: Game -> Game
= Game (map simplify (leftMoves s)) (map simplify (rightMoves s))
simplify g where s = simplifyTop g
It can be proven that the game given by the two simplifications always exists and is unique.
Before we can apply what we’ve learned to a real game, we’d like some way to easily read off what the value of a game is, if it happens to correspond to some simple value that we already understand.
Many of the games we find in real play are just the sum of a number, a
multiple of ↑
, and a nimber. Because this is so common, we will
create a new type for it:
data NumberUpStar = NUS { numberPart :: Rational, upPart :: Int, nimberPart :: Int } deriving (Eq, Ord)
= upPart nus == 0 && nimberPart nus == 0 nusIsNumber nus
We can leverage the simplification of games to make it easier to
convert from an arbitrary game to a NumberUpStar
. For example, in a
simplified game, if Left only has one option and Right has none, we
must be dealing with an integer. Many similar rules, when combined,
will give us the function we require.
optionsToNUS :: ([NumberUpStar], [NumberUpStar]) -> Maybe NumberUpStar
-- Zero game
= Just $ NUS 0 0 0
optionsToNUS ([], [])
-- If G = { L | } then L is an integer and G = L + 1
= Just $ NUS (lValue + 1) 0 0
optionsToNUS ([l], []) where lValue = numberPart l
-- If G = { | R } then R is an integer and G = R - 1
= Just $ NUS (rValue - 1) 0 0
optionsToNUS ([], [r]) where rValue = numberPart r
-- If G = { L | R } and L and R are both numbers, G = average of L and R
| nusIsNumber l && nusIsNumber r
optionsToNUS ([l], [r]) && numberPart l < numberPart r = Just $ NUS value 0 0
where value = (numberPart l + numberPart r) / 2
-- Here we are of the form n + { 0 | G }, where G has non-negative ups
| nusIsNumber l && not (nusIsNumber r)
optionsToNUS ([l], [r]) && numberPart l == numberPart r
&& upPart r >= 0
= Just $ NUS (numberPart l) (upPart r + 1) (nimberPart r `nimPlus` 1)
-- Now n + { G | 0 }, where G has non-positive ups
| not (nusIsNumber l) && nusIsNumber r
optionsToNUS ([l], [r]) && numberPart l == numberPart r
&& upPart l <= 0
= Just $ NUS (numberPart r) (upPart l - 1) (nimberPart l `nimPlus` 1)
-- If G = { n, n∗ | n }, G = n↑∗
| nusIsNumber l1 && nusIsNumber r
optionsToNUS ([l1, l2], [r]) && l1 == r && l2 == NUS (numberPart l1) 0 1
= Just $ NUS (numberPart l1) 1 1
-- If G = { n | n, n∗ }, G = n↓∗
| nusIsNumber l && nusIsNumber r1
optionsToNUS ([l], [r1, r2]) && l == r1 && r2 == NUS (numberPart r1) 0 1
= Just $ NUS (numberPart r1) (-1) 1
-- Last possibility to check, we are looking at G = n + ∗k
:ls, r1:rs) | length ls == length rs && nusIsNumber l1
optionsToNUS (l1&& l1 == r1 && nimberOptions = Just $ NUS (numberPart l1) 0 (length ls + 1)
where nimberOptions = all valid (zip3 ls rs [1..])
= l == r && numberPart l == numberPart l1
valid (l, r, i) && upPart l == 0 && nimberPart l == i
= Nothing
optionsToNUS _
nusOptionsFrom :: Game -> Maybe ([NumberUpStar], [NumberUpStar])
= do
nusOptionsFrom g <- mapM simplifiedToNUS (leftMoves g)
left <- mapM simplifiedToNUS (rightMoves g)
right return (sort left, sort right)
-- Assumes the game given to it is simplified
simplifiedToNUS :: Game -> Maybe NumberUpStar
= nusOptionsFrom >=> optionsToNUS simplifiedToNUS
If we have one of these NumberUpStar
s, it’s easy to print out a simple
representation of it. It’s standard when dealing with games to write
3↑∗
for 3 + ↑ + ∗
. We just need to be careful not to confuse this
for, say, adding 3 copies of ↑∗
together.
instance Show NumberUpStar where
show (NUS 0 0 0) = "0"
show (NUS number up star) = numberShow number ++ upShow up ++ starShow star
where numberShow n | n == 0 = ""
| denominator n == 1 = show $ numerator n
| otherwise = "(" ++ show (numerator n) ++ "/" ++ show (denominator n) ++ ")"
| n == 0 = ""
upShow n | n > 0 = replicate n '↑'
| n < 0 = replicate (-n) '↓'
| n == 0 = ""
starShow n | n == 1 = "∗"
| otherwise = "∗" ++ show n
-- show (NUS 0 0 0) ==> "0"
-- show (NUS 3 2 1) ==> "3↑↑∗"
Now, to show a game, we first try to convert it to a NumberUpStar
. If
this fails, we just print its left and right options.
instance Show Game where
show g = string (simplifiedToNUS s)
where s = simplify g
Just nus) = show nus
string (Nothing = "{ " ++ leftString ++ " | " ++ rightString ++ " }"
string = intercalate ", " (map show (leftMoves s))
leftString = intercalate ", " (map show (rightMoves s)) rightString
Finally we have a easy way to identify the games we create. You could try yourself to combine the games we already have. Some of the identities are very surprising!
-- Game [0] [up] ==> ↑↑∗
Toads and Frogs
Now let’s work on analysing a real game. The game of Toads and Frogs is played on a strip of squares. Each square is either empty, or has a Toad or a Frog in it. Whenever it’s lefT’s turn, he can either move a Toad rightwards into an empty space, or hop over a Frog to the right of him to land in an empty space. Right’s move are identical, but moving the fRogs in the other direction.
For example, if our board is in the state [ T _ T F _ ]
, Left could
either move the first Toad like this: [ _ T T F _ ]
or hop the
second Toad like this: [ T _ _ F T ]
. A standard starting board
might look like this [ T T _ _ F F ]
. Let’s use what we’ve developed
above to tell us how to play this.
First we will need a type to represent the state of a square and the board.
data Square = T | F | E deriving (Eq, Show)
type Board = [Square]
Now, given a board, we want to know what moves are possible for each player.
leftTFMoves :: Board -> [Board]
T:E:rest) = ([E,T] ++ rest) : map ([T,E] ++) (leftTFMoves rest)
leftTFMoves (T:F:E:rest) = ([E,F,T] ++ rest) : map ([T,F,E] ++) (leftTFMoves rest)
leftTFMoves (:rest) = map ([x] ++) (leftTFMoves rest)
leftTFMoves (x= [] leftTFMoves []
To find right’s possible moves, we switch the players on the board, find Left’s moves, then switch back.
switchPlayers :: Board -> Board
= reverse . map switch
switchPlayers where switch T = F
F = T
switch E = E
switch
rightTFMoves :: Board -> [Board]
= map switchPlayers . leftTFMoves . switchPlayers rightTFMoves
Now it’s a simple matter to convert a board to a game.
boardToGame :: Board -> Game
= Game (map boardToGame (leftTFMoves b)) (map boardToGame (rightTFMoves b)) boardToGame b
We can use this immediately to find the value of our board:
-- boardToGame [T,T,E,E,F,F] ==> ∗
So if you and a friend are playing on this board, you had better ask to play first!
Some very strange values can appear as positions in Toads and Frogs:
-- boardToGame [T,T,T,F,E,F] ==> { { (1/4) | 0 } | 0 }
-- boardToGame [E,T,T,T,E,F] ==> { 1∗ | 0 }
-- boardToGame [E,T,T,E,F,F,E] ==> { (1/4) | (-1/4) }
You might recognise the last one as ±(1/4)
. The next obvious question
is, what’s the best move from a given position?
bestLeftMove :: Board -> (Board, Game)
= maximumBy (compare `on` snd) movesValues
bestLeftMove b where allMoves = leftTFMoves b
= zip allMoves (map boardToGame allMoves)
movesValues
-- bestLeftMove [E,T,T,E,F,F,E] ==> ([E,T,E,T,F,F,E], (1/4))
With this up your sleeve, you should be able to beat pretty much anyone.
References
For a much better written, much more rigorous and much more entertaining introduction to combinatorial games, see:
- Winning Ways for your Mathematical Plays (Academic Press, 1982) by Berlekamp, Conway and Guy
For an almost unbelievably fast implementation of operations on combinatorial games, see:
- Combinatorial Game Suite: http://cgsuite.sourceforge.net/ by Aaron Siegel