2048 Solver in Haskell

This is a very simple solver for the popular puzzle game 2048 written in Haskell.

It was written as a way of exercising with the Haskell language, and to experiment with game solution concepts.

In the terminal output, the tiles are shown as an hex encoded exponent of base 2, so for instance

• 1 is 2
• 2 is 4
• 3 is 8
• ...
• 9 is 512
• A is 1024
• B is 2048

Solver details

The solver uses the backward induction solution concept. From a game theory perspective, we are tackling a dynamic game of complete information, where we (the player) compete against the nature, which randomly choses a location to drop a new tile in.

The solver works as follows: given a maximum game tree depth to explore (currently set to 3), backward induction is applied (without discounting) in order to find the best action to take now. Since the depth is limited, for obvious computational reasons, and we are not using discounting (which would instead allow for a justified truncation at a specific point), it is required to have a non-recursive scoring function which only looks at a specific state of the game in a "static" way. In such scenario, the computation of the score goes as follows:

scoreAtZeroDepth :: Board -> Float
scoreAtZeroDepth board =
    let 
        sEmpty = length $ filter (isNothing . snd) $ Game.locations board
        sHighest = maximum $ catMaybes $ concat board
    in
    fromIntegral (sEmpty + sHighest * 4)

i.e. by adding together the number of empty tiles and the highest exponent multiplied by a factor of 4. This seems to be a good-enough heuristic, and leads the solver to the completion of the game (the tile 2048 is obtained).

Otherwise, at a generic game tree depth, the score function computes the score the solver would obtain by recursively choosing the best move at each step, and computing the expectation over every possible random nature's move.

Implementation details

Here I note a few implementation details, for later self-reference.

The game itself is implemented in Game.hs, where we have a way to apply a move to a board:

move :: Move -> Board -> Board

or query if we reached the end of a game:

endGame :: Board -> Bool

and so on...

The solver is implemented in Main.hs, where the following recursive function

score :: Int -> Game.Board -> Float

is used to compute a score for a given board, stopping at a given game tree depth. The following functions are then part of the mutual recursion (together with the score function) and are respectively used to compute the score associated to the "final" (within the chosen depth limit) outcome of chosing a specific action right now, recursively choosing the best action at each player move (after nature's move).

scoredMoves :: Int -> Game.Board -> [(Game.Move, Float)]
bestMove :: Int -> Game.Board -> (Game.Move, Float)

Playing a game is then just a matter of initializing a game board and iteratively:

• computing the best move
• applying the best move
• making nature play (i.e. random drop of the new tile)
• check if the game is over, if so: fail/restart
• else: repeat with the updated game board

Limitations

Currently the game implementation is not perfect: only tiles of value 2 randomly drop in the game board, instead of a random choice between 2 and 4.

Most importantly, the solver is quite slow (since it has not been optimized at all) and is single threaded. These would be a couple of first good points to tackle if I were to improve this small project.

Otherwise, it was intended from the beginning as a very small learning experience and proof of concept (it was written in a couple of hours) and as such I'm happy with the result.

Compiling and running

An Haskell + Cabal installation is required, then it's enough to run

$ cabal run