HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Revised: AI for 2048 in Haskell

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
revisedhaskellfor2048

Problem

This is a revised version of an AI for the game 2048, written in Haskell.

Link to original thread: Poor AI for 2048 written in Haskell

I think this version is a lot cleaner, thanks to the tips from Benesh.

I would like to know if I'm following best practice guidelines and especially if I made the right choices performance-wise.

I think the program is already a bit slow, and it will become a lot slower if start implementing the randomized aspects of the game.

```
{--

Plays and solves the game 2048

In this implementation the randomized aspects of the game have been removed.

--}
import Data.Time
import Data.List
import Data.Ord
import Data.Maybe
import Control.Monad

emptyGrid :: [Int]
emptyGrid = [ 0 | _ 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 _ [] = []
addTile n (0:grid) = (0 : addTile (n-1) grid)
addTile n (cell:grid) = cell : 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 [Int] -> [Int]
doMove _ []

Solution

I am unfortunately no performance guru, but will take a stab at this as I repeatedly had to make programs faster, and there are no answer yet.

A nitpick : I would have used a type synonym for Grid and Row :

type Grid = [Int]
type Row = [Int]
addTile :: Int -> Grid -> Grid
moveRow :: Row -> Row


This doesn't help too much here, but might make things more obvious in the long run.

Now, considering performance, the choice of a list of integer will make your program hard to optimize. Functions such as this will be really slow :

rotate grid = [ grid !! (a + 4 * b) | a <- [0..3], b <- [0..3] ]


As lists are linked lists, and indexing will traverse all previous elements. Profiling shows that this is the most time consuming function.

I would suggest one or a combination of the following solutions.

Using the ST monad

The ST monad is a strict state monad. It is pretty useful for encapsulating value-mutating algorithms in referentially transparent functions. Basically, you would write algorithms the way you would in C, and the resulting code should be quite efficient. The STArray type might be a good candidate.

Using a library known for its performance

A library such as repa or vector, both are known to be able to generate crazy fast code when the right rewrite rules fire. repa is probably overkill, and hard to understand. You can alter vectors in the ST monad too.

Change your representation

The doMove function takes most of the time. It has an implementation for a single case (MoveLeft), and all other cases rotate the board, run a MoveLeft, and rotate it back. It might be possible to either have specialized implementations for each case, or, perhaps better, to use function composition / modification to skip the rotate / rotate back operations.

Code Snippets

type Grid = [Int]
type Row = [Int]
addTile :: Int -> Grid -> Grid
moveRow :: Row -> Row
rotate grid = [ grid !! (a + 4 * b) | a <- [0..3], b <- [0..3] ]

Context

StackExchange Code Review Q#46760, answer score: 4

Revisions (0)

No revisions yet.