Traversing game state space : more search leads to bad results

I am cross posting this question from codereview as i found that it to be non-responsive.

I am trying to solve a problem which i think is TSP on a 2-D grid. So, i am trying to get the best result that i can. However, looking ahead 1 step is producing better results than looking ahead 2 steps.

The problem is that i have to clean the dirty blocks on a 2-D grid in minimum number of movements either UP, DOWN, LEFT, RIGHT, CLEAN.

Another important thing is that i make a move and then process is restarted with the new state of grid and my new position. so i have to run the algorithm again. This also means that i have to avoid being in loop, which is easy to avoid in case of single process, but need to be guaranteed by the algorithm in case of multiple instances of the process.

In short, i have to make only next_move in my process.

so basic strategy is to find the closest dirty cell to my current position.

To look up ahead 1 step, i would do : for each dirty-cell and find the closest dirty cell to the taken dirty-cell. For 2 step, for every dirty-cell, do a 1 step lookup and find the best move. Similarly for the multiple steps.

However, i am getting higher score when i doing only 1 step lookup but less score for 2 steps lookup. score is calculated by (200 - steps_taken). So, i think something is wrong in my code/strategy.

My Haskell code is :

module Main where
import Data.List 
import Data.Function (on)
import Data.Ord

split sep = takeWhile (not . null) . unfoldr (Just . span (/= sep) . dropWhile (== sep))

getList :: Int -> IO [String]
getList n = if n==0 then return [] else do i <- getLine; is <- getList(n-1); return (i:is)

getBoardPoints :: (Int, Int) -> [String] -> [(Int, Int)]
getBoardPoints (h, w) board = [(x, y) | x <- [0..(h-1)], y <- [0..(w - 1)]
                               , ((board !! x) !! y) == 'd']

getDir :: (Int, Int) -> (Int, Int) -> String
getDir (x, y) (a, b) | a == x && y == b = "CLEAN"
                     | a < x = "UP"
                     | x == a && y < b = "RIGHT"
                     | x == a = "LEFT"
                     | otherwise = "DOWN"

getPos :: String -> (Int, Int)
getPos pos = let a = map (\x -> read x :: Int) (words pos)
                 in ((a !! 0) , (a !! 1))

getSortedPos :: (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
getSortedPos (botX, botY) points = map (\x -> (snd x)) $ sortBy (comparing fst)  [(cost, (a, b)) | (a, b) <- points, 
                                                                             cost <- [manhattanDis (a,b) (botX, botY)]]

excludePoint :: (Ord a) => [a] -> a -> [a]
excludePoint [] _ = []
excludePoint p v = [x | x <- p , x /= v]

-- game is reduce the nodes to one node with the total cost ;
-- reduction : take the next shortest node from the current-node.
playGame :: (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
playGame pos [] = [pos]
playGame startPos points = let nextPos = (head (getSortedPos startPos points))
                           in (nextPos : playGame nextPos (excludePoint points nextPos))

manhattanDis :: (Int, Int) -> (Int, Int) -> Int
manhattanDis (a, b) (x, y) = (abs (a - x) + (abs (b - y)))

-- sum up all the points as they occur.
findCost :: [(Int, Int)] -> Int
findCost seq = sum $ map (\x -> (manhattanDis (fst x) (snd x))) $ zip seq (tail seq)

-- smallCost find the position which gives the smallest overall cost.
smallCost :: [(Int, (Int, Int))] -> (Int, (Int, Int))
smallCost [] = (0, (100, 100))
smallCost [x] = x
smallCost (x:y:xs) | (fst x) <= (fst y) = smallCost (x : xs)
                   | otherwise = smallCost (y : xs)                      

-- take each point and think it as starting pos and play the game with it.
-- this helps us in looking up one step.
findBestMove :: (Int, Int) -> [(Int, Int)] -> Int -> (Int, (Int, Int))
findBestMove startPos  points level 
                                    | level == 0 = smallCost $ map (\x -> (findCost (startPos : (x : (playGame x (excludePoint points x)))), x)) points
                                    | otherwise  = smallCost $ map (\x -> (
                                                                           (findCost (startPos : [x])) +
                                                                           (fst (findBestMove x
                                                                                  (excludePoint points x) (level - 1))),
                                                                           x)) points

next_move :: (Int, Int) -> (Int, Int) -> [String] ->  String
next_move pos dim board = let boardPoints = (getBoardPoints dim board)
                              numPoints = (length boardPoints)
                              -- change the below `deep` to 1 for better results. 
                              deep = if (numPoints > 3) then 2 else if (numPoints == 1) then 1 else (numPoints - 1)                                
                          in if pos `elem` boardPoints then getDir pos pos
                                                       else getDir pos $ snd $ findBestMove pos boardPoints deep


main :: IO()
main = do
    -- Take input
   b <- getLine
   i <- getLine
   let bot = ((read (head s))::Int,(read (head(tail s))::Int)) where s = split (' ') b
   let dim = ((read (head s))::Int,(read (head(tail s))::Int)) where s = split (' ') i
   board <- getList (fst dim)
   -- putStrLn $ show dim
   -- putStrLn $ show $ getBoardPoints dim board
   putStrLn $ next_move bot dim board

I control how deep i can go with variable deep. What am i doing wrong ?