BFS implementation that walks a tile-based field

Question

I wrote a BFS implementation that walks a tile-based field. It takes a function that should return true for walkable tiles and false for walls. It also takes the start and end points. It currently takes about 5 seconds to find the shortest path from (0, 0) to (1000, 1000) which isn't bad, but it really isn't great.

import qualified Data.HashSet as H
import Data.Maybe (mapMaybe, isNothing)
import Data.List (foldl')
bfs :: 
 (Int -> Int -> Bool) -> -- The field function. Returns True if tile is empty, False if it's a wall
 (Int, Int) -> -- Starting position
 (Int, Int) -> -- Final position
 Int -- Minimal steps
bfs field start end = minSteps H.empty [start] 0
 where 
 minSteps visited queue steps
 |end `elem` queue = steps + 1
 |otherwise = minSteps newVisited newQueue (steps + 1)
 where
 (newVisited, newQueue) = foldl' aggr (visited, []) queue
 aggr (vis, q) node = if H.member node vis
 then (H.insert node vis, neighbors node ++ q)
 else (vis, q)
 neighbors (nx, ny) = filter (uncurry field) $ map (\(x, y) -> (nx + x, ny + y)) [(1, 0), (0, -1), (-1, 0), (0, 1)]
hugeField x y = x >= 0 && x <= 1000 && y >= 0 && y <= 1000
main = print $ bfs hugeField (0, 0) (1000, 1000)

• max taldykin: it seems you accidentally swapped then and else parts of the condition

Answer 1

I managed to make it five times faster but my solution uses some ad-hoc hacks.

First, I replaced queue with a set. This makes checking for solution faster and allows to update visited with single set-union operation.

bfs field start end = minSteps H.empty (H.singleton start) 0
 where 
 minSteps visited queue steps
 |end `H.member` queue = steps + 1
 |otherwise = minSteps newVisited newQueue (steps + 1)
 where
 -- add whole frontier to visited set
 newVisited = queue `H.union` visited
 -- make next frontier from non-visited neighbors
 newQueue
 = H.fromList (concatMap neighbors $ H.toList queue)
 `H.difference` newVisited

This change makes the program slightly slower but it allows further optimizations.

Now to the ugly hack. Assuming you are on 64-bit machine and coordinates of empty tiles are in the range [0..2^31), it is possible to pack pair of coordinates into single Int. This will reduce memory footprint, improve cache locality and simplify hash calculation.

Here are two functions to pack/unpack coordinates:

enc :: (Int,Int) -> Int
enc (x,y) = shiftL (x .&. 0xFFFFFFFF) 32 .|. (y .&. 0xFFFFFFFF)
dec :: Int -> (Int, Int)
dec z = (shiftR z 32, z .&. 0xFFFFFFFF)

Use them to store packed coordinates in visited and queue and this will give you small improvement over the original code.

So, we made some ugly changes but gained very small speedup. Now it's time for magic. Changing single line of code will make the code 5 times faster.

Just import Data.IntSet instead of Data.HashSet.
Here is full code:

import qualified Data.IntSet as H
import Data.Bits
bfs field start end = minSteps H.empty (H.singleton $ enc start) 0
 where
 minSteps visited queue steps
 |enc end `H.member` queue = steps + 1
 |otherwise = minSteps newVisited newQueue (steps + 1)
 where
 newVisited = queue `H.union` visited
 newQueue
 = H.fromList (concatMap (map enc.neighbors.dec) $ H.toList queue)
 `H.difference` newVisited
 neighbors (nx, ny)
 = filter (uncurry field)
 $ map (\(x, y) -> (nx + x, ny + y))
 [(1, 0), (0, -1), (-1, 0), (0, 1)]
enc :: (Int,Int) -> Int
enc (x,y) = shiftL (x .&. 0xFFFFFFFF) 32 .|. (y .&. 0xFFFFFFFF)
dec :: Int -> (Int, Int)
dec z = (shiftR z 32, z .&. 0xFFFFFFFF)
hugeField x y = x >= 0 && x <= 1000 && y >= 0 && y <= 1000
main = print $ bfs hugeField (0, 0) (1000, 1000)

The reason of such a speedup is that IntSet represents dense sets in much more compact form than HashSet. And this makes union and difference faster.