{-# LANGUAGE ScopedTypeVariables #-}
module Graphs.FindCycle (
findCycle,
) where
import qualified Data.Set as Set
data DFSOut a =
NoCycle (Set.Set a)
| Cycle [a]
| PartialCycle [a] a
findCycle :: Ord a => [a] -> (a -> [a]) -> Maybe [a]
findCycle :: [a] -> (a -> [a]) -> Maybe [a]
findCycle ([a]
nodes :: [a]) (a -> [a]
sFn :: a -> [a]) =
let
findCycle1 :: [a] -> Set.Set a -> Maybe [a]
findCycle1 :: [a] -> Set a -> Maybe [a]
findCycle1 [a]
nodes0 Set a
visited0 =
case [a]
nodes0 of
a
a : [a]
nodes1 ->
case Set a -> Set a -> a -> DFSOut a
findCycle2 Set a
forall a. Set a
Set.empty Set a
visited0 a
a of
NoCycle Set a
visited1 -> [a] -> Set a -> Maybe [a]
findCycle1 [a]
nodes1 Set a
visited1
Cycle [a]
cycle -> [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
cycle
DFSOut a
_ -> [Char] -> Maybe [a]
forall a. HasCallStack => [Char] -> a
error [Char]
"findCycle - unexpected PartialCycle"
[] -> Maybe [a]
forall a. Maybe a
Nothing
findCycle2 :: Set.Set a -> Set.Set a -> a -> DFSOut a
findCycle2 :: Set a -> Set a -> a -> DFSOut a
findCycle2 Set a
aboveThis0 Set a
visited0 a
this =
if a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
this Set a
visited0
then
Set a -> DFSOut a
forall a. Set a -> DFSOut a
NoCycle Set a
visited0
else
if a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
this Set a
aboveThis0
then
[a] -> a -> DFSOut a
forall a. [a] -> a -> DFSOut a
PartialCycle [] a
this
else
let
succs :: [a]
succs = a -> [a]
sFn a
this
aboveThis1 :: Set a
aboveThis1 = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
this Set a
aboveThis0
doSuccs :: [a] -> Set.Set a -> DFSOut a
doSuccs :: [a] -> Set a -> DFSOut a
doSuccs [] Set a
visited
= Set a -> DFSOut a
forall a. Set a -> DFSOut a
NoCycle (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
this Set a
visited)
doSuccs (a
succ:[a]
succs) Set a
visited0 =
case Set a -> Set a -> a -> DFSOut a
findCycle2 Set a
aboveThis1 Set a
visited0 a
succ of
NoCycle Set a
visited1 -> [a] -> Set a -> DFSOut a
doSuccs [a]
succs Set a
visited1
PartialCycle [a]
arc a
node ->
if a
node a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
this
then
[a] -> DFSOut a
forall a. [a] -> DFSOut a
Cycle (a
this a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
arc)
else
[a] -> a -> DFSOut a
forall a. [a] -> a -> DFSOut a
PartialCycle (a
this a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
arc) a
node
DFSOut a
cycle -> DFSOut a
cycle
in
[a] -> Set a -> DFSOut a
doSuccs [a]
succs Set a
visited0
in
[a] -> Set a -> Maybe [a]
findCycle1 [a]
nodes Set a
forall a. Set a
Set.empty