Traversing game state space : more search leads to bad results

Question

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

This problem is avaiable at hackerrank ai. I am not asking for solutions but trying to find what is wrong with my strategy or code.

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.

Input Format :

b represents the bot in grid. - is the clean cell. d is dirty cell.

First Line is pair of ints of bot position. This make b in grid redundant. If bot is currently standing on a dirty cell, d would be present on that cell in grid.

Second Line is dimension of grid.

Third input is grid in row form. Please see the sample input below.

My Haskell code is :

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

-- slits up a string 
-- ** only used in IO. 
split sep = takeWhile (not . null) . unfoldr (Just . span (/= sep) . dropWhile (== sep))
-- ** only used in IO
getList :: Int -> IO [String]
getList n = if n==0 then return [] else do i <- getLine; is <- getList(n-1); return (i:is)

-- find positions of all dirty cells in the board
getAllDirtyCells :: (Int, Int) -> [String] -> [(Int, Int)]
getAllDirtyCells (h, w) board = [(x, y) | x <- [0..(h-1)], y <- [0..(w - 1)]
                               , ((board !! x) !! y) == 'd']

-- finally get the direction to print ;
-- first argument is my-position and second arg is next-position.
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"

-- only used in IO for converting strin gto coordinate.
getPos :: String -> (Int, Int)
getPos pos = let a = map (\x -> read x :: Int) (words pos)
             in ((a !! 0) , (a !! 1))


-- manhattan Distance :  sum of difference of x and y coordinates
manhattanDis :: (Int, Int) -> (Int, Int) -> Int
manhattanDis (a, b) (x, y) = (abs (a - x) + (abs (b - y)))

-- sort the positions from (botX, botY) position on manhattan-distance.
-- does not returns the cost.
getSortedPos :: (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
getSortedPos (botX, botY) points = map (\x -> (snd x)) $ 
                                   sortBy (comparing fst)  -- compare on the basis of cost.
                                              [(cost, (a, b)) | 
                                                     (a, b) <- points, 
                                                     cost <- [manhattanDis (a,b) (botX, botY)]]
-- exclude the point `v` from the list `p`
excludePoint :: (Ord a) => [a] -> a -> [a]
excludePoint [] _ = []
excludePoint p v = [x | x <- p , x /= v]

-- playGame uses the nearest-node-policy. 
-- we start playing game when we are not going more deep. 
-- more about that in findBestMove
-- game is to 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))

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

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

-- This is actual move-finder. It does the lookups upto `level` deep.
-- from startpoint, take each point and think it as starting pos and play the game with it.
-- this helps us in looking up one step.
-- when level is 0, just use basic `playGame` strategy. 
findBestMove :: (Int, Int) -> [(Int, Int)] -> Int -> (Int, (Int, Int))
findBestMove startPos  points level 
                                    -- returns the move that takes the smallest cost i.e. total distances.
                                    | level == 0 = smallestCostMove $ 
                                                     -- return pair of (cost-with-node-x-playGame, x)
                                                     map (\x -> (findCost (startPos : (x : (playGame x (excludePoint points x)))), 
                                                                x)) 
                                                         points
                                    | otherwise  = smallestCostMove $ 
                                                     map (\x -> 
                                                           -- return pair of (cost-with-node-x, x)
                                                            ( (findCost (startPos : [x])) + 
                                                              -- findBestMove returns the pair of (cost, next-move-from-x)
                                                              (fst (findBestMove x (excludePoint points x) (level - 1))),
                                                             x)) 
                                                         points

-- next_move is our entry point. go only 2 level deep for now, as it can be time-expensive.
next_move :: (Int, Int) -> (Int, Int) -> [String] ->  String
next_move pos dim board = let boardPoints = (getAllDirtyCells dim board)
                              numPoints = (length boardPoints)
                              -- ** Important : This is my question :
                              -- 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
   -- bot contains (Int, Int) : my-coordinates. like (0,0)
   let botPos = (read $ head s::Int,read $ head $ tail s::Int) where s = split (' ') b
   -- dimOfBoard contains dimension of board like (5,5)
   let dimOfBoard = (read $ head s::Int, read $ head $ tail s::Int) where s = split (' ') i
   board <- getList (fst dimOfBoard)
   putStrLn $ next_move botPos dimOfBoard board

I control how deep i can go with variable deep.

Sample board is :

0 0
5 5
b---d
-d--d
--dd-
--d--
----d

There can be three answers :

Output :

RIGHT or DOWN or LEFT

Important : Again new process would be called with new board and my bot new position, till i clean all the dirty cells.

What am i doing wrong ?

Answer 1

After a lot of work I found an example where the best path determined by findBestMove at level 1 returns a worse path than when called with level set to 0:

 points = [(6,8),(9,7),(9,4),(4,10),(4,6),(7,10),(5,7),(2,4),(8,8),(6,5)]
 start: (1,10)

  level = 0:
    cost: 31
    path: [(1,10),(4,10),(7,10),(5,7),(6,8),(8,8),(9,7),(9,4),(6,5),(4,6),(2,4)]

  level = 1:
    cost: 34
    path: [(1,10),(2,4),(6,5),(6,8),(5,7),(4,6),(4,10),(7,10),(8,8),(9,7),(9,4)]

The problem is that playGame explores only one of the best possible moves. I've found that your algorithm becames more stable if you explore all of the best possible moves like this:

 greedy start [] = 0
 greedy start points =
   let sorted@((d0,_):_) = sort [ (dist start x, x) | x <- points ]
       nexts = map snd $ takeWhile (\(d,_) -> d == d0) sorted
   in d0 + minimum [ greedy n (delete n points)  | n <- nexts ]

Here greedy combines findCost and playGame. By only looking at the first move in the sorted list playGame is dependent on the sorting algorithm and the ordering of the points.

You can also write bestMove like this:

 bestMove _ start [] = (0,start)
 bestMove depth start points
   | depth == 0 = minimum [ (d0+d,x) | x <- points,
                              let d0 = dist start x,
                              let d = greedy x (delete x points) ]
   | otherwise  = minimum [ (d0+d,x) | x <- points,
                              let d0 = dist start x,
                              let (d,_) = bestMove (depth-1) x (delete x points  ) ]

and this highlights the symmetry between the two cases more clearly.

Here is the code I used to find and display the best path for the above board: http://lpaste.net/121294 To use it just put your code in the module named Ashish.

Finally my instincts tells me that your approach may not be a sound way to solve the problem. What you are doing is similar to the A*-algorithm with playGame playing the role of the heuristic function. However, in order for A* to work, the heuristic function should not over estimate the shortest distance. But playGame always gives you an upperbound on the shortest distance. Anyway - it's something to consider.