module GHC.Data.Graph.Inductive.Graph (
Node,LNode,UNode,
Edge,LEdge,UEdge,
Adj,Context,MContext,Decomp,GDecomp,UContext,UDecomp,
Path,LPath(..),UPath,
Graph(..),
DynGraph(..),
order,
size,
ufold,gmap,nmap,emap,nemap,
nodes,edges,toEdge,edgeLabel,toLEdge,newNodes,gelem,
insNode,insEdge,delNode,delEdge,delLEdge,delAllLEdge,
insNodes,insEdges,delNodes,delEdges,
buildGr,mkUGraph,
gfiltermap,nfilter,labnfilter,labfilter,subgraph,
context,lab,neighbors,lneighbors,
suc,pre,lsuc,lpre,
out,inn,outdeg,indeg,deg,
hasEdge,hasNeighbor,hasLEdge,hasNeighborAdj,
equal,
node',lab',labNode',neighbors',lneighbors',
suc',pre',lpre',lsuc',
out',inn',outdeg',indeg',deg',
prettify,
prettyPrint,
OrdGr(..)
) where
import GHC.Prelude
import Control.Arrow (first)
import Data.Function (on)
import qualified Data.IntSet as IntSet
import Data.List (delete, groupBy, sort, sortBy, (\\))
import Data.Maybe (fromMaybe, isJust)
import GHC.Utils.Panic
type Node = Int
type LNode a = (Node,a)
type UNode = LNode ()
type Edge = (Node,Node)
type LEdge b = (Node,Node,b)
type UEdge = LEdge ()
type Path = [Node]
newtype LPath a = LP { forall a. LPath a -> [LNode a]
unLPath :: [LNode a] }
instance (Show a) => Show (LPath a) where
show :: LPath a -> String
show (LP [LNode a]
xs) = [LNode a] -> String
forall a. Show a => a -> String
show [LNode a]
xs
instance (Eq a) => Eq (LPath a) where
(LP []) == :: LPath a -> LPath a -> Bool
== (LP []) = Bool
True
(LP ((Int
_,a
x):[LNode a]
_)) == (LP ((Int
_,a
y):[LNode a]
_)) = a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
y
(LP [LNode a]
_) == (LP [LNode a]
_) = Bool
False
instance (Ord a) => Ord (LPath a) where
compare :: LPath a -> LPath a -> Ordering
compare (LP []) (LP []) = Ordering
EQ
compare (LP ((Int
_,a
x):[LNode a]
_)) (LP ((Int
_,a
y):[LNode a]
_)) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y
compare LPath a
_ LPath a
_ = String -> Ordering
forall a. HasCallStack => String -> a
panic String
"LPath: cannot compare two empty paths"
type UPath = [UNode]
type Adj b = [(b,Node)]
type Context a b = (Adj b,Node,a,Adj b)
type MContext a b = Maybe (Context a b)
type Decomp g a b = (MContext a b,g a b)
type GDecomp g a b = (Context a b,g a b)
type UContext = ([Node],Node,[Node])
type UDecomp g = (Maybe UContext,g)
class Graph gr where
{-# MINIMAL empty, isEmpty, match, mkGraph, labNodes #-}
empty :: gr a b
isEmpty :: gr a b -> Bool
match :: Node -> gr a b -> Decomp gr a b
mkGraph :: [LNode a] -> [LEdge b] -> gr a b
labNodes :: gr a b -> [LNode a]
matchAny :: gr a b -> GDecomp gr a b
matchAny gr a b
g = case gr a b -> [LNode a]
forall a b. gr a b -> [LNode a]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes gr a b
g of
[] -> String -> GDecomp gr a b
forall a. HasCallStack => String -> a
panic String
"Match Exception, Empty Graph"
(Int
v,a
_):[LNode a]
_ | (Just Context a b
c,gr a b
g') <- Int -> gr a b -> (MContext a b, gr a b)
forall a b. Int -> gr a b -> Decomp gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
match Int
v gr a b
g -> (Context a b
c,gr a b
g')
[LNode a]
_ -> String -> GDecomp gr a b
forall a. HasCallStack => String -> a
panic String
"This can't happen: failed to match node in graph"
noNodes :: gr a b -> Int
noNodes = [LNode a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([LNode a] -> Int) -> (gr a b -> [LNode a]) -> gr a b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> [LNode a]
forall a b. gr a b -> [LNode a]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes
nodeRange :: gr a b -> (Node,Node)
nodeRange gr a b
g
| gr a b -> Bool
forall a b. gr a b -> Bool
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = String -> (Int, Int)
forall a. HasCallStack => String -> a
panic String
"nodeRange of empty graph"
| Bool
otherwise = ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int]
vs, [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
vs)
where
vs :: [Int]
vs = gr a b -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Int]
nodes gr a b
g
labEdges :: gr a b -> [LEdge b]
labEdges = (Context a b -> [LEdge b] -> [LEdge b])
-> [LEdge b] -> gr a b -> [LEdge b]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c -> c) -> c -> gr a b -> c
ufold (\(Adj b
_,Int
v,a
_,Adj b
s)->(((b, Int) -> LEdge b) -> Adj b -> [LEdge b]
forall a b. (a -> b) -> [a] -> [b]
map (\(b
l,Int
w)->(Int
v,Int
w,b
l)) Adj b
s [LEdge b] -> [LEdge b] -> [LEdge b]
forall a. [a] -> [a] -> [a]
++)) []
class (Graph gr) => DynGraph gr where
(&) :: Context a b -> gr a b -> gr a b
order :: (Graph gr) => gr a b -> Int
order :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int
order = gr a b -> Int
forall a b. gr a b -> Int
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int
noNodes
size :: (Graph gr) => gr a b -> Int
size :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int
size = [LEdge b] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([LEdge b] -> Int) -> (gr a b -> [LEdge b]) -> gr a b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> [LEdge b]
forall a b. gr a b -> [LEdge b]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges
ufold :: (Graph gr) => (Context a b -> c -> c) -> c -> gr a b -> c
ufold :: forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c -> c) -> c -> gr a b -> c
ufold Context a b -> c -> c
f c
u gr a b
g
| gr a b -> Bool
forall a b. gr a b -> Bool
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = c
u
| Bool
otherwise = Context a b -> c -> c
f Context a b
c ((Context a b -> c -> c) -> c -> gr a b -> c
forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c -> c) -> c -> gr a b -> c
ufold Context a b -> c -> c
f c
u gr a b
g')
where
(Context a b
c,gr a b
g') = gr a b -> (Context a b, gr a b)
forall a b. gr a b -> GDecomp gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> GDecomp gr a b
matchAny gr a b
g
gmap :: (DynGraph gr) => (Context a b -> Context c d) -> gr a b -> gr c d
gmap :: forall (gr :: * -> * -> *) a b c d.
DynGraph gr =>
(Context a b -> Context c d) -> gr a b -> gr c d
gmap Context a b -> Context c d
f = (Context a b -> gr c d -> gr c d) -> gr c d -> gr a b -> gr c d
forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c -> c) -> c -> gr a b -> c
ufold (\Context a b
c->(Context a b -> Context c d
f Context a b
cContext c d -> gr c d -> gr c d
forall a b. Context a b -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
&)) gr c d
forall a b. gr a b
forall (gr :: * -> * -> *) a b. Graph gr => gr a b
empty
{-# NOINLINE [0] gmap #-}
nmap :: (DynGraph gr) => (a -> c) -> gr a b -> gr c b
nmap :: forall (gr :: * -> * -> *) a c b.
DynGraph gr =>
(a -> c) -> gr a b -> gr c b
nmap a -> c
f = (Context a b -> Context c b) -> gr a b -> gr c b
forall (gr :: * -> * -> *) a b c d.
DynGraph gr =>
(Context a b -> Context c d) -> gr a b -> gr c d
gmap (\(Adj b
p,Int
v,a
l,Adj b
s)->(Adj b
p,Int
v,a -> c
f a
l,Adj b
s))
{-# NOINLINE [0] nmap #-}
emap :: (DynGraph gr) => (b -> c) -> gr a b -> gr a c
emap :: forall (gr :: * -> * -> *) b c a.
DynGraph gr =>
(b -> c) -> gr a b -> gr a c
emap b -> c
f = (Context a b -> Context a c) -> gr a b -> gr a c
forall (gr :: * -> * -> *) a b c d.
DynGraph gr =>
(Context a b -> Context c d) -> gr a b -> gr c d
gmap (\(Adj b
p,Int
v,a
l,Adj b
s)->((b -> c) -> Adj b -> [(c, Int)]
forall {b} {c} {d}. (b -> c) -> [(b, d)] -> [(c, d)]
map1 b -> c
f Adj b
p,Int
v,a
l,(b -> c) -> Adj b -> [(c, Int)]
forall {b} {c} {d}. (b -> c) -> [(b, d)] -> [(c, d)]
map1 b -> c
f Adj b
s))
where
map1 :: (b -> c) -> [(b, d)] -> [(c, d)]
map1 b -> c
g = ((b, d) -> (c, d)) -> [(b, d)] -> [(c, d)]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> c) -> (b, d) -> (c, d)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first b -> c
g)
{-# NOINLINE [0] emap #-}
nemap :: (DynGraph gr) => (a -> c) -> (b -> d) -> gr a b -> gr c d
nemap :: forall (gr :: * -> * -> *) a c b d.
DynGraph gr =>
(a -> c) -> (b -> d) -> gr a b -> gr c d
nemap a -> c
fn b -> d
fe = (Context a b -> Context c d) -> gr a b -> gr c d
forall (gr :: * -> * -> *) a b c d.
DynGraph gr =>
(Context a b -> Context c d) -> gr a b -> gr c d
gmap (\(Adj b
p,Int
v,a
l,Adj b
s) -> (Adj b -> [(d, Int)]
fe' Adj b
p,Int
v,a -> c
fn a
l,Adj b -> [(d, Int)]
fe' Adj b
s))
where
fe' :: Adj b -> [(d, Int)]
fe' = ((b, Int) -> (d, Int)) -> Adj b -> [(d, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> d) -> (b, Int) -> (d, Int)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first b -> d
fe)
{-# NOINLINE [0] nemap #-}
nodes :: (Graph gr) => gr a b -> [Node]
nodes :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Int]
nodes = ((Int, a) -> Int) -> [(Int, a)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, a) -> Int
forall a b. (a, b) -> a
fst ([(Int, a)] -> [Int]) -> (gr a b -> [(Int, a)]) -> gr a b -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> [(Int, a)]
forall a b. gr a b -> [LNode a]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes
edges :: (Graph gr) => gr a b -> [Edge]
edges :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [(Int, Int)]
edges = (LEdge b -> (Int, Int)) -> [LEdge b] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map LEdge b -> (Int, Int)
forall b. LEdge b -> (Int, Int)
toEdge ([LEdge b] -> [(Int, Int)])
-> (gr a b -> [LEdge b]) -> gr a b -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> [LEdge b]
forall a b. gr a b -> [LEdge b]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges
toEdge :: LEdge b -> Edge
toEdge :: forall b. LEdge b -> (Int, Int)
toEdge (Int
v,Int
w,b
_) = (Int
v,Int
w)
toLEdge :: Edge -> b -> LEdge b
toLEdge :: forall b. (Int, Int) -> b -> LEdge b
toLEdge (Int
v,Int
w) b
l = (Int
v,Int
w,b
l)
edgeLabel :: LEdge b -> b
edgeLabel :: forall b. LEdge b -> b
edgeLabel (Int
_,Int
_,b
l) = b
l
newNodes :: (Graph gr) => Int -> gr a b -> [Node]
newNodes :: forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> [Int]
newNodes Int
i gr a b
g
| gr a b -> Bool
forall a b. gr a b -> Bool
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = [Int
0..Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
| Bool
otherwise = [Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i]
where
(Int
_,Int
n) = gr a b -> (Int, Int)
forall a b. gr a b -> (Int, Int)
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> (Int, Int)
nodeRange gr a b
g
gelem :: (Graph gr) => Node -> gr a b -> Bool
gelem :: forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> Bool
gelem Int
v = Maybe (Context a b) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Context a b) -> Bool)
-> (gr a b -> Maybe (Context a b)) -> gr a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Context a b), gr a b) -> Maybe (Context a b)
forall a b. (a, b) -> a
fst ((Maybe (Context a b), gr a b) -> Maybe (Context a b))
-> (gr a b -> (Maybe (Context a b), gr a b))
-> gr a b
-> Maybe (Context a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> gr a b -> (Maybe (Context a b), gr a b)
forall a b. Int -> gr a b -> Decomp gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
match Int
v
insNode :: (DynGraph gr) => LNode a -> gr a b -> gr a b
insNode :: forall (gr :: * -> * -> *) a b.
DynGraph gr =>
LNode a -> gr a b -> gr a b
insNode (Int
v,a
l) = (([],Int
v,a
l,[])Context a b -> gr a b -> gr a b
forall a b. Context a b -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
&)
{-# NOINLINE [0] insNode #-}
insEdge :: (DynGraph gr) => LEdge b -> gr a b -> gr a b
insEdge :: forall (gr :: * -> * -> *) b a.
DynGraph gr =>
LEdge b -> gr a b -> gr a b
insEdge (Int
v,Int
w,b
l) gr a b
g = (Adj b
pr,Int
v,a
la,(b
l,Int
w)(b, Int) -> Adj b -> Adj b
forall a. a -> [a] -> [a]
:Adj b
su) Context a b -> gr a b -> gr a b
forall a b. Context a b -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
& gr a b
g'
where
(MContext a b
mcxt,gr a b
g') = Int -> gr a b -> (MContext a b, gr a b)
forall a b. Int -> gr a b -> Decomp gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
match Int
v gr a b
g
(Adj b
pr,Int
_,a
la,Adj b
su) = Context a b -> MContext a b -> Context a b
forall a. a -> Maybe a -> a
fromMaybe
(String -> Context a b
forall a. HasCallStack => String -> a
panic (String
"insEdge: cannot add edge from non-existent vertex " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
v))
MContext a b
mcxt
{-# NOINLINE [0] insEdge #-}
delNode :: (Graph gr) => Node -> gr a b -> gr a b
delNode :: forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> gr a b
delNode Int
v = [Int] -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
[Int] -> gr a b -> gr a b
delNodes [Int
v]
delEdge :: (DynGraph gr) => Edge -> gr a b -> gr a b
delEdge :: forall (gr :: * -> * -> *) a b.
DynGraph gr =>
(Int, Int) -> gr a b -> gr a b
delEdge (Int
v,Int
w) gr a b
g = case Int -> gr a b -> Decomp gr a b
forall a b. Int -> gr a b -> Decomp gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
match Int
v gr a b
g of
(Maybe (Context a b)
Nothing,gr a b
_) -> gr a b
g
(Just (Adj b
p,Int
v',a
l,Adj b
s),gr a b
g') -> (Adj b
p,Int
v',a
l,((b, Int) -> Bool) -> Adj b -> Adj b
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
w)(Int -> Bool) -> ((b, Int) -> Int) -> (b, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(b, Int) -> Int
forall a b. (a, b) -> b
snd) Adj b
s) Context a b -> gr a b -> gr a b
forall a b. Context a b -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
& gr a b
g'
delLEdge :: (DynGraph gr, Eq b) => LEdge b -> gr a b -> gr a b
delLEdge :: forall (gr :: * -> * -> *) b a.
(DynGraph gr, Eq b) =>
LEdge b -> gr a b -> gr a b
delLEdge = ((b, Int) -> Adj b -> Adj b) -> LEdge b -> gr a b -> gr a b
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
((b, Int) -> Adj b -> Adj b) -> LEdge b -> gr a b -> gr a b
delLEdgeBy (b, Int) -> Adj b -> Adj b
forall a. Eq a => a -> [a] -> [a]
delete
delAllLEdge :: (DynGraph gr, Eq b) => LEdge b -> gr a b -> gr a b
delAllLEdge :: forall (gr :: * -> * -> *) b a.
(DynGraph gr, Eq b) =>
LEdge b -> gr a b -> gr a b
delAllLEdge = ((b, Int) -> Adj b -> Adj b) -> LEdge b -> gr a b -> gr a b
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
((b, Int) -> Adj b -> Adj b) -> LEdge b -> gr a b -> gr a b
delLEdgeBy (((b, Int) -> Bool) -> Adj b -> Adj b
forall a. (a -> Bool) -> [a] -> [a]
filter (((b, Int) -> Bool) -> Adj b -> Adj b)
-> ((b, Int) -> (b, Int) -> Bool) -> (b, Int) -> Adj b -> Adj b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, Int) -> (b, Int) -> Bool
forall a. Eq a => a -> a -> Bool
(/=))
delLEdgeBy :: (DynGraph gr) => ((b,Node) -> Adj b -> Adj b)
-> LEdge b -> gr a b -> gr a b
delLEdgeBy :: forall (gr :: * -> * -> *) b a.
DynGraph gr =>
((b, Int) -> Adj b -> Adj b) -> LEdge b -> gr a b -> gr a b
delLEdgeBy (b, Int) -> Adj b -> Adj b
f (Int
v,Int
w,b
b) gr a b
g = case Int -> gr a b -> Decomp gr a b
forall a b. Int -> gr a b -> Decomp gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
match Int
v gr a b
g of
(Maybe (Context a b)
Nothing,gr a b
_) -> gr a b
g
(Just (Adj b
p,Int
v',a
l,Adj b
s),gr a b
g') -> (Adj b
p,Int
v',a
l,(b, Int) -> Adj b -> Adj b
f (b
b,Int
w) Adj b
s) Context a b -> gr a b -> gr a b
forall a b. Context a b -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
& gr a b
g'
insNodes :: (DynGraph gr) => [LNode a] -> gr a b -> gr a b
insNodes :: forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[LNode a] -> gr a b -> gr a b
insNodes [LNode a]
vs gr a b
g = (gr a b -> LNode a -> gr a b) -> gr a b -> [LNode a] -> gr a b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((LNode a -> gr a b -> gr a b) -> gr a b -> LNode a -> gr a b
forall a b c. (a -> b -> c) -> b -> a -> c
flip LNode a -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
LNode a -> gr a b -> gr a b
insNode) gr a b
g [LNode a]
vs
{-# INLINABLE insNodes #-}
insEdges :: (DynGraph gr) => [LEdge b] -> gr a b -> gr a b
insEdges :: forall (gr :: * -> * -> *) b a.
DynGraph gr =>
[LEdge b] -> gr a b -> gr a b
insEdges [LEdge b]
es gr a b
g = (gr a b -> LEdge b -> gr a b) -> gr a b -> [LEdge b] -> gr a b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((LEdge b -> gr a b -> gr a b) -> gr a b -> LEdge b -> gr a b
forall a b c. (a -> b -> c) -> b -> a -> c
flip LEdge b -> gr a b -> gr a b
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
LEdge b -> gr a b -> gr a b
insEdge) gr a b
g [LEdge b]
es
{-# INLINABLE insEdges #-}
delNodes :: (Graph gr) => [Node] -> gr a b -> gr a b
delNodes :: forall (gr :: * -> * -> *) a b.
Graph gr =>
[Int] -> gr a b -> gr a b
delNodes [Int]
vs gr a b
g = (gr a b -> Int -> gr a b) -> gr a b -> [Int] -> gr a b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((MContext a b, gr a b) -> gr a b
forall a b. (a, b) -> b
snd ((MContext a b, gr a b) -> gr a b)
-> (gr a b -> Int -> (MContext a b, gr a b))
-> gr a b
-> Int
-> gr a b
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: (Int -> gr a b -> (MContext a b, gr a b))
-> gr a b -> Int -> (MContext a b, gr a b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> gr a b -> (MContext a b, gr a b)
forall a b. Int -> gr a b -> Decomp gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
match) gr a b
g [Int]
vs
delEdges :: (DynGraph gr) => [Edge] -> gr a b -> gr a b
delEdges :: forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[(Int, Int)] -> gr a b -> gr a b
delEdges [(Int, Int)]
es gr a b
g = (gr a b -> (Int, Int) -> gr a b)
-> gr a b -> [(Int, Int)] -> gr a b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((Int, Int) -> gr a b -> gr a b) -> gr a b -> (Int, Int) -> gr a b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int, Int) -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
(Int, Int) -> gr a b -> gr a b
delEdge) gr a b
g [(Int, Int)]
es
buildGr :: (DynGraph gr) => [Context a b] -> gr a b
buildGr :: forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[Context a b] -> gr a b
buildGr = (Context a b -> gr a b -> gr a b)
-> gr a b -> [Context a b] -> gr a b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Context a b -> gr a b -> gr a b
forall a b. Context a b -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
(&) gr a b
forall a b. gr a b
forall (gr :: * -> * -> *) a b. Graph gr => gr a b
empty
mkUGraph :: (Graph gr) => [Node] -> [Edge] -> gr () ()
mkUGraph :: forall (gr :: * -> * -> *).
Graph gr =>
[Int] -> [(Int, Int)] -> gr () ()
mkUGraph [Int]
vs [(Int, Int)]
es = [LNode ()] -> [LEdge ()] -> gr () ()
forall a b. [LNode a] -> [LEdge b] -> gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph ([Int] -> [LNode ()]
forall {a}. [a] -> [(a, ())]
labUNodes [Int]
vs) ([(Int, Int)] -> [LEdge ()]
labUEdges [(Int, Int)]
es)
where
labUEdges :: [(Int, Int)] -> [LEdge ()]
labUEdges = ((Int, Int) -> LEdge ()) -> [(Int, Int)] -> [LEdge ()]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> () -> LEdge ()
forall b. (Int, Int) -> b -> LEdge b
`toLEdge` ())
labUNodes :: [a] -> [(a, ())]
labUNodes = (a -> (a, ())) -> [a] -> [(a, ())]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> () -> (a, ())) -> () -> a -> (a, ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) ())
gfiltermap :: DynGraph gr => (Context a b -> MContext c d) -> gr a b -> gr c d
gfiltermap :: forall (gr :: * -> * -> *) a b c d.
DynGraph gr =>
(Context a b -> MContext c d) -> gr a b -> gr c d
gfiltermap Context a b -> MContext c d
f = (Context a b -> gr c d -> gr c d) -> gr c d -> gr a b -> gr c d
forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c -> c) -> c -> gr a b -> c
ufold ((gr c d -> gr c d)
-> (Context c d -> gr c d -> gr c d)
-> MContext c d
-> gr c d
-> gr c d
forall b a. b -> (a -> b) -> Maybe a -> b
maybe gr c d -> gr c d
forall a. a -> a
id Context c d -> gr c d -> gr c d
forall a b. Context a b -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
(&) (MContext c d -> gr c d -> gr c d)
-> (Context a b -> MContext c d) -> Context a b -> gr c d -> gr c d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a b -> MContext c d
f) gr c d
forall a b. gr a b
forall (gr :: * -> * -> *) a b. Graph gr => gr a b
empty
labnfilter :: Graph gr => (LNode a -> Bool) -> gr a b -> gr a b
labnfilter :: forall (gr :: * -> * -> *) a b.
Graph gr =>
(LNode a -> Bool) -> gr a b -> gr a b
labnfilter LNode a -> Bool
p gr a b
gr = [Int] -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
[Int] -> gr a b -> gr a b
delNodes ((LNode a -> Int) -> [LNode a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map LNode a -> Int
forall a b. (a, b) -> a
fst ([LNode a] -> [Int])
-> ([LNode a] -> [LNode a]) -> [LNode a] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LNode a -> Bool) -> [LNode a] -> [LNode a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (LNode a -> Bool) -> LNode a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LNode a -> Bool
p) ([LNode a] -> [Int]) -> [LNode a] -> [Int]
forall a b. (a -> b) -> a -> b
$ gr a b -> [LNode a]
forall a b. gr a b -> [LNode a]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes gr a b
gr) gr a b
gr
nfilter :: DynGraph gr => (Node -> Bool) -> gr a b -> gr a b
nfilter :: forall (gr :: * -> * -> *) a b.
DynGraph gr =>
(Int -> Bool) -> gr a b -> gr a b
nfilter Int -> Bool
f = (LNode a -> Bool) -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
(LNode a -> Bool) -> gr a b -> gr a b
labnfilter (Int -> Bool
f (Int -> Bool) -> (LNode a -> Int) -> LNode a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LNode a -> Int
forall a b. (a, b) -> a
fst)
labfilter :: DynGraph gr => (a -> Bool) -> gr a b -> gr a b
labfilter :: forall (gr :: * -> * -> *) a b.
DynGraph gr =>
(a -> Bool) -> gr a b -> gr a b
labfilter a -> Bool
f = (LNode a -> Bool) -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
(LNode a -> Bool) -> gr a b -> gr a b
labnfilter (a -> Bool
f (a -> Bool) -> (LNode a -> a) -> LNode a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LNode a -> a
forall a b. (a, b) -> b
snd)
subgraph :: DynGraph gr => [Node] -> gr a b -> gr a b
subgraph :: forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[Int] -> gr a b -> gr a b
subgraph [Int]
vs = let vs' :: IntSet
vs' = [Int] -> IntSet
IntSet.fromList [Int]
vs
in (Int -> Bool) -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
(Int -> Bool) -> gr a b -> gr a b
nfilter (Int -> IntSet -> Bool
`IntSet.member` IntSet
vs')
context :: (Graph gr) => gr a b -> Node -> Context a b
context :: forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Context a b
context gr a b
g Int
v = Context a b -> Maybe (Context a b) -> Context a b
forall a. a -> Maybe a -> a
fromMaybe (String -> Context a b
forall a. HasCallStack => String -> a
panic (String
"Match Exception, Node: "String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
v))
((Maybe (Context a b), gr a b) -> Maybe (Context a b)
forall a b. (a, b) -> a
fst (Int -> gr a b -> (Maybe (Context a b), gr a b)
forall a b. Int -> gr a b -> Decomp gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
match Int
v gr a b
g))
lab :: (Graph gr) => gr a b -> Node -> Maybe a
lab :: forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Maybe a
lab gr a b
g Int
v = (Context a b -> a) -> Maybe (Context a b) -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Context a b -> a
forall a b. Context a b -> a
lab' (Maybe (Context a b) -> Maybe a)
-> ((Maybe (Context a b), gr a b) -> Maybe (Context a b))
-> (Maybe (Context a b), gr a b)
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Context a b), gr a b) -> Maybe (Context a b)
forall a b. (a, b) -> a
fst ((Maybe (Context a b), gr a b) -> Maybe a)
-> (Maybe (Context a b), gr a b) -> Maybe a
forall a b. (a -> b) -> a -> b
$ Int -> gr a b -> (Maybe (Context a b), gr a b)
forall a b. Int -> gr a b -> Decomp gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
match Int
v gr a b
g
neighbors :: (Graph gr) => gr a b -> Node -> [Node]
neighbors :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
neighbors = ((b, Int) -> Int) -> [(b, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (b, Int) -> Int
forall a b. (a, b) -> b
snd ([(b, Int)] -> [Int])
-> (gr a b -> Int -> [(b, Int)]) -> gr a b -> Int -> [Int]
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: gr a b -> Int -> [(b, Int)]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
lneighbors
lneighbors :: (Graph gr) => gr a b -> Node -> Adj b
lneighbors :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
lneighbors = Adj b -> (Context a b -> Adj b) -> Maybe (Context a b) -> Adj b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Context a b -> Adj b
forall a b. Context a b -> Adj b
lneighbors' (Maybe (Context a b) -> Adj b)
-> (gr a b -> Int -> Maybe (Context a b)) -> gr a b -> Int -> Adj b
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: gr a b -> Int -> Maybe (Context a b)
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> MContext a b
mcontext
suc :: (Graph gr) => gr a b -> Node -> [Node]
suc :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
suc = ((b, Int) -> Int) -> [(b, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (b, Int) -> Int
forall a b. (a, b) -> b
snd ([(b, Int)] -> [Int])
-> (gr a b -> Int -> [(b, Int)]) -> gr a b -> Int -> [Int]
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: gr a b -> Int -> [(b, Int)]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context4l
pre :: (Graph gr) => gr a b -> Node -> [Node]
pre :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
pre = ((b, Int) -> Int) -> [(b, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (b, Int) -> Int
forall a b. (a, b) -> b
snd ([(b, Int)] -> [Int])
-> (gr a b -> Int -> [(b, Int)]) -> gr a b -> Int -> [Int]
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: gr a b -> Int -> [(b, Int)]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context1l
lsuc :: (Graph gr) => gr a b -> Node -> [(Node,b)]
lsuc :: forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [(Int, b)]
lsuc = ((b, Int) -> (Int, b)) -> [(b, Int)] -> [(Int, b)]
forall a b. (a -> b) -> [a] -> [b]
map (b, Int) -> (Int, b)
forall a b. (a, b) -> (b, a)
flip2 ([(b, Int)] -> [(Int, b)])
-> (gr a b -> Int -> [(b, Int)]) -> gr a b -> Int -> [(Int, b)]
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: gr a b -> Int -> [(b, Int)]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context4l
lpre :: (Graph gr) => gr a b -> Node -> [(Node,b)]
lpre :: forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [(Int, b)]
lpre = ((b, Int) -> (Int, b)) -> [(b, Int)] -> [(Int, b)]
forall a b. (a -> b) -> [a] -> [b]
map (b, Int) -> (Int, b)
forall a b. (a, b) -> (b, a)
flip2 ([(b, Int)] -> [(Int, b)])
-> (gr a b -> Int -> [(b, Int)]) -> gr a b -> Int -> [(Int, b)]
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: gr a b -> Int -> [(b, Int)]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context1l
out :: (Graph gr) => gr a b -> Node -> [LEdge b]
out :: forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [LEdge b]
out gr a b
g Int
v = ((b, Int) -> LEdge b) -> [(b, Int)] -> [LEdge b]
forall a b. (a -> b) -> [a] -> [b]
map (\(b
l,Int
w)->(Int
v,Int
w,b
l)) (gr a b -> Int -> [(b, Int)]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context4l gr a b
g Int
v)
inn :: (Graph gr) => gr a b -> Node -> [LEdge b]
inn :: forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [LEdge b]
inn gr a b
g Int
v = ((b, Int) -> LEdge b) -> [(b, Int)] -> [LEdge b]
forall a b. (a -> b) -> [a] -> [b]
map (\(b
l,Int
w)->(Int
w,Int
v,b
l)) (gr a b -> Int -> [(b, Int)]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context1l gr a b
g Int
v)
outdeg :: (Graph gr) => gr a b -> Node -> Int
outdeg :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Int
outdeg = [(b, Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(b, Int)] -> Int)
-> (gr a b -> Int -> [(b, Int)]) -> gr a b -> Int -> Int
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: gr a b -> Int -> [(b, Int)]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context4l
indeg :: (Graph gr) => gr a b -> Node -> Int
indeg :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Int
indeg = [(b, Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(b, Int)] -> Int)
-> (gr a b -> Int -> [(b, Int)]) -> gr a b -> Int -> Int
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: gr a b -> Int -> [(b, Int)]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context1l
deg :: (Graph gr) => gr a b -> Node -> Int
deg :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Int
deg = Context a b -> Int
forall a b. Context a b -> Int
deg' (Context a b -> Int)
-> (gr a b -> Int -> Context a b) -> gr a b -> Int -> Int
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: gr a b -> Int -> Context a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Context a b
context
node' :: Context a b -> Node
node' :: forall a b. Context a b -> Int
node' (Adj b
_,Int
v,a
_,Adj b
_) = Int
v
lab' :: Context a b -> a
lab' :: forall a b. Context a b -> a
lab' (Adj b
_,Int
_,a
l,Adj b
_) = a
l
labNode' :: Context a b -> LNode a
labNode' :: forall a b. Context a b -> LNode a
labNode' (Adj b
_,Int
v,a
l,Adj b
_) = (Int
v,a
l)
neighbors' :: Context a b -> [Node]
neighbors' :: forall a b. Context a b -> [Int]
neighbors' (Adj b
p,Int
_,a
_,Adj b
s) = ((b, Int) -> Int) -> Adj b -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (b, Int) -> Int
forall a b. (a, b) -> b
snd Adj b
p[Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++((b, Int) -> Int) -> Adj b -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (b, Int) -> Int
forall a b. (a, b) -> b
snd Adj b
s
lneighbors' :: Context a b -> Adj b
lneighbors' :: forall a b. Context a b -> Adj b
lneighbors' (Adj b
p,Int
_,a
_,Adj b
s) = Adj b
p Adj b -> Adj b -> Adj b
forall a. [a] -> [a] -> [a]
++ Adj b
s
suc' :: Context a b -> [Node]
suc' :: forall a b. Context a b -> [Int]
suc' = ((b, Int) -> Int) -> [(b, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (b, Int) -> Int
forall a b. (a, b) -> b
snd ([(b, Int)] -> [Int])
-> (Context a b -> [(b, Int)]) -> Context a b -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a b -> [(b, Int)]
forall a b. Context a b -> Adj b
context4l'
pre' :: Context a b -> [Node]
pre' :: forall a b. Context a b -> [Int]
pre' = ((b, Int) -> Int) -> [(b, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (b, Int) -> Int
forall a b. (a, b) -> b
snd ([(b, Int)] -> [Int])
-> (Context a b -> [(b, Int)]) -> Context a b -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a b -> [(b, Int)]
forall a b. Context a b -> Adj b
context1l'
lsuc' :: Context a b -> [(Node,b)]
lsuc' :: forall a b. Context a b -> [(Int, b)]
lsuc' = ((b, Int) -> (Int, b)) -> [(b, Int)] -> [(Int, b)]
forall a b. (a -> b) -> [a] -> [b]
map (b, Int) -> (Int, b)
forall a b. (a, b) -> (b, a)
flip2 ([(b, Int)] -> [(Int, b)])
-> (Context a b -> [(b, Int)]) -> Context a b -> [(Int, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a b -> [(b, Int)]
forall a b. Context a b -> Adj b
context4l'
lpre' :: Context a b -> [(Node,b)]
lpre' :: forall a b. Context a b -> [(Int, b)]
lpre' = ((b, Int) -> (Int, b)) -> [(b, Int)] -> [(Int, b)]
forall a b. (a -> b) -> [a] -> [b]
map (b, Int) -> (Int, b)
forall a b. (a, b) -> (b, a)
flip2 ([(b, Int)] -> [(Int, b)])
-> (Context a b -> [(b, Int)]) -> Context a b -> [(Int, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a b -> [(b, Int)]
forall a b. Context a b -> Adj b
context1l'
out' :: Context a b -> [LEdge b]
out' :: forall a b. Context a b -> [LEdge b]
out' c :: Context a b
c@(Adj b
_,Int
v,a
_,Adj b
_) = ((b, Int) -> LEdge b) -> Adj b -> [LEdge b]
forall a b. (a -> b) -> [a] -> [b]
map (\(b
l,Int
w)->(Int
v,Int
w,b
l)) (Context a b -> Adj b
forall a b. Context a b -> Adj b
context4l' Context a b
c)
inn' :: Context a b -> [LEdge b]
inn' :: forall a b. Context a b -> [LEdge b]
inn' c :: Context a b
c@(Adj b
_,Int
v,a
_,Adj b
_) = ((b, Int) -> LEdge b) -> Adj b -> [LEdge b]
forall a b. (a -> b) -> [a] -> [b]
map (\(b
l,Int
w)->(Int
w,Int
v,b
l)) (Context a b -> Adj b
forall a b. Context a b -> Adj b
context1l' Context a b
c)
outdeg' :: Context a b -> Int
outdeg' :: forall a b. Context a b -> Int
outdeg' = [(b, Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(b, Int)] -> Int)
-> (Context a b -> [(b, Int)]) -> Context a b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a b -> [(b, Int)]
forall a b. Context a b -> Adj b
context4l'
indeg' :: Context a b -> Int
indeg' :: forall a b. Context a b -> Int
indeg' = [(b, Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(b, Int)] -> Int)
-> (Context a b -> [(b, Int)]) -> Context a b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a b -> [(b, Int)]
forall a b. Context a b -> Adj b
context1l'
deg' :: Context a b -> Int
deg' :: forall a b. Context a b -> Int
deg' (Adj b
p,Int
_,a
_,Adj b
s) = Adj b -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Adj b
pInt -> Int -> Int
forall a. Num a => a -> a -> a
+Adj b -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Adj b
s
hasEdge :: Graph gr => gr a b -> Edge -> Bool
hasEdge :: forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> (Int, Int) -> Bool
hasEdge gr a b
gr (Int
v,Int
w) = Int
w Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` gr a b -> Int -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
suc gr a b
gr Int
v
hasNeighbor :: Graph gr => gr a b -> Node -> Node -> Bool
hasNeighbor :: forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Int -> Bool
hasNeighbor gr a b
gr Int
v Int
w = Int
w Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` gr a b -> Int -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
neighbors gr a b
gr Int
v
hasLEdge :: (Graph gr, Eq b) => gr a b -> LEdge b -> Bool
hasLEdge :: forall (gr :: * -> * -> *) b a.
(Graph gr, Eq b) =>
gr a b -> LEdge b -> Bool
hasLEdge gr a b
gr (Int
v,Int
w,b
l) = (Int
w,b
l) (Int, b) -> [(Int, b)] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` gr a b -> Int -> [(Int, b)]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [(Int, b)]
lsuc gr a b
gr Int
v
hasNeighborAdj :: (Graph gr, Eq b) => gr a b -> Node -> (b,Node) -> Bool
hasNeighborAdj :: forall (gr :: * -> * -> *) b a.
(Graph gr, Eq b) =>
gr a b -> Int -> (b, Int) -> Bool
hasNeighborAdj gr a b
gr Int
v (b, Int)
a = (b, Int)
a (b, Int) -> [(b, Int)] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` gr a b -> Int -> [(b, Int)]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
lneighbors gr a b
gr Int
v
slabNodes :: (Graph gr) => gr a b -> [LNode a]
slabNodes :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
slabNodes = (LNode a -> LNode a -> Ordering) -> [LNode a] -> [LNode a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (LNode a -> Int) -> LNode a -> LNode a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LNode a -> Int
forall a b. (a, b) -> a
fst) ([LNode a] -> [LNode a])
-> (gr a b -> [LNode a]) -> gr a b -> [LNode a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> [LNode a]
forall a b. gr a b -> [LNode a]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes
glabEdges :: (Graph gr) => gr a b -> [GroupEdges b]
glabEdges :: forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> [GroupEdges b]
glabEdges = ([LEdge b] -> GroupEdges b) -> [[LEdge b]] -> [GroupEdges b]
forall a b. (a -> b) -> [a] -> [b]
map (LEdge [b] -> GroupEdges b
forall b. LEdge [b] -> GroupEdges b
GEs (LEdge [b] -> GroupEdges b)
-> ([LEdge b] -> LEdge [b]) -> [LEdge b] -> GroupEdges b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LEdge b] -> LEdge [b]
forall {b}. [LEdge b] -> LEdge [b]
groupLabels)
([[LEdge b]] -> [GroupEdges b])
-> (gr a b -> [[LEdge b]]) -> gr a b -> [GroupEdges b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LEdge b -> LEdge b -> Bool) -> [LEdge b] -> [[LEdge b]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ((Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((Int, Int) -> (Int, Int) -> Bool)
-> (LEdge b -> (Int, Int)) -> LEdge b -> LEdge b -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LEdge b -> (Int, Int)
forall b. LEdge b -> (Int, Int)
toEdge)
([LEdge b] -> [[LEdge b]])
-> (gr a b -> [LEdge b]) -> gr a b -> [[LEdge b]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LEdge b -> LEdge b -> Ordering) -> [LEdge b] -> [LEdge b]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Int, Int) -> (Int, Int) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Int, Int) -> (Int, Int) -> Ordering)
-> (LEdge b -> (Int, Int)) -> LEdge b -> LEdge b -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LEdge b -> (Int, Int)
forall b. LEdge b -> (Int, Int)
toEdge)
([LEdge b] -> [LEdge b])
-> (gr a b -> [LEdge b]) -> gr a b -> [LEdge b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> [LEdge b]
forall a b. gr a b -> [LEdge b]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges
where
groupLabels :: [LEdge b] -> LEdge [b]
groupLabels [LEdge b]
les = (Int, Int) -> [b] -> LEdge [b]
forall b. (Int, Int) -> b -> LEdge b
toLEdge (LEdge b -> (Int, Int)
forall b. LEdge b -> (Int, Int)
toEdge ([LEdge b] -> LEdge b
forall a. HasCallStack => [a] -> a
head [LEdge b]
les)) ((LEdge b -> b) -> [LEdge b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map LEdge b -> b
forall b. LEdge b -> b
edgeLabel [LEdge b]
les)
equal :: (Eq a,Eq b,Graph gr) => gr a b -> gr a b -> Bool
equal :: forall a b (gr :: * -> * -> *).
(Eq a, Eq b, Graph gr) =>
gr a b -> gr a b -> Bool
equal gr a b
g gr a b
g' = gr a b -> [LNode a]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
slabNodes gr a b
g [LNode a] -> [LNode a] -> Bool
forall a. Eq a => a -> a -> Bool
== gr a b -> [LNode a]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
slabNodes gr a b
g' Bool -> Bool -> Bool
&& gr a b -> [GroupEdges b]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> [GroupEdges b]
glabEdges gr a b
g [GroupEdges b] -> [GroupEdges b] -> Bool
forall a. Eq a => a -> a -> Bool
== gr a b -> [GroupEdges b]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> [GroupEdges b]
glabEdges gr a b
g'
newtype GroupEdges b = GEs (LEdge [b])
deriving (Int -> GroupEdges b -> ShowS
[GroupEdges b] -> ShowS
GroupEdges b -> String
(Int -> GroupEdges b -> ShowS)
-> (GroupEdges b -> String)
-> ([GroupEdges b] -> ShowS)
-> Show (GroupEdges b)
forall b. Show b => Int -> GroupEdges b -> ShowS
forall b. Show b => [GroupEdges b] -> ShowS
forall b. Show b => GroupEdges b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall b. Show b => Int -> GroupEdges b -> ShowS
showsPrec :: Int -> GroupEdges b -> ShowS
$cshow :: forall b. Show b => GroupEdges b -> String
show :: GroupEdges b -> String
$cshowList :: forall b. Show b => [GroupEdges b] -> ShowS
showList :: [GroupEdges b] -> ShowS
Show, ReadPrec [GroupEdges b]
ReadPrec (GroupEdges b)
Int -> ReadS (GroupEdges b)
ReadS [GroupEdges b]
(Int -> ReadS (GroupEdges b))
-> ReadS [GroupEdges b]
-> ReadPrec (GroupEdges b)
-> ReadPrec [GroupEdges b]
-> Read (GroupEdges b)
forall b. Read b => ReadPrec [GroupEdges b]
forall b. Read b => ReadPrec (GroupEdges b)
forall b. Read b => Int -> ReadS (GroupEdges b)
forall b. Read b => ReadS [GroupEdges b]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall b. Read b => Int -> ReadS (GroupEdges b)
readsPrec :: Int -> ReadS (GroupEdges b)
$creadList :: forall b. Read b => ReadS [GroupEdges b]
readList :: ReadS [GroupEdges b]
$creadPrec :: forall b. Read b => ReadPrec (GroupEdges b)
readPrec :: ReadPrec (GroupEdges b)
$creadListPrec :: forall b. Read b => ReadPrec [GroupEdges b]
readListPrec :: ReadPrec [GroupEdges b]
Read)
instance (Eq b) => Eq (GroupEdges b) where
(GEs (Int
v1,Int
w1,[b]
bs1)) == :: GroupEdges b -> GroupEdges b -> Bool
== (GEs (Int
v2,Int
w2,[b]
bs2)) = Int
v1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
v2
Bool -> Bool -> Bool
&& Int
w1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
w2
Bool -> Bool -> Bool
&& [b] -> [b] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
eqLists [b]
bs1 [b]
bs2
eqLists :: (Eq a) => [a] -> [a] -> Bool
eqLists :: forall a. Eq a => [a] -> [a] -> Bool
eqLists [a]
xs [a]
ys = [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a]
xs [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
ys) Bool -> Bool -> Bool
&& [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a]
ys [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
xs)
(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
.: :: forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
(.:) = ((b -> c) -> b -> d) -> (a -> b -> c) -> a -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (((b -> c) -> b -> d) -> (a -> b -> c) -> a -> b -> d)
-> ((c -> d) -> (b -> c) -> b -> d)
-> (c -> d)
-> (a -> b -> c)
-> a
-> b
-> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> d) -> (b -> c) -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
flip2 :: (a,b) -> (b,a)
flip2 :: forall a b. (a, b) -> (b, a)
flip2 (a
x,b
y) = (b
y,a
x)
context1l :: (Graph gr) => gr a b -> Node -> Adj b
context1l :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context1l = Adj b -> (Context a b -> Adj b) -> Maybe (Context a b) -> Adj b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Context a b -> Adj b
forall a b. Context a b -> Adj b
context1l' (Maybe (Context a b) -> Adj b)
-> (gr a b -> Int -> Maybe (Context a b)) -> gr a b -> Int -> Adj b
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: gr a b -> Int -> Maybe (Context a b)
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> MContext a b
mcontext
context4l :: (Graph gr) => gr a b -> Node -> Adj b
context4l :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context4l = Adj b -> (Context a b -> Adj b) -> Maybe (Context a b) -> Adj b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Context a b -> Adj b
forall a b. Context a b -> Adj b
context4l' (Maybe (Context a b) -> Adj b)
-> (gr a b -> Int -> Maybe (Context a b)) -> gr a b -> Int -> Adj b
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: gr a b -> Int -> Maybe (Context a b)
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> MContext a b
mcontext
mcontext :: (Graph gr) => gr a b -> Node -> MContext a b
mcontext :: forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> MContext a b
mcontext = (MContext a b, gr a b) -> MContext a b
forall a b. (a, b) -> a
fst ((MContext a b, gr a b) -> MContext a b)
-> (gr a b -> Int -> (MContext a b, gr a b))
-> gr a b
-> Int
-> MContext a b
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: (Int -> gr a b -> (MContext a b, gr a b))
-> gr a b -> Int -> (MContext a b, gr a b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> gr a b -> (MContext a b, gr a b)
forall a b. Int -> gr a b -> Decomp gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
match
context1l' :: Context a b -> Adj b
context1l' :: forall a b. Context a b -> Adj b
context1l' (Adj b
p,Int
v,a
_,Adj b
s) = Adj b
pAdj b -> Adj b -> Adj b
forall a. [a] -> [a] -> [a]
++((b, Int) -> Bool) -> Adj b -> Adj b
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
v)(Int -> Bool) -> ((b, Int) -> Int) -> (b, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(b, Int) -> Int
forall a b. (a, b) -> b
snd) Adj b
s
context4l' :: Context a b -> Adj b
context4l' :: forall a b. Context a b -> Adj b
context4l' (Adj b
p,Int
v,a
_,Adj b
s) = Adj b
sAdj b -> Adj b -> Adj b
forall a. [a] -> [a] -> [a]
++((b, Int) -> Bool) -> Adj b -> Adj b
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
v)(Int -> Bool) -> ((b, Int) -> Int) -> (b, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(b, Int) -> Int
forall a b. (a, b) -> b
snd) Adj b
p
prettify :: (DynGraph gr, Show a, Show b) => gr a b -> String
prettify :: forall (gr :: * -> * -> *) a b.
(DynGraph gr, Show a, Show b) =>
gr a b -> String
prettify gr a b
g = (Int -> ShowS -> ShowS) -> ShowS -> [Int] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Adj b, Int, a, Adj b) -> ShowS -> ShowS
forall {a} {a} {a} {a} {a}.
(Show a, Show a, Show a) =>
(a, a, a, a) -> (a -> String) -> a -> String
showsContext ((Adj b, Int, a, Adj b) -> ShowS -> ShowS)
-> (Int -> (Adj b, Int, a, Adj b)) -> Int -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> Int -> (Adj b, Int, a, Adj b)
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Context a b
context gr a b
g) ShowS
forall a. a -> a
id (gr a b -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Int]
nodes gr a b
g) String
""
where
showsContext :: (a, a, a, a) -> (a -> String) -> a -> String
showsContext (a
_,a
n,a
l,a
s) a -> String
sg = a -> ShowS
forall a. Show a => a -> ShowS
shows a
n ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
':'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
l
ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"->" ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
s
ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'\n'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
sg
prettyPrint :: (DynGraph gr, Show a, Show b) => gr a b -> IO ()
prettyPrint :: forall (gr :: * -> * -> *) a b.
(DynGraph gr, Show a, Show b) =>
gr a b -> IO ()
prettyPrint = String -> IO ()
putStr (String -> IO ()) -> (gr a b -> String) -> gr a b -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> String
forall (gr :: * -> * -> *) a b.
(DynGraph gr, Show a, Show b) =>
gr a b -> String
prettify
newtype OrdGr gr a b = OrdGr { forall {k} {k} (gr :: k -> k -> *) (a :: k) (b :: k).
OrdGr gr a b -> gr a b
unOrdGr :: gr a b }
deriving (ReadPrec [OrdGr gr a b]
ReadPrec (OrdGr gr a b)
Int -> ReadS (OrdGr gr a b)
ReadS [OrdGr gr a b]
(Int -> ReadS (OrdGr gr a b))
-> ReadS [OrdGr gr a b]
-> ReadPrec (OrdGr gr a b)
-> ReadPrec [OrdGr gr a b]
-> Read (OrdGr gr a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k k (gr :: k -> k -> *) (a :: k) (b :: k).
Read (gr a b) =>
ReadPrec [OrdGr gr a b]
forall k k (gr :: k -> k -> *) (a :: k) (b :: k).
Read (gr a b) =>
ReadPrec (OrdGr gr a b)
forall k k (gr :: k -> k -> *) (a :: k) (b :: k).
Read (gr a b) =>
Int -> ReadS (OrdGr gr a b)
forall k k (gr :: k -> k -> *) (a :: k) (b :: k).
Read (gr a b) =>
ReadS [OrdGr gr a b]
$creadsPrec :: forall k k (gr :: k -> k -> *) (a :: k) (b :: k).
Read (gr a b) =>
Int -> ReadS (OrdGr gr a b)
readsPrec :: Int -> ReadS (OrdGr gr a b)
$creadList :: forall k k (gr :: k -> k -> *) (a :: k) (b :: k).
Read (gr a b) =>
ReadS [OrdGr gr a b]
readList :: ReadS [OrdGr gr a b]
$creadPrec :: forall k k (gr :: k -> k -> *) (a :: k) (b :: k).
Read (gr a b) =>
ReadPrec (OrdGr gr a b)
readPrec :: ReadPrec (OrdGr gr a b)
$creadListPrec :: forall k k (gr :: k -> k -> *) (a :: k) (b :: k).
Read (gr a b) =>
ReadPrec [OrdGr gr a b]
readListPrec :: ReadPrec [OrdGr gr a b]
Read,Int -> OrdGr gr a b -> ShowS
[OrdGr gr a b] -> ShowS
OrdGr gr a b -> String
(Int -> OrdGr gr a b -> ShowS)
-> (OrdGr gr a b -> String)
-> ([OrdGr gr a b] -> ShowS)
-> Show (OrdGr gr a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k k (gr :: k -> k -> *) (a :: k) (b :: k).
Show (gr a b) =>
Int -> OrdGr gr a b -> ShowS
forall k k (gr :: k -> k -> *) (a :: k) (b :: k).
Show (gr a b) =>
[OrdGr gr a b] -> ShowS
forall k k (gr :: k -> k -> *) (a :: k) (b :: k).
Show (gr a b) =>
OrdGr gr a b -> String
$cshowsPrec :: forall k k (gr :: k -> k -> *) (a :: k) (b :: k).
Show (gr a b) =>
Int -> OrdGr gr a b -> ShowS
showsPrec :: Int -> OrdGr gr a b -> ShowS
$cshow :: forall k k (gr :: k -> k -> *) (a :: k) (b :: k).
Show (gr a b) =>
OrdGr gr a b -> String
show :: OrdGr gr a b -> String
$cshowList :: forall k k (gr :: k -> k -> *) (a :: k) (b :: k).
Show (gr a b) =>
[OrdGr gr a b] -> ShowS
showList :: [OrdGr gr a b] -> ShowS
Show)
instance (Graph gr, Ord a, Ord b) => Eq (OrdGr gr a b) where
OrdGr gr a b
g1 == :: OrdGr gr a b -> OrdGr gr a b -> Bool
== OrdGr gr a b
g2 = OrdGr gr a b -> OrdGr gr a b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare OrdGr gr a b
g1 OrdGr gr a b
g2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
instance (Graph gr, Ord a, Ord b) => Ord (OrdGr gr a b) where
compare :: OrdGr gr a b -> OrdGr gr a b -> Ordering
compare (OrdGr gr a b
g1) (OrdGr gr a b
g2) =
([LNode a] -> [LNode a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([LNode a] -> [LNode a] -> Ordering)
-> (gr a b -> [LNode a]) -> gr a b -> gr a b -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` [LNode a] -> [LNode a]
forall a. Ord a => [a] -> [a]
sort ([LNode a] -> [LNode a])
-> (gr a b -> [LNode a]) -> gr a b -> [LNode a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> [LNode a]
forall a b. gr a b -> [LNode a]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes) gr a b
g1 gr a b
g2
Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` ([LEdge b] -> [LEdge b] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([LEdge b] -> [LEdge b] -> Ordering)
-> (gr a b -> [LEdge b]) -> gr a b -> gr a b -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` [LEdge b] -> [LEdge b]
forall a. Ord a => [a] -> [a]
sort ([LEdge b] -> [LEdge b])
-> (gr a b -> [LEdge b]) -> gr a b -> [LEdge b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> [LEdge b]
forall a b. gr a b -> [LEdge b]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges) gr a b
g1 gr a b
g2