mirror of
https://codeberg.org/JasterV/word-ladder.hs.git
synced 2026-04-26 18:10:06 +00:00
fix bfsSearch
This commit is contained in:
parent
34dcf329d5
commit
b0dc140299
1 changed files with 7 additions and 7 deletions
14
src/Graph.hs
14
src/Graph.hs
|
|
@ -68,12 +68,6 @@ deleteEdge (node, child) = M.alter aux node
|
|||
deleteEdges :: (Eq a) => [(a, a)] -> DiGraph a -> DiGraph a
|
||||
deleteEdges edges graph = foldr deleteEdge graph edges
|
||||
|
||||
addMultiplePredecessors :: (Eq a) => [(a, [a])] -> DiGraph a -> DiGraph a
|
||||
addMultiplePredecessors [] graph = graph
|
||||
addMultiplePredecessors ((node, childs) : xs) graph =
|
||||
let edges = L.map (,node) childs
|
||||
in addMultiplePredecessors xs (addEdges edges graph)
|
||||
|
||||
type SearchState a = ([a], DiGraph a, DiGraph a)
|
||||
|
||||
type SearchResult a = Maybe (DiGraph a)
|
||||
|
|
@ -90,6 +84,12 @@ bfsSearch initialGraph start end
|
|||
[] -> [node]
|
||||
(x : _) -> node : aux x
|
||||
|
||||
addMultiplePredecessors :: [(a, [a])] -> DiGraph a -> DiGraph a
|
||||
addMultiplePredecessors [] graph = graph
|
||||
addMultiplePredecessors ((node, childs) : xs) graph =
|
||||
let edges = L.map (,node) childs
|
||||
in addMultiplePredecessors xs (addEdges edges graph)
|
||||
|
||||
bfsSearch' :: SearchState a -> SearchResult a
|
||||
bfsSearch' ([], _, _) = Nothing
|
||||
bfsSearch' (frontier, graph, predecessors) =
|
||||
|
|
@ -109,7 +109,7 @@ bfsSearch initialGraph start end
|
|||
frontier' = L.concatMap snd neighboursMap
|
||||
in if end `L.elem` frontier'
|
||||
then
|
||||
Just predecessors
|
||||
Just predecessors'
|
||||
else
|
||||
bfsSearch' (frontier', graph', predecessors')
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue