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)

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.