-- (c) 1999 - 2002 by Martin Erwig [see file COPYRIGHT]
-- | Basic Graph Algorithms
module Data.Graph.Inductive.Basic
(
    -- * Graph Operations
    grev,
    undir,unlab,
    gsel, gfold,
    -- * Filter Operations
    efilter,elfilter,
    -- * Predicates and Classifications
    hasLoop,isSimple,
    -- * Tree Operations
    postorder, postorderF, preorder, preorderF
)
where


import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.Internal.Thread (Collect, Split, SplitM, threadList,
                                             threadMaybe)

import Data.List (nub)
import Data.Tree

-- | Reverse the direction of all edges.
grev :: (DynGraph gr) => gr a b -> gr a b
grev :: forall (gr :: * -> * -> *) a b. DynGraph gr => gr a b -> gr a b
grev = forall (gr :: * -> * -> *) a b c d.
DynGraph gr =>
(Context a b -> Context c d) -> gr a b -> gr c d
gmap (\(Adj b
p,Node
v,a
l,Adj b
s)->(Adj b
s,Node
v,a
l,Adj b
p))

-- | Make the graph undirected, i.e. for every edge from A to B, there
-- exists an edge from B to A.
undir :: (Eq b,DynGraph gr) => gr a b -> gr a b
undir :: forall b (gr :: * -> * -> *) a.
(Eq b, DynGraph gr) =>
gr a b -> gr a b
undir = forall (gr :: * -> * -> *) a b c d.
DynGraph gr =>
(Context a b -> Context c d) -> gr a b -> gr c d
gmap (\(Adj b
p,Node
v,a
l,Adj b
s)->let ps :: Adj b
ps = forall a. Eq a => [a] -> [a]
nub (Adj b
pforall a. [a] -> [a] -> [a]
++Adj b
s) in (Adj b
ps,Node
v,a
l,Adj b
ps))
-- this version of undir considers edge lables and keeps edges with
-- different labels, an alternative is the definition below:
--   undir = gmap (\(p,v,l,s)->
--           let ps = nubBy (\x y->snd x==snd y) (p++s) in (ps,v,l,ps))

-- | Remove all labels.
unlab :: (DynGraph gr) => gr a b -> gr () ()
unlab :: forall (gr :: * -> * -> *) a b. DynGraph gr => gr a b -> gr () ()
unlab = forall (gr :: * -> * -> *) a b c d.
DynGraph gr =>
(Context a b -> Context c d) -> gr a b -> gr c d
gmap (\(Adj b
p,Node
v,a
_,Adj b
s)->(forall {a} {b}. [(a, b)] -> [((), b)]
unlabAdj Adj b
p,Node
v,(),forall {a} {b}. [(a, b)] -> [((), b)]
unlabAdj Adj b
s))
        where unlabAdj :: [(a, b)] -> [((), b)]
unlabAdj = forall a b. (a -> b) -> [a] -> [b]
map (\(a
_,b
v)->((),b
v))
-- alternative:
--    unlab = nmap (\_->()) . emap (\_->())

-- | Return all 'Context's for which the given function returns 'True'.
gsel :: (Graph gr) => (Context a b -> Bool) -> gr a b -> [Context a b]
gsel :: forall (gr :: * -> * -> *) a b.
Graph gr =>
(Context a b -> Bool) -> gr a b -> [Context a b]
gsel Context a b -> Bool
p = 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]
cs->if Context a b -> Bool
p Context a b
c then Context a b
cforall a. a -> [a] -> [a]
:[Context a b]
cs else [Context a b]
cs) []


-- filter operations
--
-- efilter  : filter based on edge property
-- elfilter : filter based on edge label property
--

-- | Filter based on edge property.
efilter :: (DynGraph gr) => (LEdge b -> Bool) -> gr a b -> gr a b
efilter :: forall (gr :: * -> * -> *) b a.
DynGraph gr =>
(LEdge b -> Bool) -> gr a b -> gr a b
efilter LEdge b -> Bool
f = forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c -> c) -> c -> gr a b -> c
ufold forall {gr :: * -> * -> *} {a}.
DynGraph gr =>
([(b, Node)], Node, a, [(b, Node)]) -> gr a b -> gr a b
cfilter forall (gr :: * -> * -> *) a b. Graph gr => gr a b
empty
            where cfilter :: ([(b, Node)], Node, a, [(b, Node)]) -> gr a b -> gr a b
cfilter ([(b, Node)]
p,Node
v,a
l,[(b, Node)]
s) gr a b
g = ([(b, Node)]
p',Node
v,a
l,[(b, Node)]
s') forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
& gr a b
g
                   where p' :: [(b, Node)]
p' = forall a. (a -> Bool) -> [a] -> [a]
filter (\(b
b,Node
u)->LEdge b -> Bool
f (Node
u,Node
v,b
b)) [(b, Node)]
p
                         s' :: [(b, Node)]
s' = forall a. (a -> Bool) -> [a] -> [a]
filter (\(b
b,Node
w)->LEdge b -> Bool
f (Node
v,Node
w,b
b)) [(b, Node)]
s

-- | Filter based on edge label property.
elfilter :: (DynGraph gr) => (b -> Bool) -> gr a b -> gr a b
elfilter :: forall (gr :: * -> * -> *) b a.
DynGraph gr =>
(b -> Bool) -> gr a b -> gr a b
elfilter b -> Bool
f = forall (gr :: * -> * -> *) b a.
DynGraph gr =>
(LEdge b -> Bool) -> gr a b -> gr a b
efilter (\(Node
_,Node
_,b
b)->b -> Bool
f b
b)


-- some predicates and classifications
--

-- | 'True' if the graph has any edges of the form (A, A).
hasLoop :: (Graph gr) => gr a b -> Bool
hasLoop :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
hasLoop = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b.
Graph gr =>
(Context a b -> Bool) -> gr a b -> [Context a b]
gsel (\Context a b
c->forall a b. Context a b -> Node
node' Context a b
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. Context a b -> [Node]
suc' Context a b
c)

-- | The inverse of 'hasLoop'.
isSimple :: (Graph gr) => gr a b -> Bool
isSimple :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isSimple = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
hasLoop

threadGraph :: (Graph gr) => (Context a b -> r -> t)
               -> Split (gr a b) (Context a b) r -> SplitM (gr a b) Node t
threadGraph :: forall (gr :: * -> * -> *) a b r t.
Graph gr =>
(Context a b -> r -> t)
-> Split (gr a b) (Context a b) r -> SplitM (gr a b) Node t
threadGraph Context a b -> r -> t
f Split (gr a b) (Context a b) r
c = forall i r a t j.
(i -> r -> a) -> Split t i r -> SplitM t j i -> SplitM t j a
threadMaybe Context a b -> r -> t
f Split (gr a b) (Context a b) r
c forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> Decomp gr a b
match

-- gfold1 f d b u = threadGraph (\c->d (labNode' c)) (\c->gfoldn f d b u (f c))
gfold1 :: (Graph gr) => (Context a b -> [Node]) -> (Context a b -> r -> t)
          -> Collect (Maybe t) r -> SplitM (gr a b) Node t
gfold1 :: forall (gr :: * -> * -> *) a b r t.
Graph gr =>
(Context a b -> [Node])
-> (Context a b -> r -> t)
-> Collect (Maybe t) r
-> SplitM (gr a b) Node t
gfold1 Context a b -> [Node]
f Context a b -> r -> t
d Collect (Maybe t) r
b = forall (gr :: * -> * -> *) a b r t.
Graph gr =>
(Context a b -> r -> t)
-> Split (gr a b) (Context a b) r -> SplitM (gr a b) Node t
threadGraph Context a b -> r -> t
d (forall (gr :: * -> * -> *) a b r t.
Graph gr =>
(Context a b -> [Node])
-> (Context a b -> r -> t)
-> Collect (Maybe t) r
-> [Node]
-> gr a b
-> (r, gr a b)
gfoldn Context a b -> [Node]
f Context a b -> r -> t
d Collect (Maybe t) r
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a b -> [Node]
f)

gfoldn :: (Graph gr) => (Context a b -> [Node]) -> (Context a b -> r -> t)
          -> Collect (Maybe t) r -> [Node] -> gr a b -> (r, gr a b)
gfoldn :: forall (gr :: * -> * -> *) a b r t.
Graph gr =>
(Context a b -> [Node])
-> (Context a b -> r -> t)
-> Collect (Maybe t) r
-> [Node]
-> gr a b
-> (r, gr a b)
gfoldn Context a b -> [Node]
f Context a b -> r -> t
d Collect (Maybe t) r
b = forall r c t i. Collect r c -> Split t i r -> [i] -> t -> (c, t)
threadList Collect (Maybe t) r
b (forall (gr :: * -> * -> *) a b r t.
Graph gr =>
(Context a b -> [Node])
-> (Context a b -> r -> t)
-> Collect (Maybe t) r
-> SplitM (gr a b) Node t
gfold1 Context a b -> [Node]
f Context a b -> r -> t
d Collect (Maybe t) r
b)

-- gfold :: ((Context a b) -> [Node]) -> ((Node,a) -> c -> d) ->
--          (Maybe d -> c -> c) -> c -> [Node] -> Graph a b -> c
-- gfold f d b u l g = fst (gfoldn f d b u l g)

-- type Dir a b    = (Context a b) -> [Node]  -- direction of fold
-- type Dagg a b c = (Node,a) -> b -> c       -- depth aggregation
-- type Bagg a b   = (Maybe a -> b -> b,b)    -- breadth/level aggregation
--
-- gfold :: (Dir a b) -> (Dagg a c d) -> (Bagg d c) -> [Node] -> Graph a b -> c
-- gfold f d (b,u) l g = fst (gfoldn f d b u l g)

-- | Directed graph fold.
gfold :: (Graph gr) =>   (Context a b -> [Node])    -- ^ direction of fold
        -> (Context a b -> c -> d)    -- ^ depth aggregation
        -> (Maybe d -> c -> c, c)      -- ^ breadth\/level aggregation
        -> [Node]
        -> gr a b
        -> c
gfold :: forall (gr :: * -> * -> *) a b c d.
Graph gr =>
(Context a b -> [Node])
-> (Context a b -> c -> d)
-> (Maybe d -> c -> c, c)
-> [Node]
-> gr a b
-> c
gfold Context a b -> [Node]
f Context a b -> c -> d
d (Maybe d -> c -> c, c)
b [Node]
l gr a b
g = forall a b. (a, b) -> a
fst (forall (gr :: * -> * -> *) a b r t.
Graph gr =>
(Context a b -> [Node])
-> (Context a b -> r -> t)
-> Collect (Maybe t) r
-> [Node]
-> gr a b
-> (r, gr a b)
gfoldn Context a b -> [Node]
f Context a b -> c -> d
d (Maybe d -> c -> c, c)
b [Node]
l gr a b
g)

-- not finished yet ...
--
-- undirBy :: (b -> b -> b) -> Graph a b -> Graph a b
-- undirBy = gmap (\(p,v,l,s)->let ps = nub (p++s) in (ps,v,l,ps))

-- | Flatten a 'Tree', returning the elements in post-order.
postorder :: Tree a -> [a]
postorder :: forall a. Tree a -> [a]
postorder (Node a
v [Tree a]
ts) = forall a. [Tree a] -> [a]
postorderF [Tree a]
ts forall a. [a] -> [a] -> [a]
++ [a
v]

-- | Flatten multiple 'Tree's in post-order.
postorderF :: [Tree a] -> [a]
postorderF :: forall a. [Tree a] -> [a]
postorderF = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Tree a -> [a]
postorder

-- | Flatten a 'Tree', returning the elements in pre-order.  Equivalent to
--'flatten' in 'Data.Tree'.
preorder :: Tree a -> [a]
preorder :: forall a. Tree a -> [a]
preorder = forall a. Tree a -> [a]
flatten

-- | Flatten multiple 'Tree's in pre-order.
preorderF :: [Tree a] -> [a]
preorderF :: forall a. [Tree a] -> [a]
preorderF = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Tree a -> [a]
preorder