-- (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 :: gr a b -> gr a b
grev = (Context a b -> Context a b) -> gr a b -> gr a 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,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 :: gr a b -> gr a b
undir = (Context a b -> Context a b) -> gr a b -> gr a 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,Node
v,a
l,Adj b
s)->let ps :: Adj b
ps = Adj b -> Adj b
forall a. Eq a => [a] -> [a]
nub (Adj b
pAdj b -> Adj b -> Adj b
forall 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 :: gr a b -> gr () ()
unlab = (Context a b -> Context () ()) -> gr a b -> gr () ()
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)->(Adj b -> [((), Node)]
forall a b. [(a, b)] -> [((), b)]
unlabAdj Adj b
p,Node
v,(),Adj b -> [((), Node)]
forall a b. [(a, b)] -> [((), b)]
unlabAdj Adj b
s))
        where unlabAdj :: [(a, b)] -> [((), b)]
unlabAdj = ((a, b) -> ((), b)) -> [(a, b)] -> [((), b)]
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 :: (Context a b -> Bool) -> gr a b -> [Context a b]
gsel Context a b -> Bool
p = (Context a b -> [Context a b] -> [Context a b])
-> [Context a b] -> gr a b -> [Context a b]
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
cContext a b -> [Context a b] -> [Context a b]
forall 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 :: (LEdge b -> Bool) -> gr a b -> gr a b
efilter LEdge b -> Bool
f = (Context a b -> gr a b -> gr a b) -> gr a b -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c -> c) -> c -> gr a b -> c
ufold Context a b -> gr a b -> gr a b
forall (gr :: * -> * -> *) a.
DynGraph gr =>
([(b, Node)], Node, a, [(b, Node)]) -> gr a b -> gr a b
cfilter gr a b
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') ([(b, Node)], Node, a, [(b, Node)]) -> 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 p' :: [(b, Node)]
p' = ((b, Node) -> Bool) -> [(b, Node)] -> [(b, Node)]
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' = ((b, Node) -> Bool) -> [(b, Node)] -> [(b, Node)]
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 :: (b -> Bool) -> gr a b -> gr a b
elfilter b -> Bool
f = (LEdge b -> Bool) -> gr a b -> gr a b
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 :: gr a b -> Bool
hasLoop = Bool -> Bool
not (Bool -> Bool) -> (gr a b -> Bool) -> gr a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Context a b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Context a b] -> Bool)
-> (gr a b -> [Context a b]) -> gr a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context a b -> Bool) -> gr a b -> [Context a b]
forall (gr :: * -> * -> *) a b.
Graph gr =>
(Context a b -> Bool) -> gr a b -> [Context a b]
gsel (\Context a b
c->Context a b -> Node
forall a b. Context a b -> Node
node' Context a b
c Node -> [Node] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Context a b -> [Node]
forall a b. Context a b -> [Node]
suc' Context a b
c)

-- | The inverse of 'hasLoop'.
isSimple :: (Graph gr) => gr a b -> Bool
isSimple :: gr a b -> Bool
isSimple = Bool -> Bool
not (Bool -> Bool) -> (gr a b -> Bool) -> gr a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> Bool
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 :: (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 = (Context a b -> r -> t)
-> Split (gr a b) (Context a b) r
-> SplitM (gr a b) Node (Context a b)
-> SplitM (gr a b) Node t
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 SplitM (gr a b) Node (Context a b)
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 :: (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 = (Context a b -> r -> t)
-> Split (gr a b) (Context a b) r -> SplitM (gr a b) Node t
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 ((Context a b -> [Node])
-> (Context a b -> r -> t)
-> Collect (Maybe t) r
-> [Node]
-> gr a b
-> (r, gr a b)
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 ([Node] -> gr a b -> (r, gr a b))
-> (Context a b -> [Node]) -> Split (gr a b) (Context a b) r
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 :: (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 = Collect (Maybe t) r
-> Split (gr a b) Node (Maybe t) -> [Node] -> gr a b -> (r, gr a b)
forall r c t i. Collect r c -> Split t i r -> [i] -> t -> (c, t)
threadList Collect (Maybe t) r
b ((Context a b -> [Node])
-> (Context a b -> r -> t)
-> Collect (Maybe t) r
-> Split (gr a b) Node (Maybe t)
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 :: (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 = (c, gr a b) -> c
forall a b. (a, b) -> a
fst ((Context a b -> [Node])
-> (Context a b -> c -> d)
-> (Maybe d -> c -> c, c)
-> [Node]
-> gr a b
-> (c, gr a b)
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 :: Tree a -> [a]
postorder (Node a
v Forest a
ts) = Forest a -> [a]
forall a. [Tree a] -> [a]
postorderF Forest a
ts [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
v]

-- | Flatten multiple 'Tree's in post-order.
postorderF :: [Tree a] -> [a]
postorderF :: [Tree a] -> [a]
postorderF = (Tree a -> [a]) -> [Tree a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree a -> [a]
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 :: Tree a -> [a]
preorder = Tree a -> [a]
forall a. Tree a -> [a]
flatten

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