Recentemente, fiz uma pergunta para criar a árvore DFS a partir do Graph no Stackoverflow e aprendi que ela pode ser simplesmente implementada usando a State Monad.

DFS em haskell

Enquanto o DFS exige rastrear apenas os nós visitados, para que possamos usar 'Set' ou 'List' ou algum tipo de estrutura de dados linear para rastrear os nós visitados, o BFS exige que a estrutura de dados do 'nó visitado' e da 'fila' seja realizada.

Meu pseudocódigo para BFS é

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)

Como pode ser inferido a partir do pseudocódigo, precisamos apenas fazer 3 processos por iteração.

desenfileirar ponto da filaadicione todos os vizinhos não visitados do ponto à lista filho, fila e 'visitada' da árvore atualrepita isso para o próximo na fila

Como não estamos usando a passagem recursiva para pesquisa BFS, precisamos de algum outro método de passagem, como o loop while. Procurei um pacote loop-while no hackage, mas parece um pouco obsoleto.

O que suponho é que exijo algum tipo de código como este:

{-...-}
... =   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)

Entendo que essa implementação é muito errônea, mas isso deve fornecer uma visão minimalista de como acho que o BFS deve ser implementado. Além disso, eu realmente não sei como burlar o uso do loop while para blocos do tipo. (Ou seja, devo usar o algoritmo recursivo para superá-lo ou devo pensar em uma estratégia completamente diferente)

Considerando uma das respostas que encontrei na pergunta anterior vinculada acima, parece que a resposta deve ser assim:

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-}

Finalmente, se tal implementação para o BFS usando a mônada de estado for impossível devido a algum motivo (que eu acredito que não seja), corrija minha falsa suposição.

Eu já vi alguns exemplos de BFS em Haskell sem usar a mônada de estado, mas quero aprender mais sobre como a mônada de estado pode ser processada e não consegui encontrar nenhum exemplo de BFS implementado usando a mônada de estado.

Desde já, obrigado.

Edição: Eu vim com algum tipo de algoritmo usando estado monad, mas eu cair no loop infinito.

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: Com algumas despesas de complexidade de espaço, criei uma solução para obter o gráfico BFS usando o gráfico para retornar e enfileirar para processar. Apesar de não ser a solução ideal para gerar uma árvore / gráfico de BFS, ela funcionará.

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: Eu adicionei a função converter para gráfico em árvore. A função Running no EDIT2 e EDIT3 produzirá a Árvore BFS. Não é o melhor algoritmo para o tempo de computação, mas acredito que é intuitivo e fácil de entender para iniciantes como eu :)

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