Recientemente, hice una pregunta para construir un árbol DFS desde Graph en Stackoverflow y aprendí que puede implementarse simplemente usando State Monad.

DFS en Haskell

Mientras que DFS requiere rastrear solo los nodos visitados, para que podamos usar 'Establecer' o 'Lista' o algún tipo de estructura de datos lineal para rastrear los nodos visitados, BFS requiere que se realice la estructura de datos 'nodo visitado' y 'cola'.

Mi pseudocódigo para BFS es

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 se puede deducir del pseudocódigo, solo tenemos que hacer 3 procesos por iteración.

punto de cola de la colaagregue todos los vecinos no visitados del punto a la lista secundaria, de cola y 'visitada' del árbol actualrepita esto para el próximo en la cola

Dado que no estamos utilizando el recorrido recursivo para la búsqueda BFS, necesitamos algún otro método transversal como el ciclo while. He buscado el paquete loop-while en hackage, pero parece algo obsoleto.

Lo que supongo es que necesito algún 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)

Entiendo que esta implementación es muy errónea, pero esto debería dar una visión minimalista de cómo creo que BFS debería implementarse. Además, realmente no sé cómo eludir el uso del bucle while para hacer bloques (es decir, ¿debería usar un algoritmo recursivo para superarlo o debería pensar en una estrategia completamente diferente)

Teniendo en cuenta una de las respuestas que he encontrado en la pregunta anterior vinculada anteriormente, parece que la respuesta debería verse así:

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, si tal implementación para BFS usando mónada de estado es imposible debido a alguna razón (que creo que no es así), corrija mi suposición falsa.

He visto algunos de los ejemplos de BFS en Haskell sin usar mónada de estado, pero quiero aprender más sobre cómo se puede procesar la mónada de estado y no pude encontrar ninguno de los ejemplos de BFS implementados usando mónada de estado.

Gracias por adelantado.

EDITAR: se me ocurrió algún tipo de algoritmo usando mónada de estado pero caigo en un bucle 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: con algunos gastos de complejidad espacial, se me ocurrió una solución para obtener el gráfico BFS utilizando el gráfico para regresar y hacer cola para procesar. A pesar de que no es la solución óptima para generar un árbol / gráfico BFS, 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)

EDITAR3: agregué la función de conversión de gráfico a árbol. La función de ejecución en EDIT2 y EDIT3 generará el árbol BFS. No es el mejor algoritmo para calcular el tiempo, pero creo que es intuitivo y fácil de entender para novatos como yo :)

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