Обнаружение циклов графика (возможно, направленного или неориентированного) в Haskell

Ответ 1

Прежде всего, существует тип данных для хранения Графов в Haskell; он назывался Data.Graph.Graph в пакете containers. Он использует Data.Array вместо списка, но в остальном идентичен вашему представлению.

type Graph = Array Int [Int]

Это представление приводит к гораздо более эффективным графикам, а также использует гораздо меньше памяти. Я использую эту библиотеку следующим образом:

import Data.Graph (Graph)
import qualified Data.Graph as Graph
import Data.Array

Вы, по-видимому, знаете минимальные и максимальные узлы вашего графика; если нет, эта функция вычисляет их для вас и создает Graph:

makeGraph :: [(Node, [Node])] -> Graph
makeGraph list =
  array (minimum nodes, maximum nodes) list
  where
    nodes = map fst list

Чтобы узнать, является ли node частью цикла, необходимо проверить, могут ли узлы, доступные из одного node, за исключением самого node, содержать node. Можно использовать функцию reachable для получения узлов, достижимых из заданного node (включая node). Так как a Graph является Array, можно использовать assocs, чтобы вернуть список, из которого он был построен, с типом [(Node, [Node])]. Мы используем эти три факта для построения двух функций:

-- | Calculates all the nodes that are part of cycles in a graph.
cyclicNodes :: Graph -> [Node]
cyclicNodes graph =
  map fst . filter isCyclicAssoc . assocs $ graph
  where
    isCyclicAssoc = uncurry $ reachableFromAny graph

-- | In the specified graph, can the specified node be reached, starting out
-- from any of the specified vertices?
reachableFromAny :: Graph -> Node -> [Node] -> Bool
reachableFromAny graph node =
  elem node . concatMap (Graph.reachable graph)

Если вы заинтересованы в том, как работает функция reachable, я мог бы пройти через все это здесь, но это довольно прямолинейно, чтобы понять, когда вы смотрите на код.

Эти функции очень эффективны, но они могут быть значительно улучшены в зависимости от того, как вы хотите, чтобы циклы были представлены в конце. Вы можете, например, использовать функцию stronglyConnComp в Data.Graph, чтобы получить более упорядоченное представление.

Обратите внимание, что я злоупотребляю тем, что Node ~ Graph.Vertex ~ Int в этом случае, поэтому, если ваш тип изменения Node, вам нужно использовать соответствующие функции преобразования в Data.Graph, например graphFromEdges, чтобы получить Graph и связанные с ним функции преобразования.

Библиотека fgl - еще одна альтернатива, которая также предоставляет полный набор связанных с графиком функциональных возможностей, которые чрезвычайно оптимизированы.

Ответ 2

Существует наивный способ его попробовать, который выглядит так:

route :: Graph -> Label -> Label -> Bool
route g dest from | from == dest = True
route g dest from = any (route g dest) (neighbours g from)

Но это не получается при циклических графах. (Я также предполагаю, что вы определили соседей)

Итак, что делать, но передавать список уже увиденных узлов через.

route2 :: Graph  -> Label -> Label -> [Label] -> Bool
route2 g dest from seen 
  | dest == from = True
  | otherwise    = any (\x -> route2 g dest x (from:seen)) (neighbours g from)

Но если вы запустили его на графике здесь: Вы получили бы след, который выглядел бы как-то вроде этого (извините схему, я бесстыдно украл эти фотографии из моего класса cs. Fr - find-route, а fr-l - это версия, которая принимает список. Второй параметр является аккумулятором)

Как вы можете видеть, он заканчивается посещением узлов K и H дважды. Это плохо, давайте посмотрим, почему это делается.

Так как он не передает какую-либо информацию из рекурсивных вызовов в any, он не видит, что он сделал в ветвях, которые не удались, только то, что было на пути к текущему node.

Теперь, чтобы исправить это, мы можем взять два пути. Мой класс взял подход продолжения прохождения, который довольно по-новому, поэтому я покажу его сначала, до версии монады монахов.

routeC :: Graph -> Label -> Label -> [Label] -> ([Label] -> Bool) -> Bool
routeC g  dest from seen k 
  | dest == from     = True
  | from `elem` seen = k (from:seen)
  | otherwise        = routeCl g dest (neighbours g from) (from:seen) k

routeCl :: Graph -> Label -> [Label] -> [Label] -> ([Label] -> Bool) -> Bool
routeCl g dest []     seen k = k seen
routeCl g dest (x:xs) seen k = 
    routeC g dest x seen (\newSeen -> routeCl g dest xs newSeen k)

Для этого используется пара функций, а не любая. routeC просто проверяет, дошли ли мы до места назначения, или если мы зациклились, иначе он просто вызывает routeCL с соседями текущего node.

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

routeCL берет список узлов, и если список пуст, выполняется продолжение, иначе он делает что-то интересное. Он запускает routeC в первом node и передает ему продолжение, которое будет запускать routeCL в остальной части списка, с НОВЫМ списком видимых узлов. Таким образом, он сможет увидеть историю неудавшихся ветвей.

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

anyK :: (a -> s -> (s -> r) -> (s -> r) -> r) ->
        [a] -> s -> (s -> r) -> (s -> r) -> r
anyK p []     s tK fK = fK s
anyK p (x:xs) s tK fK = p x s tK (\s' -> anyK p xs s' tK fK)

routeK2 :: Graph -> Label -> Label -> ([Label] -> r) -> ([Label] -> r) -> r
routeK2 g dest from' trueK falseK = route from' [] trueK falseK
  where route from seen tK fK 
         | from == dest = tK seen
         | from `elem` seen = fK seen
         | otherwise = anyK route (neighbours g from) (from:seen) tK fK

То же самое, но с передачей дополнительной информации.

Теперь, за то, что вы ожидали, версия State Monad.

routeS :: Graph -> Label -> Label -> State [Label] Bool
routeS g dest from | dest == from = return True
routeS g dest from = do
      seen <- get 
      if from `elem` seen then return False else do
      put (from:seen)
      anyM (routeS g dest) (neighbours g from)

Но разве эта последняя строка не очень похожа на то, с чего мы начали, просто с дополнительной сантехникой? Для сравнения:

any  (route g dest)  (neighbours g from)  -- Simple version
anyM (routeS g dest) (neighbours g from)  -- State Version
anyK route         (neighbours g from) (from:seen) tK fK  -- CPS version

В основе все три делают то же самое. Монада в государственной версии просто красиво обрабатывает сантехнику видимых узлов для нас. И версия CPS показывает нам, каков будет поток управления, гораздо более явным образом, чем государственная монада.

О, но anyM, похоже, не находится в стандартной библиотеке. Вот как это выглядит:

anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
anyM p [] = return False
anyM p (x:xs) = do
    y <- p x
    if y
      then return True
      else anyM p xs

Ответ 3

Я бы, вероятно, просто cabal install fgl и использовал встроенные функции DFS, такие как components и тому подобное.