-- (c) 1999-2005 by Martin Erwig (see copyright at bottom)
-- | Static and Dynamic Inductive Graphs
--
-- Code is from Hackage `fgl` package version 5.7.0.3
--
module GHC.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 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

-- | 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) = [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"

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


  -- | The number of 'Node's in a '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

  -- | The minimum and maximum 'Node' in a 'Graph'.
  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

  -- | A list of all 'LEdge's in the 'Graph'.
  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
  -- | 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 = gr a b -> Int
forall a b. gr a b -> Int
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 = [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

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

-- | 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 = (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 #-}

-- | 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 = (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 #-}

-- | 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 = (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 #-}

-- | 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 = (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 #-}

-- | 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 = ((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

-- | 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 = (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

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

-- | '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 = 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

-- | 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,[])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 #-}

-- | 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)(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 #-}

-- | 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 = [Int] -> gr a b -> gr a b
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 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'

-- | 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 = ((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

-- | 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 = ((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'

-- | 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 = (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 #-}

-- | 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 = (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 #-}

-- | 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 = (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

-- | 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 = (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

-- | 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 = (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

-- | 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 = [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 (,) ())

-- | 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 = (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

-- | 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 = [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

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

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

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

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

-- | 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 = (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

-- | 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 = ((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

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

-- | 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 = ((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

-- | 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 = ((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

-- | 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 = ((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

-- | 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 = ((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

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

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

-- | 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 = [(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

-- | 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  = [(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

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

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

-- | 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 Adj b -> Adj b -> Adj b
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' = ((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'

-- | All 'Node's linked from in a 'Context'.
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'

-- | 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' = ((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'

-- | 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' = ((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'

-- | 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
_) = ((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)

-- | 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
_) = ((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)

-- | The outward degree of a 'Context'.
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'

-- | The inward degree of a 'Context'.
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'

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

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

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

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

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

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

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'
-- 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
[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)
-- 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
(.:) = ((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)

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

----------------------------------------------------------------------
-- 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 = (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

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

----------------------------------------------------------------------
-- 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)
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 (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]
$creadsPrec :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
Int -> ReadS (OrdGr gr a b)
readsPrec :: Int -> ReadS (OrdGr gr a b)
$creadList :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadS [OrdGr gr a b]
readList :: ReadS [OrdGr gr a b]
$creadPrec :: forall (gr :: * -> * -> *) a b.
Read (gr a b) =>
ReadPrec (OrdGr gr a b)
readPrec :: ReadPrec (OrdGr gr a b)
$creadListPrec :: forall (gr :: * -> * -> *) a b.
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 (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
$cshowsPrec :: forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
Int -> OrdGr gr a b -> ShowS
showsPrec :: Int -> OrdGr gr a b -> ShowS
$cshow :: forall (gr :: * -> * -> *) a b.
Show (gr a b) =>
OrdGr gr a b -> String
show :: OrdGr gr a b -> String
$cshowList :: forall (gr :: * -> * -> *) a b.
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


{-----------------------------------------------------------------

Copyright (c) 1999-2008, Martin Erwig
              2010, Ivan Lazar Miljenovic
              2022, Norman Ramsey
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

1. Redistributions of source code must retain the above copyright notice,
   this list of conditions and the following disclaimer.

2. Redistributions in binary form must reproduce the above copyright
   notice, this list of conditions and the following disclaimer in the
   documentation and/or other materials provided with the distribution.

3. Neither the name of the author nor the names of its contributors may be
   used to endorse or promote products derived from this software without
   specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.

----------------------------------------------------------------}