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 HaskellI 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 2048In this implementation the randomized aspects of the game have been removed.--}import Data.Timeimport Data.Listimport Data.Ordimport Data.Maybeimport Control.MonademptyGrid :: [Int]emptyGrid = [ 0 | _ <- [0..15] ]-- Display the 16-length list as the 4 by 4 grid it representsgridToString :: [Int] -> StringgridToString []         = gridToString xs         = show (take 4 xs) ++ \n ++ gridToString (drop 4 xs)printGrid :: [Int] -> IO()printGrid xs            = putStrLn $ gridToString xs-- Skip n empty tiles before insertingaddTile :: Int -> [Int] -> [Int] addTile 0 (0:grid)      = 2 : gridaddTile _ []            = []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 <- [0..3], b <- [0..3] ]data Move = MoveLeft | MoveRight | MoveUp | MoveDown    deriving (Show)allMoves :: [Move]allMoves = [MoveLeft, MoveRight, MoveUp, MoveDown]-- Use the definitions above to do the movesdoMove :: Move -> [Int] -> [Int]doMove _ []             = []doMove MoveLeft grid    = mergeRow (moveRow (take 4 grid)) ++ doMove MoveLeft (drop 4 grid) doMove MoveRight grid   = reverse (doMove MoveLeft (reverse grid))doMove MoveUp grid      = rotate (doMove MoveLeft (rotate grid))doMove MoveDown grid    = reverse (doMove MoveUp (reverse grid))-- Take a turn, i.e. make a move and add a tile-- Return Nothing if the move is not legaltakeTurn :: Move -> [Int] -> Maybe [Int]takeTurn move grid    | movedGrid == grid = Nothing    | otherwise         = Just $ addTile 0 movedGrid    where movedGrid = doMove move grid-- Return the best move-- Will throw an error if there are no valid movesbestMove :: Int -> [Int] -> MovebestMove depth grid     = snd bestValueMove    where         valueMoves      = [ (value, move) |                            move    <- allMoves,                            newGrid <- [ takeTurn move grid ],                            value   <- [ gridValue depth (fromJust newGrid) ],                            newGrid /= Nothing ]        bestValueMove   = maximumBy (comparing fst) valueMoves-- <<< I decided not to return Nothing on a dead end, because then we can no longer-- distinguish dead ends at different depths from eachother. >>>---- Return the value of the grid,-- + 1 for each depth traversed-- -100 if a Game Over position is reachedgridValue :: Int -> [Int] -> IntgridValue depth grid    | depth == 0        = length $ filter (==0) grid    | values == []      = -100    | otherwise         = maximum values    where        values          = [ value |                             move    <- allMoves,                            newGrid <- [ takeTurn move grid ],                            value   <- [ gridValue (depth-1) (fromJust newGrid) + 1],                            newGrid /= Nothing ]gameOver :: [Int] -> BoolgameOver grid       = all (==Nothing) ([ takeTurn move grid | move <- allMoves ])-- 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=0takeTurns :: Bool -> Int -> Int -> [Int] -> IO()takeTurns isVerbose depth n grid = do    when (isVerbose || isGameOver)      $ putStrLn $ gridToString grid ++ \n#  ++ (show n)    when (isVerbose && not isGameOver)  $ putStrLn $ (show move)    when (not isGameOver)               $ takeTurns isVerbose depth (n+1) newGrid    where        isGameOver  = gameOver grid        move        = bestMove depth grid        newGrid     = fromJust $ takeTurn move grid-- Solves at depth and only prints # of moves and final gridsolveSilent :: Int -> IO()solveSilent depth = takeTurns False depth 0 (addTile 0 emptyGrid)-- Solves at depth and prints all boards and movessolve :: Int -> IO()solve depth = takeTurns True depth 0 (addTile 0 emptyGrid)-- Solve and time the solver for multiple depth settings from start to endsolveDepths :: Int -> Int -> IO()solveDepths start end    | start <= end = do            startTime <- getCurrentTime            solveSilent start            stopTime <- getCurrentTime            putStrLn $ Depth  ++ (show start) ++  done in  ++ (show $ diffUTCTime stopTime startTime)            solveDepths (start+1) end    | otherwise = putStrLn -main = solveDepths 1 3
Revised: AI for 2048 in Haskell
haskell;ai