First search using the state monad in Haskell

Question

I recently asked about creating a DFS tree from Graph in Stackoverflow and found out that it can simply be implemented using State Monad.

DFS in haskell

While DFS only needs to track visited nodes, so we can use a “Set” or “List” or some kind of linear data structure to track visited nodes, BFS requires a “visited node structure” and a “queue” to execute.

My pseudo code for BFS is

Q = empty queue T = empty Tree mark all nodes except u as unvisited while Q is nonempty do u = deq(Q) for each vertex v ∈ Adj(u) if v is not visited then add edge (u,v) to T Mark v as visited and enq(v) 

As we can conclude from the pseudo-code, we need to do only 3 processes per iteration.

• queue decompression point
• add all invisible point neighbors to the current child tree of the tree, queue and list of "visited"
• repeat this for the next in line

Since we do not use recursive traversal to find BFS, we need another traversal method, such as a while loop. I looked at the while-hackage package, but it is somewhat outdated.

I assume I need some kind of code like this:

 {-...-} ... = evalState (bfs) ((Set.singleton start),[start]) where neighbors x = Map.findWithDefault [] x adj bfs =do (vis,x:queue)<-get map (\neighbor -> if (Set.member neighbor vis) then put(vis,queue) else put ((Set.insert neighbor vis), queue++[neighbor]) >> (addToTree neighbor) ) neighbors x (vis,queue)<-get while (length queue > 0) 

I understand that this implementation is very erroneous, but it should give a minimalist view of how I believe that BFS should be implemented. Also, I really don't know how to get around using a while loop for do blocks (for example, I have to use a recursive algorithm to overcome it or have to think about a completely different strategy)

Given one of the answers I found in the previous question above, it seems that the answer should look like this:

 newtype Graph a = Graph (Map.Map a [a]) deriving (Ord, Eq, Show) data Tree a = Tree a [Tree a] deriving (Ord, Eq, Show) bfs :: (Ord a) => Graph a -> a -> Tree a bfs (Graph adj) start = evalState (bfs') ((Set.singleton start),[start]) where bfs' = {-part where I don't know-} 

Finally, if such an implementation for BFS using the state monad is not possible for some reason (I believe this is not the case), correct my false assumption.

I saw some examples for BFS in Haskell without using the state monad, but I want to learn more about how the state monad can be processed and I could not find any of the BFS examples implemented using the state monad.

Thanks in advance.

---

EDIT: I came up with some kind of algorithm using the state monad, but I get into an infinite loop.

 bfs :: (Ord a) => Graph a -> a -> Tree a bfs (Graph adj) start = evalState (bfs' (Graph adj) start) (Set.singleton start) bfs' :: (Ord a) => Graph a -> a -> State (Set.Set a) (Tree a) bfs' (Graph adj) point= do vis <- get let neighbors x = Map.findWithDefault [] x adj let addableNeighbors (x:xs) = if Set.member x vis then addableNeighbors(xs) else x:addableNeighbors(xs) let addVisited (vis) (ns) = Set.union (vis) $ Set.fromList ns let newVisited = addVisited vis $ addableNeighbors $ neighbors point put newVisited return (Tree point $ map (flip evalState newVisited) (map (bfs' (Graph adj)) $ addableNeighbors $ neighbors point)) 

EDIT2: With some expense on spatial complexity, I had the decision to get the BFS graph using the graph to return and the queue to process. Although this is not an optimal solution for generating a BFS tree / graph, it will work.

 bfs :: (Ord a) => Graph a -> a -> Graph a bfs (Graph adj) start = evalState (bfs' (Graph adj) (Graph(Map.empty)) [start]) (Set.singleton start) bfs':: (Ord a) => Graph a -> Graph a -> [a] -> State (Set.Set a) (Graph a) bfs' _ (Graph ret) [] = return (Graph ret) bfs' (Graph adj) (Graph ret) (p:points)= do vis <- get let neighbors x = Map.findWithDefault [] x adj let addableNeighbors ns | null ns = [] | otherwise = if Set.member (head ns) vis then addableNeighbors(tail ns) else (head ns):addableNeighbors(tail ns) let addVisited (v) (ns) = Set.union (v) $ Set.fromList ns let unVisited = addableNeighbors $ neighbors p let newVisited = addVisited vis unVisited let unionGraph (Graph g1) (Graph g2) = Graph (Map.union g1 g2) put newVisited bfs' (Graph adj) (unionGraph (Graph ret) (Graph (Map.singleton p unVisited))) (points ++ unVisited) 

EDIT3: I added a conversion function for graph to tree. Running the function in EDIT2 and EDIT3 will lead to the BFS tree. This is not the best algorithm for calculating time, but I find it intuitive and understandable for beginners like me :)

 graphToTree :: (Ord a) => Graph a -> a -> Tree a graphToTree (Graph adj) point = Tree point $ map (graphToTree (Graph adj)) $ neighbors point where neighbors x = Map.findWithDefault [] x adj 

Answer 1

Converting a graph to the width of a Tree bit more complicated than just looking at the width of the graph . If you are looking for a schedule, you only need to return from one branch. When converting a graph to a tree, the result should include results from several branches.

We can use a more general type than Graph a , so that we can search or convert to trees. We can search or transform into trees something with the function a -> [a] . For Graph we will use the function (Map.!) m , where m is a Map . A lookup using a transpose table has a signature of type

 breadthFirstSearchUnseen:: Ord r => (a -> r) -> -- how to compare `a`s (a -> Bool) -> -- where to stop (a -> [a]) -> -- where you can go from an `a` [a] -> -- where to start Maybe [a] 

Converting a function to a tree containing each reachable node at the earliest depth has a signature like

 shortestPathTree :: Ord r => (a -> r) -> -- how to compare `a`s (a -> l) -- what label to put in the tree (a -> [a]) -> -- where you can go from an `a` a -> -- where to start Tree l 

We can start a little more broadly with any number of nodes and build a Forest that contains each reachable node in the near future depth.

 shortestPathTrees :: Ord r => (a -> r) -> -- how to compare `a`s (a -> l) -- what label to put in the tree (a -> [a]) -> -- where you can go from an `a` [a] -> -- where to start [Tree l] 

Search

Performing a conversion to a tree does not help us search, we can perform a search in the first order on the original graph.

 import Data.Sequence (viewl, ViewL (..), (><)) import qualified Data.Sequence as Seq import qualified Data.Set as Set breadthFirstSearchUnseen:: Ord r => (a -> r) -> (a -> Bool) -> (a -> [a]) -> [a] -> Maybe [a] breadthFirstSearchUnseen repr p expand = combine Set.empty Seq.empty [] where combine seen queued ancestors unseen = go (seen `Set.union` (Set.fromList . map repr $ unseen)) (queued >< (Seq.fromList . map ((,) ancestors) $ unseen)) go seen queue = case viewl queue of EmptyL -> Nothing (ancestors, a) :< queued -> if pa then Just . reverse $ ancestors' else combine seen queued ancestors' unseen where ancestors' = a:ancestors unseen = filter (flip Set.notMember seen . repr) . expand $ a 

The state stored in the aforementioned search algorithm represents the Seq queue of which nodes will be visited next, and the Set nodes that have already been noticed. If instead we keep track of nodes that have already been visited, we could visit the same node several times if we find several paths to the node at the same depth. There a more complete explanation in the answer I wrote this breadth of the first search.

We can easily find the Graph search in terms of our general search.

 import qualified Data.Map as Map newtype Graph a = Graph (Map.Map a [a]) deriving (Ord, Eq, Show) bfsGraph :: (Ord a) => Graph a -> (a -> Bool) -> [a] -> Maybe [a] bfsGraph (Graph adj) test = breadthFirstSearchUnseen id test ((Map.!) adj) 

We can also write how to independently search for a Tree .

 import Data.Tree bfsTrees :: (Ord a) => (a -> Bool) -> [Tree a] -> Maybe [a] bfsTrees test = fmap (map rootLabel) . breadthFirstSearchUnseen rootLabel (test . rootLabel) subForest 

Building trees

Building trees wide is a lot harder . Fortunately, Data.Tree already provides ways to build a Tree in first order width from a monodic expansion. The width of the first order will take care of the order, we will only need to track the state for the nodes that we have already seen.

unfoldTreeM_BF is of type Monad m => (b -> m (a, [b])) -> b -> m (Tree a) . m is Monad our calculations will be, b is the data type that we are going to build on the basis of the tree, and a is the type of tree labels. To use it to build a tree, we need to make a function b -> m (a, [b]) . We will rename a to l for the label, and b to a , which we used for our nodes. We need to do a -> m (l, [a]) . For m we will use the State monad from transformers to track the state; the state will be Set nodes whose representation r we have already seen; we will use the State (Set.Set r) monad State (Set.Set r) . In general, we need to provide the function a -> State (Set.Set r) (l, [a]) .

 expandUnseen :: Ord r => (a -> r) -> (a -> l) -> (a -> [a]) -> a -> State (Set.Set r) (l, [a]) expandUnseen repr label expand a = do seen <- get let unseen = filter (flip Set.notMember seen . repr) . uniqueBy repr . expand $ a put . Set.union seen . Set.fromList . map repr $ unseen return (label a, unseen) 

To build trees, we run a state calculation built by unfoldForestM_BF

 shortestPathTrees :: Ord r => (a -> r) -> (a -> l) -> (a -> [a]) -> [a] -> [Tree l] shortestPathTrees repr label expand = run . unfoldForestM_BF k . uniqueBy repr where run = flip evalState Set.empty k = expandUnseen repr label expand 

uniqueBy is a nubBy that uses an Ord instance instead of Eq .

 uniqueBy :: Ord r => (a -> r) -> [a] -> [a] uniqueBy repr = go Set.empty where go seen [] = [] go seen (x:xs) = if Set.member (repr x) seen then go seen xs else x:go (Set.insert (repr x) seen) xs 

We can write the shortest paths to build a tree from Graph in terms of our general construction of the shortest path of a tree

 shortestPathsGraph :: Ord a => Graph a -> [a] -> [Tree a] shortestPathsGraph (Graph adj) = shortestPathTrees id id ((Map.!) adj) 

We can do the same to filter Forest only on the shortest paths through Forest .

 shortestPathsTree :: Ord a => [Tree a] -> [Tree a] shortestPathsTree = shortestPathTrees rootLabel rootLabel subForest 

Answer 2

My decision is based on the working level behind the level (in relation to BFS), see also this question and answer .

General idea: suppose we already know the many elements visited before each level of our BFS in the form of a list of sets. Then we can cross the graph, level by level, update our list of sets, build the Tree exit on this path.

The trick is that after such a bypass of the level by level, we will have many visited elements after each level. And this is the same as the list before each level, only shifted by one. Thus, by linking the node , we can use the shifted output as input for the procedure.

 import Control.Monad.State import qualified Data.Map as M import Data.Maybe (fromMaybe, catMaybes) import qualified Data.Set as S import Data.Tree newtype Graph a = Graph (M.Map a [a]) deriving (Ord, Eq, Show) tagBfs :: (Ord a) => Graph a -> a -> Maybe (Tree a) tagBfs (Graph g) s = let (t, sets) = runState (thread s) (S.empty : sets) in t where thread x = do sets@ (s : subsets) <- get case M.lookup xg of Just vs | not (S.member xs) -> do -- recursively create sub-nodes and update the subsets list let (nodes, subsets') = runState (catMaybes `liftM` mapM thread vs) subsets -- put the new combined list of sets put (S.insert xs : subsets') -- .. and return the node return . Just $ Node x nodes _ -> return Nothing -- node not in the graph, or already visited 

Running tagBfs example2 'b' in the following example

 example2 :: Graph Char example2 = Graph $ M.fromList [ ('a', ['b', 'c', 'd']) , ('b', ['a']) , ('c', []) , ('d', []) ] 

gives

 Just (Node {rootLabel = 'b', subForest = [Node {rootLabel = 'a', subForest = [Node {rootLabel = 'c', subForest = []}, Node {rootLabel = 'd', subForest = []} ]} ]} )