Ширина-первый поиск с использованием монады состояния в Haskell

преобразование графика в Tree ширина-первый немного сложнее, чем просто поиск в ширину граф. Если вы ищете график,вам нужно только вернуться из одной ветви. При преобразовании графика в дерево результат должен включать результаты из нескольких ветвей.

мы можем использовать более общий тип, чем Graph a для того, что мы можем искать или конвертировать в деревья. Мы можем искать или преобразовывать в деревья что угодно с помощью функция a -> [a]. Для Graph мы бы использовали функцию (Map.!) m, где m - это Map. Поиск с помощью таблицы транспозиции имеет подпись типа

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]

преобразование функции в дерево, содержащее каждый достижимый узел на самой ранней глубине, имеет подпись

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

мы можем немного более вообще начать с любого количества узлов и построить Forest который содержит каждый достижимый узел как можно раньше глубина.

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]

Поиск

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

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 p a
                    then Just . reverse $ ancestors'
                    else combine seen queued ancestors' unseen
                    where
                        ancestors' = a:ancestors
                        unseen = filter (flip Set.notMember seen . repr) . expand $ a

состояние, поддерживаемое в приведенном выше алгоритме поиска, является Seq очередь из каких узлов посетить далее и Set узлов, которые уже были видел. Если бы мы вместо этого отслеживали узлы, которые уже были посетил, тогда мы могли бы посетить один и тот же узел несколько раз, если мы найдем несколько путей к узлу на той же глубине. Есть более полное объяснение в ответ я написал эту ширину первого поиска.

мы можем легко написать поиск GraphС точки зрения нашего общего поиска.

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)

мы также можем написать, как искать Trees себя.

import Data.Tree

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

построение деревьев

построение деревьев ширина-первая намного сложнее. К счастью!--88-->Data.Tree уже предоставляет способы построения Trees в ширину первого порядка от монадического разворачиваться. Ширина первого порядка позаботится о очереди, нам нужно будет только отслеживать состояние узлов, которые мы уже видели.

unfoldTreeM_BF тип Monad m => (b -> m (a, [b])) -> b -> m (Tree a). m - это Monad наши расчеты будут в, b это тип данных, которые мы собираемся построить дерево на основе, и a - тип для меток дерева. Чтобы использовать его для построения дерева, нам нужно сделать функцию b -> m (a, [b]). Мы собираемся переименовать a до l на ярлык, и b to a, который мы использовали для наших узлов. Нам нужно сделать a -> m (l, [a]). Для m мы будем использовать State монады от трансформаторы для отслеживания некоторого состояния; состояние будет Set узлов, представление которых r мы уже видели; мы будем использовать State (Set.Set r) монады. В целом, нам нужно предоставить функцию 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)

чтобы построить деревья, мы запускаем вычисление состояния, построенное 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 это nubBy это используетOrd например вместо 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

мы можем написать построение кратчайшего пути деревьев из Graphs с точки зрения нашего общего дерева кратчайшего пути здание

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

мы можем сделать то же самое для фильтрации a Forest только самые короткие пути через Forest.

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