I wrote a 2048 solver in Haskell, mainly because I'm learning this language right now.
My implementation of the game slightly differs from the actual game, in that a new tile is always a '2' (rather than 90% 2 and 10% 4). And that the new tile is not random, but always the first available one from the top left. This variant is also known as Det 2048.
As a consequence, this solver is deterministic.
I used an exhaustive algorithm that favours empty tiles. It performs pretty quickly for depth 1-4, but on depth 5 it gets rather slow at a around 1 second per move.
Below is the code implementing the solving algorithm. The grid is represented as a 16-length array of Integers. And scoring is done simply by counting the number of empty squares.
bestMove :: Int -> [Int] -> Int
bestMove depth grid = maxTuple [ (gridValue depth (takeTurn x grid), x) | x <- [0..3], takeTurn x grid /= [] ]
gridValue :: Int -> [Int] -> Int
gridValue _ [] = -1
gridValue 0 grid = length $ filter (==0) grid -- <= SCORING
gridValue depth grid = maxInList [ gridValue (depth-1) (takeTurn x grid) | x <- [0..3] ]
I thinks it's quite successful for its simplicity. The result it reaches when starting with an empty grid and solving at depth 5 is:
Move 4006
[2,64,16,4]
[16,4096,128,512]
[2048,64,1024,16]
[2,4,16,2]
Game Over
Source code can be found here: https://github.com/popovitsj/2048-haskell