Breadth-first search solves the ladder game by exploring a graph in layers, ensuring the first discovered solution is shortest when every edge has equal cost. section 6.0 section 6.1
Implement the search by maintaining a frontier and recording how each node was reached:
- Start with the graph and starting node as the initial frontier. section 6.1.1
- Collect neighboring nodes for every node in the current frontier. section 6.1.1
- Delete the current frontier from the graph so nodes are not visited twice. section 6.1.1
- Record each frontier node as the predecessor of its newly discovered neighbors. section 6.1.1
- Check whether the target appears among the newly discovered neighbors, then backtrack through predecessors to recover the path. section 6.1.1 section 6.2.3
Solving a word ladder
Given a graph of possible word transformations, search outward from the starting word. Because every transformation has equal cost, the first route reaching the target gives an optimal word ladder. A predecessor graph preserves the route for reconstruction. section 6.0 section 6.1 section 6.2.3
Listing 6.5 Determining the shortest paths in directed graphs with uniform cost
type SearchState a = ([a], DiGraph a, DiGraph a) #1
data SearchResult a = Unsuccessful |
Successful (DiGraph a) #2
bfsSearch :: forall a. Eq a => DiGraph a
-> a -> a -> Maybe [a] #3
bfsSearch graph start end
| start == end = Just [start] #4
| otherwise =
case bfsSearch' ([start], graph, empty) of #5
Successful preds -> Just (findSolution preds) #6
Unsuccessful -> Nothing
where
findSolution :: DiGraph a -> [a]
findSolution g = L.reverse (go end) #7
where
go x =
case children x g of #8
[] -> [x] #9
(v : _) -> x : go v #10
addMultiplePredecessors :: [(a, [a])] -> DiGraph a -> DiGraph a
addMultiplePredecessors [] g = g
addMultiplePredecessors ((n, ch) : xs) g =
addMultiplePredecessors xs (go n ch g) #11
where
go n [] g = g
go n (x : xs) g = go n xs (addEdge (x, n) g) #12
bfsSearch' :: SearchState a -> SearchResult a
bfsSearch' ([], _, preds) = Unsuccessful #13
bfsSearch' (frontier, g, preds) =
let g' = deleteNodes frontier g #14
ch =
L.map
(\n -> (n, L.filter (`M.member` g')
(children n g))) #15
frontier
frontier' = L.concatMap snd ch #16
preds' = addMultiplePredecessors ch preds #17
in if end `L.elem` frontier' #18
then Successful preds' #19
else bfsSearch' (frontier', g', preds') #20
Inspect a complete Haskell implementation that represents search state, distinguishes successful and unsuccessful searches, and reconstructs the path from predecessors. section 6.2.3
