{-# LANGUAGE CPP #-}

-- (c) 1999-2005 by Martin Erwig [see file COPYRIGHT]
-- | Static and Dynamic Inductive Graphs
module Data.Graph.Inductive.Graph (
    -- * General Type Defintions
    -- ** Node and Edge Types
    Node,LNode,UNode,
    Edge,LEdge,UEdge,
    -- ** Types Supporting Inductive Graph View
    Adj,Context,MContext,Decomp,GDecomp,UContext,UDecomp,
    Path,LPath(..),UPath,
    -- * Graph Type Classes
    -- | We define two graph classes:
    --
    --   Graph: static, decomposable graphs.
    --    Static means that a graph itself cannot be changed
    --
    --   DynGraph: dynamic, extensible graphs.
    --             Dynamic graphs inherit all operations from static graphs
    --             but also offer operations to extend and change graphs.
    --
    -- Each class contains in addition to its essential operations those
    -- derived operations that might be overwritten by a more efficient
    -- implementation in an instance definition.
    --
    -- Note that labNodes is essentially needed because the default definition
    -- for matchAny is based on it: we need some node from the graph to define
    -- matchAny in terms of match. Alternatively, we could have made matchAny
    -- essential and have labNodes defined in terms of ufold and matchAny.
    -- However, in general, labNodes seems to be (at least) as easy to define
    -- as matchAny. We have chosen labNodes instead of the function nodes since
    -- nodes can be easily derived from labNodes, but not vice versa.
    Graph(..),
    DynGraph(..),
    -- * Operations
    order,
    size,
    -- ** Graph Folds and Maps
    ufold,gmap,nmap,emap,nemap,
    -- ** Graph Projection
    nodes,edges,toEdge,edgeLabel,toLEdge,newNodes,gelem,
    -- ** Graph Construction and Destruction
    insNode,insEdge,delNode,delEdge,delLEdge,delAllLEdge,
    insNodes,insEdges,delNodes,delEdges,
    buildGr,mkUGraph,
    -- ** Subgraphs
    gfiltermap,nfilter,labnfilter,labfilter,subgraph,
    -- ** Graph Inspection
    context,lab,neighbors,lneighbors,
    suc,pre,lsuc,lpre,
    out,inn,outdeg,indeg,deg,
    hasEdge,hasNeighbor,hasLEdge,hasNeighborAdj,
    equal,
    -- ** Context Inspection
    node',lab',labNode',neighbors',lneighbors',
    suc',pre',lpre',lsuc',
    out',inn',outdeg',indeg',deg',
    -- * Pretty-printing
    prettify,
    prettyPrint,
    -- * Ordering of Graphs
    OrdGr(..)
) where

import           Control.Arrow (first)
import           Data.Function (on)
import qualified Data.IntSet   as IntSet
import           Data.List     (delete, foldl', groupBy, sort, sortBy, (\\))
import           Data.Maybe    (fromMaybe, isJust)

#if __GLASGOW_HASKELL__ < 710
import Data.Monoid (mappend)
#endif

-- | Unlabeled node
type  Node   = Int
-- | Labeled node
type LNode a = (Node,a)
-- | Quasi-unlabeled node
type UNode   = LNode ()

-- | Unlabeled edge
type  Edge   = (Node,Node)
-- | Labeled edge
type LEdge b = (Node,Node,b)
-- | Quasi-unlabeled edge
type UEdge   = LEdge ()

-- | Unlabeled path
type Path    = [Node]
-- | Labeled path
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) = 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
xforall 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]
_)) = forall a. Ord a => a -> a -> Ordering
compare a
x a
y
  compare LPath a
_ LPath a
_ = forall a. HasCallStack => String -> a
error String
"LPath: cannot compare two empty paths"

-- | Quasi-unlabeled path
type UPath   = [UNode]

-- | Labeled links to or from a 'Node'.
type Adj b        = [(b,Node)]
-- | Links to the 'Node', the 'Node' itself, a label, links from the 'Node'.
--
--   In other words, this captures all information regarding the
--   specified 'Node' within a graph.
type Context a b  = (Adj b,Node,a,Adj b) -- Context a b "=" Context' a b "+" Node
type MContext a b = Maybe (Context a b)
-- | 'Graph' decomposition - the context removed from a 'Graph', and the rest
-- of the 'Graph'.
type Decomp g a b = (MContext a b,g a b)
-- | The same as 'Decomp', only more sure of itself.
type GDecomp g a b  = (Context a b,g a b)

-- | Unlabeled context.
type UContext     = ([Node],Node,[Node])
-- | Unlabeled decomposition.
type UDecomp g    = (Maybe UContext,g)

-- | Minimum implementation: 'empty', 'isEmpty', 'match', 'mkGraph', 'labNodes'
class Graph gr where
  {-# MINIMAL empty, isEmpty, match, mkGraph, labNodes #-}

  -- | An empty 'Graph'.
  empty     :: gr a b

  -- | True if the given 'Graph' is empty.
  isEmpty   :: gr a b -> Bool

  -- | Decompose a 'Graph' into the 'MContext' found for the given node and the
  -- remaining 'Graph'.
  match     :: Node -> gr a b -> Decomp gr a b

  -- | Create a 'Graph' from the list of 'LNode's and 'LEdge's.
  --
  --   For graphs that are also instances of 'DynGraph', @mkGraph ns
  --   es@ should be equivalent to @('insEdges' es . 'insNodes' ns)
  --   'empty'@.
  mkGraph   :: [LNode a] -> [LEdge b] -> gr a b

  -- | A list of all 'LNode's in the 'Graph'.
  labNodes  :: gr a b -> [LNode a]

  -- | Decompose a graph into the 'Context' for an arbitrarily-chosen 'Node'
  -- and the remaining 'Graph'.
  matchAny  :: gr a b -> GDecomp gr a b
  matchAny gr a b
g = case forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes gr a b
g of
                 []      -> forall a. HasCallStack => String -> a
error String
"Match Exception, Empty Graph"
                 (Int
v,a
_):[LNode a]
_ -> (Context a b
c,gr a b
g')
                   where
                     (Just Context a b
c,gr a b
g') = forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
match Int
v gr a b
g

  -- | The number of 'Node's in a 'Graph'.
  noNodes   :: gr a b -> Int
  noNodes = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes

  -- | The minimum and maximum 'Node' in a 'Graph'.
  nodeRange :: gr a b -> (Node,Node)
  nodeRange gr a b
g
    | forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = forall a. HasCallStack => String -> a
error String
"nodeRange of empty graph"
    | Bool
otherwise = (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int]
vs, forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
vs)
    where
      vs :: [Int]
vs = forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Int]
nodes gr a b
g

  -- | A list of all 'LEdge's in the 'Graph'.
  labEdges  :: gr a b -> [LEdge b]
  labEdges = 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)->(forall a b. (a -> b) -> [a] -> [b]
map (\(b
l,Int
w)->(Int
v,Int
w,b
l)) Adj b
s forall a. [a] -> [a] -> [a]
++)) []

class (Graph gr) => DynGraph gr where
  -- | Merge the 'Context' into the 'DynGraph'.
  --
  --   Context adjacencies should only refer to either a Node already
  --   in a graph or the node in the Context itself (for loops).
  --
  --   Behaviour is undefined if the specified 'Node' already exists
  --   in the graph.
  (&) :: Context a b -> gr a b -> gr a b


-- | The number of nodes in the graph.  An alias for 'noNodes'.
order :: (Graph gr) => gr a b -> Int
order :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int
order = forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int
noNodes

-- | The number of edges in the graph.
--
--   Note that this counts every edge found, so if you are
--   representing an unordered graph by having each edge mirrored this
--   will be incorrect.
--
--   If you created an unordered graph by either mirroring every edge
--   (including loops!) or using the @undir@ function in
--   "Data.Graph.Inductive.Basic" then you can safely halve the value
--   returned by this.
size :: (Graph gr) => gr a b -> Int
size :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int
size = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges

-- | Fold a function over the graph by recursively calling 'match'.
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
  | 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 (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') = forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> GDecomp gr a b
matchAny gr a b
g

-- | Map a function over the graph by recursively calling 'match'.
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 = 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
cforall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
&)) forall (gr :: * -> * -> *) a b. Graph gr => gr a b
empty
{-# NOINLINE [0] gmap #-}

-- | Map a function over the 'Node' labels in a graph.
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 = 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 #-}

-- | Map a function over the 'Edge' labels in a graph.
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 = 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)->(forall {b} {c} {d}. (b -> c) -> [(b, d)] -> [(c, d)]
map1 b -> c
f Adj b
p,Int
v,a
l,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 = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first b -> c
g)
{-# NOINLINE [0] emap #-}

-- | Map functions over both the 'Node' and 'Edge' labels in a graph.
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 = 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) -> (forall {d}. [(b, d)] -> [(d, d)]
fe' Adj b
p,Int
v,a -> c
fn a
l,forall {d}. [(b, d)] -> [(d, d)]
fe' Adj b
s))
  where
    fe' :: [(b, d)] -> [(d, d)]
fe' = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first b -> d
fe)
{-# NOINLINE [0] nemap #-}

-- | List all 'Node's in the 'Graph'.
nodes :: (Graph gr) => gr a b -> [Node]
nodes :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Int]
nodes = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes

-- | List all 'Edge's in the 'Graph'.
edges :: (Graph gr) => gr a b -> [Edge]
edges :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [(Int, Int)]
edges = forall a b. (a -> b) -> [a] -> [b]
map forall b. LEdge b -> (Int, Int)
toEdge forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges

-- | Drop the label component of an edge.
toEdge :: LEdge b -> Edge
toEdge :: forall b. LEdge b -> (Int, Int)
toEdge (Int
v,Int
w,b
_) = (Int
v,Int
w)

-- | Add a label to an edge.
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)

-- | The label in an edge.
edgeLabel :: LEdge b -> b
edgeLabel :: forall b. LEdge b -> b
edgeLabel (Int
_,Int
_,b
l) = b
l

-- | List N available 'Node's, i.e. 'Node's that are not used in the 'Graph'.
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
  | forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = [Int
0..Int
iforall a. Num a => a -> a -> a
-Int
1]
  | Bool
otherwise = [Int
nforall a. Num a => a -> a -> a
+Int
1..Int
nforall a. Num a => a -> a -> a
+Int
i]
  where
    (Int
_,Int
n) = forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> (Int, Int)
nodeRange gr a b
g

-- | 'True' if the 'Node' is present in the 'Graph'.
gelem :: (Graph gr) => Node -> gr a b -> Bool
gelem :: forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> Bool
gelem Int
v = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
match Int
v

-- | Insert a 'LNode' into the 'Graph'.
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,[])forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
&)
{-# NOINLINE [0] insNode #-}

-- | Insert a 'LEdge' into the 'Graph'.
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)forall a. a -> [a] -> [a]
:Adj b
su) 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') = 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) = forall a. a -> Maybe a -> a
fromMaybe
                     (forall a. HasCallStack => String -> a
error (String
"insEdge: cannot add edge from non-existent vertex " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
v))
                     MContext a b
mcxt
{-# NOINLINE [0] insEdge #-}

-- | Remove a 'Node' from the 'Graph'.
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 = forall (gr :: * -> * -> *) a b.
Graph gr =>
[Int] -> gr a b -> gr a b
delNodes [Int
v]

-- | Remove an 'Edge' from the 'Graph'.
--
--   NOTE: in the case of multiple edges, this will delete /all/ such
--   edges from the graph as there is no way to distinguish between
--   them.  If you need to delete only a single such edge, please use
--   'delLEdge'.
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 forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
match Int
v gr a b
g of
                    (MContext 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,forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/=Int
w)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) Adj b
s) forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
& gr a b
g'

-- | Remove an 'LEdge' from the 'Graph'.
--
--   NOTE: in the case of multiple edges with the same label, this
--   will only delete the /first/ such edge.  To delete all such
--   edges, please use 'delAllLedge'.
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 = forall (gr :: * -> * -> *) b a.
DynGraph gr =>
((b, Int) -> Adj b -> Adj b) -> LEdge b -> gr a b -> gr a b
delLEdgeBy forall a. Eq a => a -> [a] -> [a]
delete

-- | Remove all edges equal to the one specified.
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 = forall (gr :: * -> * -> *) b a.
DynGraph gr =>
((b, Int) -> Adj b -> Adj b) -> LEdge b -> gr a b -> gr a b
delLEdgeBy (forall a. (a -> Bool) -> [a] -> [a]
filter forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
match Int
v gr a b
g of
                           (MContext 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) forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
& gr a b
g'

-- | Insert multiple 'LNode's into the 'Graph'.
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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (gr :: * -> * -> *) a b.
DynGraph gr =>
LNode a -> gr a b -> gr a b
insNode) gr a b
g [LNode a]
vs
{-# INLINABLE insNodes #-}

-- | Insert multiple 'LEdge's into the 'Graph'.
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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (gr :: * -> * -> *) b a.
DynGraph gr =>
LEdge b -> gr a b -> gr a b
insEdge) gr a b
g [LEdge b]
es
{-# INLINABLE insEdges #-}

-- | Remove multiple 'Node's from the 'Graph'.
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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b. (a, b) -> b
snd forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
match) gr a b
g [Int]
vs

-- | Remove multiple 'Edge's from the 'Graph'.
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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (gr :: * -> * -> *) a b.
DynGraph gr =>
(Int, Int) -> gr a b -> gr a b
delEdge) gr a b
g [(Int, Int)]
es

-- | Build a 'Graph' from a list of 'Context's.
--
--   The list should be in the order such that earlier 'Context's
--   depend upon later ones (i.e. as produced by @'ufold' (:) []@).
buildGr :: (DynGraph gr) => [Context a b] -> gr a b
buildGr :: forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[Context a b] -> gr a b
buildGr = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
(&) forall (gr :: * -> * -> *) a b. Graph gr => gr a b
empty

-- | Build a quasi-unlabeled 'Graph'.
mkUGraph :: (Graph gr) => [Node] -> [Edge] -> gr () ()
mkUGraph :: forall (gr :: * -> * -> *).
Graph gr =>
[Int] -> [(Int, Int)] -> gr () ()
mkUGraph [Int]
vs [(Int, Int)]
es = forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph (forall {a}. [a] -> [(a, ())]
labUNodes [Int]
vs) ([(Int, Int)] -> [LEdge ()]
labUEdges [(Int, Int)]
es)
   where
     labUEdges :: [(Int, Int)] -> [LEdge ()]
labUEdges = forall a b. (a -> b) -> [a] -> [b]
map (forall b. (Int, Int) -> b -> LEdge b
`toLEdge` ())
     labUNodes :: [a] -> [(a, ())]
labUNodes = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) ())

-- | Build a graph out of the contexts for which the predicate is
-- satisfied by recursively calling 'match'.
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 = forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c -> c) -> c -> gr a b -> c
ufold (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
(&) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a b -> MContext c d
f) forall (gr :: * -> * -> *) a b. Graph gr => gr a b
empty

-- | Returns the subgraph only containing the labelled nodes which
-- satisfy the given predicate.
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 = forall (gr :: * -> * -> *) a b.
Graph gr =>
[Int] -> gr a b -> gr a b
delNodes (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. LNode a -> Bool
p) forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes gr a b
gr) gr a b
gr

-- | Returns the subgraph only containing the nodes which satisfy the
-- given predicate.
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 = forall (gr :: * -> * -> *) a b.
Graph gr =>
(LNode a -> Bool) -> gr a b -> gr a b
labnfilter (Int -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

-- | Returns the subgraph only containing the nodes whose labels
-- satisfy the given predicate.
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 = forall (gr :: * -> * -> *) a b.
Graph gr =>
(LNode a -> Bool) -> gr a b -> gr a b
labnfilter (a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

-- | Returns the subgraph induced by the supplied nodes.
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 forall (gr :: * -> * -> *) a b.
DynGraph gr =>
(Int -> Bool) -> gr a b -> gr a b
nfilter (Int -> IntSet -> Bool
`IntSet.member` IntSet
vs')

-- | Find the context for the given 'Node'.  Causes an error if the 'Node' is
-- not present in the 'Graph'.
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 = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error (String
"Match Exception, Node: "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Int
v))
                        (forall a b. (a, b) -> a
fst (forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
match Int
v gr a b
g))

-- | Find the label for a 'Node'.
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Context a b -> a
lab' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
match Int
v gr a b
g

-- | Find the neighbors for a 'Node'.
neighbors :: (Graph gr) => gr a b -> Node -> [Node]
neighbors :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
neighbors = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
lneighbors

-- | Find the labelled links coming into or going from a 'Context'.
lneighbors :: (Graph gr) => gr a b -> Node -> Adj b
lneighbors :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
lneighbors = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a b. Context a b -> Adj b
lneighbors' forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> MContext a b
mcontext

-- | Find all 'Node's that have a link from the given 'Node'.
suc :: (Graph gr) => gr a b -> Node -> [Node]
suc :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
suc = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context4l

-- | Find all 'Node's that link to to the given 'Node'.
pre :: (Graph gr) => gr a b -> Node -> [Node]
pre :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
pre = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context1l

-- | Find all 'Node's that are linked from the given 'Node' and the label of
-- each link.
lsuc :: (Graph gr) => gr a b -> Node -> [(Node,b)]
lsuc :: forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [(Int, b)]
lsuc = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
flip2 forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context4l

-- | Find all 'Node's that link to the given 'Node' and the label of each link.
lpre :: (Graph gr) => gr a b -> Node -> [(Node,b)]
lpre :: forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [(Int, b)]
lpre = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
flip2 forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context1l

-- | Find all outward-bound 'LEdge's for the given 'Node'.
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 = forall a b. (a -> b) -> [a] -> [b]
map (\(b
l,Int
w)->(Int
v,Int
w,b
l)) (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context4l gr a b
g Int
v)

-- | Find all inward-bound 'LEdge's for the given 'Node'.
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 = forall a b. (a -> b) -> [a] -> [b]
map (\(b
l,Int
w)->(Int
w,Int
v,b
l)) (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context1l gr a b
g Int
v)

-- | The outward-bound degree of the 'Node'.
outdeg :: (Graph gr) => gr a b -> Node -> Int
outdeg :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Int
outdeg = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context4l

-- | The inward-bound degree of the 'Node'.
indeg :: (Graph gr) => gr a b -> Node -> Int
indeg :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Int
indeg  = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context1l

-- | The degree of the 'Node'.
deg :: (Graph gr) => gr a b -> Node -> Int
deg :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Int
deg = forall a b. Context a b -> Int
deg' forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Context a b
context

-- | The 'Node' in a 'Context'.
node' :: Context a b -> Node
node' :: forall a b. Context a b -> Int
node' (Adj b
_,Int
v,a
_,Adj b
_) = Int
v

-- | The label in a 'Context'.
lab' :: Context a b -> a
lab' :: forall a b. Context a b -> a
lab' (Adj b
_,Int
_,a
l,Adj b
_) = a
l

-- | The 'LNode' from a 'Context'.
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)

-- | All 'Node's linked to or from in a 'Context'.
neighbors' :: Context a b -> [Node]
neighbors' :: forall a b. Context a b -> [Int]
neighbors' (Adj b
p,Int
_,a
_,Adj b
s) = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd Adj b
pforall a. [a] -> [a] -> [a]
++forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd Adj b
s

-- | All labelled links coming into or going from a 'Context'.
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 forall a. [a] -> [a] -> [a]
++ Adj b
s

-- | All 'Node's linked to in a 'Context'.
suc' :: Context a b -> [Node]
suc' :: forall a b. Context a b -> [Int]
suc' = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Context a b -> Adj b
context4l'

-- | All 'Node's linked from in a 'Context'.
pre' :: Context a b -> [Node]
pre' :: forall a b. Context a b -> [Int]
pre' = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Context a b -> Adj b
context1l'

-- | All 'Node's linked from in a 'Context', and the label of the links.
lsuc' :: Context a b -> [(Node,b)]
lsuc' :: forall a b. Context a b -> [(Int, b)]
lsuc' = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
flip2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Context a b -> Adj b
context4l'

-- | All 'Node's linked from in a 'Context', and the label of the links.
lpre' :: Context a b -> [(Node,b)]
lpre' :: forall a b. Context a b -> [(Int, b)]
lpre' = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
flip2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Context a b -> Adj b
context1l'

-- | All outward-directed 'LEdge's in a 'Context'.
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
_) = forall a b. (a -> b) -> [a] -> [b]
map (\(b
l,Int
w)->(Int
v,Int
w,b
l)) (forall a b. Context a b -> Adj b
context4l' Context a b
c)

-- | All inward-directed 'LEdge's in a 'Context'.
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
_) = forall a b. (a -> b) -> [a] -> [b]
map (\(b
l,Int
w)->(Int
w,Int
v,b
l)) (forall a b. Context a b -> Adj b
context1l' Context a b
c)

-- | The outward degree of a 'Context'.
outdeg' :: Context a b -> Int
outdeg' :: forall a b. Context a b -> Int
outdeg' = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Context a b -> Adj b
context4l'

-- | The inward degree of a 'Context'.
indeg' :: Context a b -> Int
indeg' :: forall a b. Context a b -> Int
indeg' = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Context a b -> Adj b
context1l'

-- | The degree of a 'Context'.
deg' :: Context a b -> Int
deg' :: forall a b. Context a b -> Int
deg' (Adj b
p,Int
_,a
_,Adj b
s) = forall (t :: * -> *) a. Foldable t => t a -> Int
length Adj b
pforall a. Num a => a -> a -> a
+forall (t :: * -> *) a. Foldable t => t a -> Int
length Adj b
s

-- | Checks if there is a directed edge between two nodes.
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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
suc gr a b
gr Int
v

-- | Checks if there is an undirected edge between two nodes.
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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> [Int]
neighbors gr a b
gr Int
v

-- | Checks if there is a labelled edge between two nodes.
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) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [(Int, b)]
lsuc gr a b
gr Int
v

-- | Checks if there is an undirected labelled edge between two nodes.
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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
lneighbors gr a b
gr Int
v

----------------------------------------------------------------------
-- GRAPH EQUALITY
----------------------------------------------------------------------

slabNodes :: (Graph gr) => gr a b -> [LNode a]
slabNodes :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
slabNodes = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. (a -> b) -> [a] -> [b]
map (forall b. LEdge [b] -> GroupEdges b
GEs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}. [LEdge b] -> LEdge [b]
groupLabels)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall b. LEdge b -> (Int, Int)
toEdge)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall b. LEdge b -> (Int, Int)
toEdge)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges
  where
    groupLabels :: [LEdge b] -> LEdge [b]
groupLabels [LEdge b]
les = forall b. (Int, Int) -> b -> LEdge b
toLEdge (forall b. LEdge b -> (Int, Int)
toEdge (forall a. [a] -> a
head [LEdge b]
les)) (forall a b. (a -> b) -> [a] -> [b]
map 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' = forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
slabNodes gr a b
g forall a. Eq a => a -> a -> Bool
== forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
slabNodes gr a b
g' Bool -> Bool -> Bool
&& forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> [GroupEdges b]
glabEdges gr a b
g forall a. Eq a => a -> a -> Bool
== forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> [GroupEdges b]
glabEdges gr a b
g'
-- This assumes that nodes aren't repeated (which shouldn't happen for
-- sane graph instances).  If node IDs are repeated, then the usage of
-- slabNodes cannot guarantee stable ordering.

-- Newtype wrapper just to test for equality of multiple edges.  This
-- is needed because without an Ord constraint on `b' it is not
-- possible to guarantee a stable ordering on edge labels.
newtype GroupEdges b = GEs (LEdge [b])
  deriving (Int -> GroupEdges b -> ShowS
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
showList :: [GroupEdges b] -> ShowS
$cshowList :: forall b. Show b => [GroupEdges b] -> ShowS
show :: GroupEdges b -> String
$cshow :: forall b. Show b => GroupEdges b -> String
showsPrec :: Int -> GroupEdges b -> ShowS
$cshowsPrec :: forall b. Show b => Int -> GroupEdges b -> ShowS
Show, ReadPrec [GroupEdges b]
ReadPrec (GroupEdges b)
ReadS [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
readListPrec :: ReadPrec [GroupEdges b]
$creadListPrec :: forall b. Read b => ReadPrec [GroupEdges b]
readPrec :: ReadPrec (GroupEdges b)
$creadPrec :: forall b. Read b => ReadPrec (GroupEdges b)
readList :: ReadS [GroupEdges b]
$creadList :: forall b. Read b => ReadS [GroupEdges b]
readsPrec :: Int -> ReadS (GroupEdges b)
$creadsPrec :: forall b. Read b => Int -> ReadS (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 forall a. Eq a => a -> a -> Bool
== Int
v2
                                           Bool -> Bool -> Bool
&& Int
w1 forall a. Eq a => a -> a -> Bool
== Int
w2
                                           Bool -> Bool -> 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 = forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a]
xs forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
ys) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a]
ys forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
xs)
-- OK to use \\ here as we want each value in xs to cancel a *single*
-- value in ys.

----------------------------------------------------------------------
-- UTILITIES
----------------------------------------------------------------------

-- auxiliary functions used in the implementation of the
-- derived class members
--
(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
-- f .: g = \x y->f (g x y)
-- f .: g = (f .) . g
-- (.:) f = ((f .) .)
-- (.:) = (.) (.) (.)
.: :: forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
(.:) = forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)

-- projecting on context elements
--
context1l :: (Graph gr) => gr a b -> Node -> Adj b
context1l :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Int -> Adj b
context1l = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a b. Context a b -> Adj b
context1l' forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a b. Context a b -> Adj b
context4l' forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: 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 = forall a b. (a, b) -> a
fst forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall a b c. (a -> b -> c) -> b -> a -> c
flip 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
pforall a. [a] -> [a] -> [a]
++forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
==Int
v)forall b c a. (b -> c) -> (a -> b) -> a -> c
.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
sforall a. [a] -> [a] -> [a]
++forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
==Int
v)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) Adj b
p

----------------------------------------------------------------------
-- PRETTY PRINTING
----------------------------------------------------------------------

-- | Pretty-print the graph.  Note that this loses a lot of
--   information, such as edge inverses, etc.
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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall {a} {a} {a} {a} {a}.
(Show a, Show a, Show a) =>
(a, a, a, a) -> (a -> String) -> a -> String
showsContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> Context a b
context gr a b
g) forall a. a -> a
id (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 = forall a. Show a => a -> ShowS
shows a
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
':'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows a
l
                                forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"->" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows a
s
                                forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'\n'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
sg

-- | Pretty-print the graph to stdout.
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b.
(DynGraph gr, Show a, Show b) =>
gr a b -> String
prettify

----------------------------------------------------------------------
-- Ordered Graph
----------------------------------------------------------------------

-- | OrdGr comes equipped with an Ord instance, so that graphs can be
--   used as e.g. Map keys.
newtype OrdGr gr a b = OrdGr { forall (gr :: * -> * -> *) a b. OrdGr gr a b -> gr a b
unOrdGr :: gr a b }
  deriving (ReadPrec [OrdGr gr a b]
ReadPrec (OrdGr gr a b)
ReadS [OrdGr gr a b]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadPrec [OrdGr gr a b]
forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadPrec (OrdGr gr a b)
forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
Int -> ReadS (OrdGr gr a b)
forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadS [OrdGr gr a b]
readListPrec :: ReadPrec [OrdGr gr a b]
$creadListPrec :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadPrec [OrdGr gr a b]
readPrec :: ReadPrec (OrdGr gr a b)
$creadPrec :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadPrec (OrdGr gr a b)
readList :: ReadS [OrdGr gr a b]
$creadList :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadS [OrdGr gr a b]
readsPrec :: Int -> ReadS (OrdGr gr a b)
$creadsPrec :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
Int -> ReadS (OrdGr gr a b)
Read,Int -> OrdGr gr a b -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
Int -> OrdGr gr a b -> ShowS
forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
[OrdGr gr a b] -> ShowS
forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
OrdGr gr a b -> String
showList :: [OrdGr gr a b] -> ShowS
$cshowList :: forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
[OrdGr gr a b] -> ShowS
show :: OrdGr gr a b -> String
$cshow :: forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
OrdGr gr a b -> String
showsPrec :: Int -> OrdGr gr a b -> ShowS
$cshowsPrec :: forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
Int -> 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 = forall a. Ord a => a -> a -> Ordering
compare OrdGr gr a b
g1 OrdGr gr a b
g2 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) =
    (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes) gr a b
g1 gr a b
g2
    forall a. Monoid a => a -> a -> a
`mappend` (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges) gr a b
g1 gr a b
g2