Недавно я задал вопрос о построении дерева DFS из Graph в Stackoverflow и узнал, что его можно просто реализовать с помощью State Monad.

DFS в хаскеле

В то время как DFS требует отслеживать только посещенные узлы, чтобы мы могли использовать 'Set' или 'List' или какую-либо линейную структуру данных для отслеживания посещенных узлов, BFS требует, чтобы была выполнена структура данных 'посещенный узел' и 'очередь'.

Мой псевдокод для 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)

Как можно заключить из псевдокода, нам нужно выполнить только 3 процесса за одну итерацию.

точка отвода от очередидобавить всех непосещенных соседей точки в дочерний список, очередь и список посещенных деревьев текущего дереваповторите это для следующего в очереди

Поскольку мы не используем рекурсивный обход для поиска BFS, нам нужен какой-то другой метод обхода, такой как цикл while. Я посмотрел зацикленный пакет в hackage, но это кажется несколько устаревшим.

Я предполагаю, что мне нужен какой-то код вроде этого:

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

Я понимаю, что эта реализация очень ошибочна, но это должно дать минималистическое представление о том, как я думаю, что BFS должна быть реализована. Кроме того, я действительно не знаю, как обойти использование цикла while для блоков do (то есть я должен использовать рекурсивный алгоритм для его преодоления или придумать совершенно другую стратегию)

Учитывая один из ответов, которые я нашел в предыдущем вопросе, связанном выше, кажется, что ответ должен выглядеть следующим образом:

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

Наконец, если такая реализация для BFS, использующая монаду состояния, невозможна по какой-либо причине (что, я считаю, не так), пожалуйста, исправьте мое неверное предположение.

Я видел некоторые примеры BFS в Haskell без использования монады состояний, но я хочу узнать больше о том, как можно обрабатывать монаду состояний, и не смог найти ни одного из примеров BFS, реализованных с использованием монады состояний.

Заранее спасибо.

РЕДАКТИРОВАТЬ: я придумал какой-то алгоритм с использованием монады состояния, но я падаю в бесконечный цикл.

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

РЕДАКТИРОВАТЬ 2: С некоторыми затратами из-за сложности пространства, я предложил решение для получения графа BFS, используя граф для возврата и очереди для обработки. Несмотря на то, что это не оптимальное решение для генерации дерева / графика BFS, оно будет работать.

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: я добавил функцию преобразования для графа в дерево. Запуск функции в EDIT2 и EDIT3 приведет к BFS Tree. Это не лучший алгоритм для вычисления времени, но я считаю, что он интуитивно понятен и прост для понимания новичков, как я :)

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