Breitensuche mit Staatsmonade in Haskell

or kurzem habe ich eine Frage zum Erstellen eines DFS-Baums aus Graph in Stackoverflow gestellt und festgestellt, dass dies einfach mit State Monad implementiert werden kan

DFS in haskell

Während DFS nur besuchte Knoten nachverfolgen muss, damit 'Set' oder 'List' oder eine Art lineare Datenstruktur zum Nachverfolgen besuchter Knoten verwendet werden kann, muss für BFS die Datenstruktur 'visited node' und 'queue' ausgeführt werden.

Mein Pseudocode für BFS ist

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)

Wie aus dem Pseudocode abgeleitet werden kann, müssen pro Iteration nur drei Prozesse ausgeführt werden.

dequeue point from queueadd alle nicht besuchten Nachbarn des Punkts zu aktuellem Baumkind, Warteschlange und Besuchslistewiederhole dies für den nächsten in der Warteschlange

Da wir für die BFS-Suche kein rekursives Traversal verwenden, benötigen wir eine andere Traversal-Methode, z. B. while-Schleife. Ich habe Loop-While-Paket in Hackage nachgeschlagen, aber es scheint etwas veraltet zu sein.

Ich gehe davon aus, dass ich einen Code wie diesen benötige:

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

Ich verstehe, dass diese Implementierung sehr fehlerhaft ist, aber dies sollte einen minimalistischen Überblick darüber geben, wie BFS meiner Meinung nach implementiert werden sollte. Außerdem weiß ich wirklich nicht, wie ich die while-Schleife für do-Blöcke umgehen soll (d. H. Sollte ich rekursive Algorithmen verwenden, um sie zu überwinden, oder sollte ich mir eine völlig andere Strategie überlege

Betrachtet man eine der Antworten, die ich in der oben verlinkten vorherigen Frage gefunden habe, so sollte die Antwort wie folgt aussehen:

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, wenn eine solche Implementierung für BFS mit state monad aus irgendeinem Grund unmöglich ist (was ich glaube nicht zu sein), korrigieren Sie bitte meine falsche Annahme.

Ich habe einige Beispiele für BFS in Haskell gesehen, ohne State Monad zu verwenden, möchte aber mehr darüber erfahren, wie State Monad verarbeitet werden kann und ich konnte keine Beispiele für BFS finden, die mit State Monad implementiert wurden.

Danke im Voraus

EDIT: Ich habe mir einen Algorithmus ausgedacht, der die State-Monade verwendet, aber ich falle in eine Endlosschleife.

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: Mit einigem Aufwand an Platzkomplexität habe ich eine Lösung gefunden, mit der BFS-Diagramme mithilfe von Diagrammen zurückgegeben und in die Warteschlange gestellt werden können. Obwohl dies nicht die optimale Lösung zum Generieren eines BFS-Baums / Diagramms ist, funktioniert es.

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: Ich habe die Konvertierungsfunktion für Diagramm in Baum hinzugefügt. Wenn Sie die Funktion in EDIT2 und EDIT3 ausführen, erhalten Sie den BFS-Baum. Es ist nicht der beste Algorithmus für die zeitliche Berechnung, aber ich glaube, es ist intuitiv und für Neulinge wie mich leicht zu verstehen:)

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

Antworten auf die Frage(4)

Ihre Antwort auf die Frage