Detectando ciclos de un gráfico (tal vez dirigido o no dirigido) en Haskell

Question

Comencé a resolver este problema de manera imperativa y funciona (DFS con tres técnicas de color tradicionales). Sin embargo, me toma el triple de tiempo averiguar cómo hacerlo Haskell y ¡fallé! Supongamos que represento el gráfico como una lista (o mapa) de un nodo con sus nodos de adyacencia.

type Node = Int 
type Graph = [(Node, [Node])] 

Nota: la representación anterior se puede dirigir o no dirigir. También paso el conjunto visto y lo configuré como argumentos (ya que no se prefieren efectos secundarios en el funcional) cuando realizo la exploración para detectar el borde posterior de la pista. Sin embargo, ¡no puedo hacerlo en Haskell! Sé que puede haber uso de la mónada estatal, pero eso tampoco ha pasado por mi mente. Tengo curiosidad por saber cómo alguien podría guiarme sobre cómo hacerlo en el "hermoso" estilo Haskell.

Answer 1

Probablemente solo cabal install fgl y use las funciones DFS integradas como components y similares.

Answer 2

Antes que nada, hay un tipo de datos para almacenar gráficos en Haskell; se llama Data.Graph.Graph en el paquete containers. Utiliza un Data.Array en lugar de una lista, pero es idéntico a su representación.

type Graph = Array Int [Int] 

Esta representación conduce a gráficos mucho más eficientes, al tiempo que utiliza mucha menos memoria. Uso esta biblioteca de la siguiente manera:

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

Probablemente conozca los nodos mínimo y máximo en su gráfico; si no, esta función los calcula para usted y crea un Graph:

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

para ver si un nodo es parte de un ciclo, hay que comprobar si los nodos de acceso desde un nodo, excluyendo el propio nodo, contienen esa nodo. Se puede usar la función reachable para obtener los nodos que se pueden alcanzar desde un nodo determinado (incluido ese nodo). Como Graph es Array, se puede usar assocs para recuperar la lista desde la que se creó, con el tipo [(Node, [Node])]. Utilizamos estos tres hechos para construir dos funciones:

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

Si usted está interesado en cómo la función reachable funciona, podría pasar por todos aquí, pero es bastante sencillo de entender cuando nos fijamos en the code .

Estas funciones son muy eficientes, pero podrían mejorarse mucho dependiendo de cómo quiera que se representen los ciclos al final. Por ejemplo, puede usar la función stronglyConnComp en Data.Graph para obtener una representación más optimizada.

Nota que estoy abusando del hecho de que Node ~ Graph.Vertex ~ Int en este caso, lo que si su Node s tipo de cambio, es necesario utilizar las funciones de conversión apropiados en Data.Graph, como graphFromEdges, para obtener un Graph y funciones de conversión asociados.

La biblioteca fgl es otra alternativa que también proporciona un conjunto completo de funciones relacionadas con gráficos que está extremadamente optimizado.

Answer 3

No es la forma ingenua de intentarlo, que se ve así:

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

Pero eso no funciona en bucle gráficos. (También estoy asumiendo que tiene vecinos definidos)

Entonces, qué hacer pero pasar la lista de nodos ya vistos.

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) 

Pero si se ejecuta en el gráfico aquí:. Obtendría una traza que parecía algo como esto (con perdón del esquema, he robado descaradamente estas fotos de mi clase cs es fr encontrar-ruta, y fr-l es una versión de la misma que toma una lista. el segundo parámetro es el acumulador)

Como se puede ver, termina visitando los nodos K ​​y H dos veces. Esto es malo, veamos por qué está haciendo eso.

Dado que no pasa ninguna información de respaldo de las llamadas recursivas en any, no puede ver lo que hizo en las ramas que fallaron, solo lo que estaba en la ruta al nodo actual.

Ahora, para solucionar eso, hay dos caminos que podemos seguir. Mi clase adoptó un enfoque de continuación de aprobación que es bastante novedoso, así que lo mostraré primero, antes de la versión de mónada estatal.

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) 

Esto utiliza un par de funciones, en lugar de cualquiera. routeC solo comprueba si llegamos al destino o si hemos realizado un bucle, de lo contrario solo llama a routeCL con los vecinos del nodo actual.

Si hemos realizado un bucle, en lugar de solo devolver False, llamamos a la continuación, pero con los nodos que hemos visto actualmente (incluido el actual).

routeCL toma una lista de nodos, y si la lista está vacía, ejecuta la continuación, de lo contrario, hace algo interesante. Se ejecuta routeC en el primer nodo, y le pasa una continuación que ejecutará routeCl en el resto de la lista, con la NUEVA lista de nodos vistos. Por lo tanto, podrá ver en la historia de las ramas fallidas.

(Como cosa adicional, podemos generalizar esto un poco más y transformarlo por completo en el estilo de paso de continuación. He generalizado también cualquiera, en lugar de usar el par de funciones. Esto es opcional, y el tipo firma es más aterrador que el código.)

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 

lo mismo, pero con más información que se ha pasado.

Ahora, por lo que has estado esperando, la versión del estado mónada.

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) 

¿Pero no se parece mucho a la última línea con la que empezamos, solo con un poco de plomería adicional? Compare:

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 

En el núcleo, los tres están haciendo lo mismo. La mónada en la versión de estado maneja muy bien la fontanería de los nodos vistos para nosotros.Y la versión de CPS nos muestra exactamente cómo será el flujo de control, de una manera mucho más explícita que la mónada de estado.

Oh, pero anyM no parece estar en la biblioteca estándar. Esto es lo que parece:

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