Poor AI for 2048 written in Haskell

Question

I'm learning Haskell and thought it would be fun to write an AI for the game 2048 in Haskell.

In my implementation I got rid of the randomized aspects of the game.

This makes the program deterministic (or pure). However, I don't think it performs very well. It uses a very simple algorithm:

Recurse into all possible moves with depth x and return the number of empty tiles of the result. The move that results in the highest number of empty tiles is seen as the best move.

I use a 16-length List to represent the board. I am afraid that the many list operations make my program very slow, and wonder if there are better ways to solve this.

The code:

{--

Plays and solves the game 2048

--}
import Data.Time
import Control.Monad

emptyGrid :: [Int]
emptyGrid = [ 0 | _ <- [0..15] ]

-- Display the 16-length list as the 4 by 4 grid it represents
gridToString :: [Int] -> String
gridToString []         = ""
gridToString xs         = show (take 4 xs) ++ "\n" ++ gridToString (drop 4 xs)

printGrid :: [Int] -> IO()
printGrid xs            = putStrLn $ gridToString xs

-- Skip n empty tiles before inserting
addTile :: Int -> [Int] -> [Int] 
addTile 0 (0:grid)      = 2 : grid
addTile n []            = []
addTile n (0:grid)      = (0 : addTile (n-1) grid)
addTile n (cell:grid)   = cell : addTile n grid

-- Insert multiple tiles at once
addTiles :: [Int] -> [Int] -> [Int]
addTiles [] grid        = grid
addTiles (n:ns) grid    = addTiles ns (addTile n grid)

-- For one row of the grid, push the non-empty tiles together
-- e.g. [0,2,0,2] becomes [2,2,0,0]
moveRow :: [Int] -> [Int]
moveRow []                  = []
moveRow (0:xs)              = moveRow xs ++ [0]
moveRow (x:xs)              = x : moveRow xs

-- For one row of the grid, do the merge (cells of same value merge)
-- e.g. [2,2,4,4] becomes [4,8,0,0]
-- [2,4,2,2] becomes [2,4,4,0]

mergeRow :: [Int] -> [Int]
mergeRow []                 = []
mergeRow (a:[])             = [a]
mergeRow (a:b:xs)           
    | a == b                = (a + b) : (mergeRow xs) ++ [0]
    | otherwise             = a : mergeRow (b:xs)

-- Rotate the grid to be able to do vertical moving/merging
-- e.g. [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]
-- becomes [0,4,8,12,1,5,9,13,2,6,10,14,3,7,11,15]
rotate :: [Int] -> [Int]
rotate grid = [ grid !! (a + 4 * b) | a <- [0..3], b <- [0..3] ]

-- Use the definitions above to do the moves
move :: Int -> [Int] -> [Int]
move _ []               = []
-- 0=Left, 1=Right, 2=Up, 3=Down
move 0 grid             = mergeRow (moveRow (take 4 grid)) ++ move 0 (drop 4 grid) 
move 1 grid             = reverse (move 0 (reverse grid))
move 3 grid             = rotate (move 0 (rotate grid))
move 2 grid             = reverse (move 3 (reverse grid))

-- Mapping of move-codes to text
moveToString :: Int -> String
moveToString n = ["Left", "Right", "Up", "Down"] !! n

-- Take a turn, i.e. make a move and add a tile
takeTurn :: Int -> [Int] -> [Int]
takeTurn n grid
    | n == -1               = []
    | newGrid /= grid       = newGrid
    | otherwise             = []
    where newGrid = addTile 0 (move n grid)

maxInList :: Ord a => [a] -> a
maxInList (x:xs) = maxInList_ x xs 
maxInList_ :: Ord a => a -> [a] -> a
maxInList_ m [] = m
maxInList_ m (x:xs)     = maxInList_ (max m x) xs

-- Find highest tuple in list of pairs.
-- On equality, the first wins
maxTuple :: [(Int,Int)] -> Int
maxTuple []                 = -1
maxTuple (x:xs)             = secondFromTuple $ maxTuple_ x xs
secondFromTuple :: (a,a) -> a
secondFromTuple (x,y)       = y
maxTuple_ :: Ord a => (a,a) -> [(a,a)] -> (a,a)
maxTuple_ x []              = x
maxTuple_ (a,b) ((y,z):xs)
    | a >= y                = maxTuple_ (a,b) xs
    | otherwise             = maxTuple_ (y,z) xs

-- Return the best possible move
-- TODO: can the seemingly redundancy be eliminated?
bestMove :: Int -> [Int] -> Int
bestMove depth grid         = maxTuple [ (gridValue depth (takeTurn x grid), x) | x <- [0..2], takeTurn x grid /= [] ]

gridValue :: Int -> [Int] -> Int
gridValue _ [] = -1
gridValue 0 grid = length $ filter (==0) grid
gridValue depth grid = maxInList [ gridValue (depth-1) (takeTurn x grid) | x <- [0..2] ]

-- Take turns and prints the result of each move to the console until no more moves are possible
-- n counts the moves
-- Should normally be called with n=0
takeTurns :: Int -> Int -> [Int] -> IO()
takeTurns depth n grid          = do
    let newGrid                 = takeTurn (bestMove depth grid) grid
    if newGrid /= []
        then do
            when (n `rem` 100 == 0) $ putStrLn $ "Move " ++ (show n)
            -- putStrLn $ "Move " ++ (show n)
            -- putStrLn $ gridToString newGrid
            takeTurns depth (n+1) newGrid
        else do
            putStrLn $ gridToString grid
            putStrLn $ "Game Over: " ++ (show n) ++ " Turns"

solve :: Int -> IO()
solve depth = takeTurns depth 0 emptyGrid

solveTenTimes :: Int -> IO()
solveTenTimes 10 = putStrLn "Done"
solveTenTimes n = do
    start <- getCurrentTime
    solve n 
    stop <- getCurrentTime
    putStrLn $ (show n) ++ ": " ++ (show $ diffUTCTime stop start)
    solveTenTimes (n+1)

main = do
    solveTenTimes 0

Edit

I posted a revised version here: Revised: AI for 2048 in Haskell

Answer 1

First of all - way to go! Type signatures, pattern matching, monads - you're clearly on the right track.

Some general tips:

1. Don't reinvent the wheel!

   When you encounter a function that looks like this:

   secondFromTuple :: (a,a) -> a
   secondFromTuple (x,y)       = y
   

   your first thought should be: "wait, that's a really simple and usefuly function. I wonder if it's already in the standard library?". Well, let's search Hoogle for the type signature (a,a)->a: http://www.haskell.org/hoogle/?hoogle=%28a%2Ca%29-%3Ea

   The first result is: snd :: (a, b) -> b, which is actually the right function. snd is even more general than secondFromTuple - the latter won't work on (0,"zero"), for example, because it's type is (Int,String) and secondFromTuple only work on homogenous tuples.

   Another example: maximum is a standard library function that behave just like maxInList. Notice that maxInList [] will result in a pattern match failure while maximum [] will result in an empty list exception.

   Now let's take a look at maxTuple. It takes a list of tuples and return the second item of the tuple with the highest first item. Can we replace it with a standard library function?

   Well, the Data.List module contains maximumBy :: (a -> a -> Ordering) -> [a] -> a. The By family of functions - sortBy,nubBy - are variation of standard function like maximum,sort and nub, which compares items using an external comparison function. Usually, and easy way to create one is with the comparing function from Data.Ord. For example, comparing fst is a function that gets 2 tuples and compares them by the first element. So maximumBy (comparing fst) will return the tuple with the highest first item, and snd will return its second item.

   So we can rewrite maxTuple as maxTuple xs = snd $ maximumBy (comparing fst), or in pointfree style - maxTuple = snd . maximumBy (comparing fst).

   There's one small issue here: One, we don't know how maximumBy resolves ties - if it's an issue, you can modify the solution a little, maybe use sortBy or write a different comparison function.

2. If you need to fail - fail

   maxTuple [] returns -1, and that's not a good idea. maxTuple [(0,-1)] returns -1 as well - how can you tell if it's a valid result?

   If a function encounters an invalid state - you need to report an error. There are several ways to do it - I'll mention two:

   • Throw an error: maxTuple [] = error "maxTuple: empty list". It's the simplest way to do it, and in a small-scale project it's probably the best. The downside is that error-handling is an IO operation, so this error can't be handled in pure code.

   • The Maybe monad:

     maxTuple :: [(Int,Int)] -> Maybe Int
     maxTuple [] = Nothing
     maxTuple xs = Just $ snd $ maximumBy (comparing fst)
     

     This is the safer way to do it. A failure results in Nothing. The caller can then deal with this Nothing instead of simply crashing the program. The downside is that now you need to examine the value of maxTuple before using it, which complicates the code. Data.Maybe and Control.Monad can help with this task.

   You can read more about proper Haskell error handling in this great article.

3. Use data instead of hardcoded values

   Instead of representing directions with 0-3, you can use data:

   data Direction = Left | Right | Up | Down
                    deriving (Show)
   

   Now move is more readable:

   move :: Direction -> [Int] -> [Int]
   ...
   move Left grid  = ...
   move Right grid = ...
   move Down grid  = ...
   move Up grid    = ...
   

   Also, since there's no 5th direction, move 4 results in a pattern match failure. In the new version, there is no such danger.

   Plus, deriving (Show) means we can use show on Direction value - so we get moveToString for free: show Left returns "Left", show Down returns "Down" and so on.

That's it for now. Good luck!