Rilevamento di cicli di un grafico (forse diretto o non diretto) in Haskell

Question

Ho iniziato a risolvere questo problema in modo imperativo e funziona (DFS con le tradizionali tre tecniche di colorazione). Tuttavia, mi ci vuole un tempo triplo per capire come farlo. Haskell e io abbiamo fallito! Supponiamo che rappresenti un grafico come lista (o mappa) di un nodo con i suoi nodi di adiacenza.

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

Nota la rappresentazione di cui sopra può essere diretta o non diretta. Ho anche passato il set visto e finito impostato come argomenti (dal momento che non sono preferiti gli effetti secondari nel funzionamento) quando si esegue l'esplorazione per rilevare il bordo del back track. Tuttavia, non posso proprio farlo in Haskell! So che potrebbe esserci una monade di stato, ma quella cosa non mi è passata per la testa nemmeno bene. Sono curioso di sapere come qualcuno mi può guidare come farlo in "bello" stile Haskell?

Answer 1

Probabilmente sarei solo cabal install fgl e utilizzare le funzioni DFS integrate come components e simili.

Answer 2

Prima di tutto, esiste un tipo di dati per la memorizzazione dei grafici in Haskell; si chiama Data.Graph.Graph nel pacchetto containers. Utilizza un numero Data.Array anziché un elenco, ma è comunque identico alla tua rappresentazione.

type Graph = Array Int [Int] 

Questa rappresentazione porta a grafici molto più efficienti, mentre utilizza anche molta meno memoria. Io uso questa libreria in questo modo:

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

È presumibilmente conosce l'nodi minimo e massimo nel grafico; in caso contrario, questa funzione li calcola per voi e crea un Graph:

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

per vedere se un nodo è parte di un ciclo, si deve verificare se i nodi raggiungibili da un nodo, escluso il nodo stesso, contengono che nodo. Si può usare la funzione reachable per ottenere i nodi che sono raggiungibili da un dato nodo (incluso quel nodo). Poiché uno Graph è un Array, è possibile utilizzare assocs per recuperare l'elenco da cui è stato creato, con il tipo [(Node, [Node])]. Usiamo questi tre fatti per costruire due funzioni:

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

Se siete interessati a come la funzione reachable funziona, ho potuto passare attraverso tutti qui, ma è abbastanza facile, per capire quando si guarda a the code .

Queste funzioni sono molto efficienti, ma potrebbero essere notevolmente migliorate a seconda di come si desidera rappresentare i cicli alla fine. Ad esempio, è possibile utilizzare la funzione stronglyConnComp in Data.Graph per ottenere una rappresentazione più semplificata.

Nota che sto abusando del fatto che Node ~ Graph.Vertex ~ Int in questo caso, quindi se il vostro Node s tipo di cambiamento, è necessario utilizzare funzioni di conversione appropriate Data.Graph, come graphFromEdges, per ottenere un Graph e funzioni di conversione associate.

La libreria fgl è un'altra alternativa che fornisce anche una suite completa di funzionalità relative al grafico estremamente ottimizzata.

Answer 3

C'è il modo ingenuo di tentare di esso, che assomiglia a questo:

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

Ma questo non funziona in loop grafici. (Suppongo anche che tu abbia dei vicini definiti)

Quindi, cosa fare, ma passare l'elenco dei nodi già visti attraverso.

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) 

Ma se si stesse eseguendo sul grafico qui:. Si otterrebbe una traccia che sembrava qualcosa di simile (scusate il programma, ho spudoratamente rubato queste immagini della mia classe cs fr è trovare-percorso, e fr-L è una versione di esso che prende una lista. il secondo parametro è l'accumulatore)

Come si può vedere, finisce per visitare i nodi K e H due volte. Questo è male, vediamo perché lo sta facendo.

Poiché non passa alcun backup di informazioni dalle chiamate ricorsive in any, non può vedere cosa ha fatto nei rami che hanno avuto esito negativo, solo ciò che era sul percorso del nodo corrente.

Ora per risolvere il problema, ci sono due percorsi che possiamo intraprendere. La mia classe ha adottato un approccio di passaggio che è piuttosto nuovo, quindi lo mostrerò prima, prima della versione monade dello stato.

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) 

Questo utilizza una coppia di funzioni, invece di qualsiasi. routeC controlla solo se siamo arrivati ​​alla destinazione, o se siamo in loop, altrimenti chiama solo routeCL con i vicini del nodo corrente.

Se siamo in loop, quindi invece di restituire False, chiamiamo la continuazione, ma con i nodi che abbiamo visto attualmente (incluso quello corrente).

routeCL prende un elenco di nodi e, se l'elenco è vuoto, esegue la continuazione, altrimenti fa qualcosa di interessante. Esegue routeC sul primo nodo e ne passa una continuazione che eseguirà routeCl sul resto dell'elenco, con il NUOVO elenco di nodi visti. Quindi sarà in grado di vedere nella storia dei rami falliti.

(Come ulteriore cosa, possiamo generalizzare un po 'di più, e trasformarlo completamente in uno stile di passaggio continuo. Ne ho generalizzato anche uno, invece di usare la coppia di funzioni.Questo è opzionale, e il tipo firma è più spaventoso rispetto al codice.)

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 

Stessa cosa, ma con più informazioni che vengono passati in.

Ora, per quello che stavate aspettando, la versione Stato Monade.

Ma quell'ultima riga non assomiglia molto a quello che abbiamo iniziato, solo con qualche tubatura in più? Confronta:

Al centro, tutti e tre stanno facendo la stessa cosa. La monade nella versione statale gestisce semplicemente l'impianto idraulico dei nodi visti per noi.E la versione CPS ci mostra esattamente come sarà il flusso di controllo, in un modo molto più esplicito della monade di stato.

Oh, ma l'anyM non sembra essere nella libreria standard. Ecco come appare:

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