WIP: BfsSearch

src/Graph.hs

@@ -1,3 +1,7 @@
+{-# LANGUAGE TupleSections #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Use map once" #-}
 module Graph
   ( DiGraph,
     hasNode,
@@ -15,6 +19,8 @@ module Graph
 where
 
 import qualified Data.AssocMap as M
+import Data.Bifunctor (second)
+import Data.Function ((&))
 import qualified Data.List as L
 
 type DiGraph a = M.AssocMap a [a]
@@ -57,3 +63,36 @@ 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)
+
+data SearchResult a = Unsuccessful | Success (DiGraph a)
+
+bfsSearch :: (Eq a) => DiGraph a -> a -> a -> Maybe [a]
+bfsSearch graph start end
+  | start == end = Just [start]
+  | otherwise = case bfsSearch' ([start], graph, empty) of
+      Unsuccessful -> Nothing
+      Success preds -> Just (findSolution preds)
+
+bfsSearch' :: (Eq a) => SearchState a -> SearchResult a
+bfsSearch' (frontier, graph, preds) =
+  let -- Create a new graph with the frontier nodes removed
+      newGraph = deleteNodes frontier graph
+      neighboursMap =
+        -- Associate each node to its neighbours
+        L.map (\node -> (node, children node graph)) frontier
+          -- Filter the neighbours that are not present on the new graph (does not contain frontier)
+          & L.map (second $ L.filter (`M.member` newGraph))
+
+      predecessors = addPredecessors preds neighboursMap
+   in Unsuccessful
+
+findSolution :: DiGraph a -> [a]
+findSolution _graph = []