# Poor AI for 2048 written in Haskell

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

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 ++  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) ++  | 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 ## 1 Answer 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.

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!

• Thanks for your feedback! I'll definately be upgrading my code with your advice. You're right about using library functions... I don't really know my way in the Haskell libraries yet. – wvdz Apr 7 '14 at 23:02
• I implemented your feedback and posted a revised version of my code here: codereview.stackexchange.com/questions/46760/… It would be great if you could take a look at it! – wvdz Apr 9 '14 at 21:59
• Well done! As for the performance issue - have you tried profiling it? GHC has some profiling tools (which I've never used myself) – Benesh Apr 10 '14 at 8:35
• You have a point! – wvdz Nov 3 '14 at 14:39