-- (c) 2000-2005 by Martin Erwig [see file COPYRIGHT]
-- | Breadth-First Search Algorithms

module Data.Graph.Inductive.Query.BFS(

    -- * BFS Node List
    bfs, bfsn, bfsWith, bfsnWith,

    -- * Node List With Depth Info
    level, leveln,

    -- * BFS Edges
    bfe, bfen,

    -- * BFS Tree
    bft, lbft, RTree,

    -- * Shortest Path (Number of Edges)
    esp, lesp

) where


import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.Internal.Queue
import Data.Graph.Inductive.Internal.RootPath

-- bfs (node list ordered by distance)
--
bfsnInternal :: (Graph gr) => (Context a b -> c) -> Queue Node -> gr a b -> [c]
bfsnInternal :: forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c) -> Queue Node -> gr a b -> [c]
bfsnInternal Context a b -> c
f Queue Node
q gr a b
g | forall a. Queue a -> Bool
queueEmpty Queue Node
q Bool -> Bool -> Bool
|| forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = []
                   | Bool
otherwise                 =
       case forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> Decomp gr a b
match Node
v gr a b
g of
        (Just Context a b
c, gr a b
g')  -> Context a b -> c
f Context a b
cforall a. a -> [a] -> [a]
:forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c) -> Queue Node -> gr a b -> [c]
bfsnInternal Context a b -> c
f (forall a. [a] -> Queue a -> Queue a
queuePutList (forall a b. Context a b -> [Node]
suc' Context a b
c) Queue Node
q') gr a b
g'
        (MContext a b
Nothing, gr a b
g') -> forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c) -> Queue Node -> gr a b -> [c]
bfsnInternal Context a b -> c
f Queue Node
q' gr a b
g'
        where (Node
v,Queue Node
q') = forall a. Queue a -> (a, Queue a)
queueGet Queue Node
q

bfsnWith :: (Graph gr) => (Context a b -> c) -> [Node] -> gr a b -> [c]
bfsnWith :: forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c) -> [Node] -> gr a b -> [c]
bfsnWith Context a b -> c
f [Node]
vs = forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c) -> Queue Node -> gr a b -> [c]
bfsnInternal Context a b -> c
f (forall a. [a] -> Queue a -> Queue a
queuePutList [Node]
vs forall a. Queue a
mkQueue)

bfsn :: (Graph gr) => [Node] -> gr a b -> [Node]
bfsn :: forall (gr :: * -> * -> *) a b.
Graph gr =>
[Node] -> gr a b -> [Node]
bfsn = forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c) -> [Node] -> gr a b -> [c]
bfsnWith forall a b. Context a b -> Node
node'

bfsWith :: (Graph gr) => (Context a b -> c) -> Node -> gr a b -> [c]
bfsWith :: forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c) -> Node -> gr a b -> [c]
bfsWith Context a b -> c
f Node
v = forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c) -> Queue Node -> gr a b -> [c]
bfsnInternal Context a b -> c
f (forall a. a -> Queue a -> Queue a
queuePut Node
v forall a. Queue a
mkQueue)

bfs :: (Graph gr) => Node -> gr a b -> [Node]
bfs :: forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> [Node]
bfs = forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c) -> Node -> gr a b -> [c]
bfsWith forall a b. Context a b -> Node
node'


-- level (extension of bfs giving the depth of each node)
--
level :: (Graph gr) => Node -> gr a b -> [(Node,Int)]
level :: forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> [(Node, Node)]
level Node
v = forall (gr :: * -> * -> *) a b.
Graph gr =>
[(Node, Node)] -> gr a b -> [(Node, Node)]
leveln [(Node
v,Node
0)]

suci :: Context a b -> Int -> [(Node, Int)]
suci :: forall a b. Context a b -> Node -> [(Node, Node)]
suci Context a b
c Node
i = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. Context a b -> [Node]
suc' Context a b
c) (forall a. a -> [a]
repeat Node
i)

leveln :: (Graph gr) => [(Node,Int)] -> gr a b -> [(Node,Int)]
leveln :: forall (gr :: * -> * -> *) a b.
Graph gr =>
[(Node, Node)] -> gr a b -> [(Node, Node)]
leveln []         gr a b
_             = []
leveln [(Node, Node)]
_          gr a b
g | forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = []
leveln ((Node
v,Node
j):[(Node, Node)]
vs) gr a b
g = case forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> Decomp gr a b
match Node
v gr a b
g of
                        (Just Context a b
c,gr a b
g')  -> (Node
v,Node
j)forall a. a -> [a] -> [a]
:forall (gr :: * -> * -> *) a b.
Graph gr =>
[(Node, Node)] -> gr a b -> [(Node, Node)]
leveln ([(Node, Node)]
vsforall a. [a] -> [a] -> [a]
++forall a b. Context a b -> Node -> [(Node, Node)]
suci Context a b
c (Node
jforall a. Num a => a -> a -> a
+Node
1)) gr a b
g'
                        (MContext a b
Nothing,gr a b
g') -> forall (gr :: * -> * -> *) a b.
Graph gr =>
[(Node, Node)] -> gr a b -> [(Node, Node)]
leveln [(Node, Node)]
vs gr a b
g'


-- bfe (breadth first edges)
-- remembers predecessor information
--
bfenInternal :: (Graph gr) => Queue Edge -> gr a b -> [Edge]
bfenInternal :: forall (gr :: * -> * -> *) a b.
Graph gr =>
Queue (Node, Node) -> gr a b -> [(Node, Node)]
bfenInternal Queue (Node, Node)
q gr a b
g | forall a. Queue a -> Bool
queueEmpty Queue (Node, Node)
q Bool -> Bool -> Bool
|| forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = []
                 | Bool
otherwise                 =
      case forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> Decomp gr a b
match Node
v gr a b
g of
        (Just Context a b
c, gr a b
g')  -> (Node
u,Node
v)forall a. a -> [a] -> [a]
:forall (gr :: * -> * -> *) a b.
Graph gr =>
Queue (Node, Node) -> gr a b -> [(Node, Node)]
bfenInternal (forall a. [a] -> Queue a -> Queue a
queuePutList (forall a b. Context a b -> [(Node, Node)]
outU Context a b
c) Queue (Node, Node)
q') gr a b
g'
        (MContext a b
Nothing, gr a b
g') -> forall (gr :: * -> * -> *) a b.
Graph gr =>
Queue (Node, Node) -> gr a b -> [(Node, Node)]
bfenInternal Queue (Node, Node)
q' gr a b
g'
        where ((Node
u,Node
v),Queue (Node, Node)
q') = forall a. Queue a -> (a, Queue a)
queueGet Queue (Node, Node)
q

bfen :: (Graph gr) => [Edge] -> gr a b -> [Edge]
bfen :: forall (gr :: * -> * -> *) a b.
Graph gr =>
[(Node, Node)] -> gr a b -> [(Node, Node)]
bfen [(Node, Node)]
vs = forall (gr :: * -> * -> *) a b.
Graph gr =>
Queue (Node, Node) -> gr a b -> [(Node, Node)]
bfenInternal (forall a. [a] -> Queue a -> Queue a
queuePutList [(Node, Node)]
vs forall a. Queue a
mkQueue)

bfe :: (Graph gr) => Node -> gr a b -> [Edge]
bfe :: forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> [(Node, Node)]
bfe Node
v = forall (gr :: * -> * -> *) a b.
Graph gr =>
[(Node, Node)] -> gr a b -> [(Node, Node)]
bfen [(Node
v,Node
v)]

outU :: Context a b -> [Edge]
outU :: forall a b. Context a b -> [(Node, Node)]
outU Context a b
c = forall a b. (a -> b) -> [a] -> [b]
map forall b. LEdge b -> (Node, Node)
toEdge (forall a b. Context a b -> [LEdge b]
out' Context a b
c)


-- bft (breadth first search tree)
-- here: with inward directed trees
--
-- bft :: Node -> gr a b -> IT.InTree Node
-- bft v g = IT.build $ map swap $ bfe v g
--           where swap (x,y) = (y,x)
--
-- sp (shortest path wrt to number of edges)
--
-- sp :: Node -> Node -> gr a b -> [Node]
-- sp s t g = reverse $ IT.rootPath (bft s g) t


-- faster shortest paths
-- here: with root path trees
--
bft :: (Graph gr) => Node -> gr a b -> RTree
bft :: forall (gr :: * -> * -> *) a b. Graph gr => Node -> gr a b -> RTree
bft Node
v = forall (gr :: * -> * -> *) a b.
Graph gr =>
Queue [Node] -> gr a b -> RTree
bf (forall a. a -> Queue a -> Queue a
queuePut [Node
v] forall a. Queue a
mkQueue)

bf :: (Graph gr) => Queue Path -> gr a b -> RTree
bf :: forall (gr :: * -> * -> *) a b.
Graph gr =>
Queue [Node] -> gr a b -> RTree
bf Queue [Node]
q gr a b
g | forall a. Queue a -> Bool
queueEmpty Queue [Node]
q Bool -> Bool -> Bool
|| forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = []
       | Bool
otherwise                 =
       case forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> Decomp gr a b
match Node
v gr a b
g of
         (Just Context a b
c, gr a b
g')  -> [Node]
pforall a. a -> [a] -> [a]
:forall (gr :: * -> * -> *) a b.
Graph gr =>
Queue [Node] -> gr a b -> RTree
bf (forall a. [a] -> Queue a -> Queue a
queuePutList (forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
:[Node]
p) (forall a b. Context a b -> [Node]
suc' Context a b
c)) Queue [Node]
q') gr a b
g'
         (MContext a b
Nothing, gr a b
g') -> forall (gr :: * -> * -> *) a b.
Graph gr =>
Queue [Node] -> gr a b -> RTree
bf Queue [Node]
q' gr a b
g'
         where (p :: [Node]
p@(Node
v:[Node]
_),Queue [Node]
q') = forall a. Queue a -> (a, Queue a)
queueGet Queue [Node]
q

esp :: (Graph gr) => Node -> Node -> gr a b -> Path
esp :: forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> Node -> gr a b -> [Node]
esp Node
s Node
t = Node -> RTree -> [Node]
getPath Node
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b. Graph gr => Node -> gr a b -> RTree
bft Node
s


-- lesp is a version of esp that returns labeled paths
-- Note that the label of the first node in a returned path is meaningless;
-- all other nodes are paired with the label of their incoming edge.
--
lbft :: (Graph gr) => Node -> gr a b -> LRTree b
lbft :: forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> LRTree b
lbft Node
v gr a b
g = case forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> [LEdge b]
out gr a b
g Node
v of
             []         -> [forall a. [LNode a] -> LPath a
LP []]
             (Node
v',Node
_,b
l):[LEdge b]
_ -> forall (gr :: * -> * -> *) b a.
Graph gr =>
Queue (LPath b) -> gr a b -> LRTree b
lbf (forall a. a -> Queue a -> Queue a
queuePut (forall a. [LNode a] -> LPath a
LP [(Node
v',b
l)]) forall a. Queue a
mkQueue) gr a b
g

lbf :: (Graph gr) => Queue (LPath b) -> gr a b -> LRTree b
lbf :: forall (gr :: * -> * -> *) b a.
Graph gr =>
Queue (LPath b) -> gr a b -> LRTree b
lbf Queue (LPath b)
q gr a b
g | forall a. Queue a -> Bool
queueEmpty Queue (LPath b)
q Bool -> Bool -> Bool
|| forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = []
        | Bool
otherwise                 =
       case forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> Decomp gr a b
match Node
v gr a b
g of
         (Just Context a b
c, gr a b
g') ->
             forall a. [LNode a] -> LPath a
LP [LNode b]
pforall a. a -> [a] -> [a]
:forall (gr :: * -> * -> *) b a.
Graph gr =>
Queue (LPath b) -> gr a b -> LRTree b
lbf (forall a. [a] -> Queue a -> Queue a
queuePutList (forall a b. (a -> b) -> [a] -> [b]
map (\LNode b
v' -> forall a. [LNode a] -> LPath a
LP (LNode b
v'forall a. a -> [a] -> [a]
:[LNode b]
p)) (forall a b. Context a b -> [(Node, b)]
lsuc' Context a b
c)) Queue (LPath b)
q') gr a b
g'
         (MContext a b
Nothing, gr a b
g') -> forall (gr :: * -> * -> *) b a.
Graph gr =>
Queue (LPath b) -> gr a b -> LRTree b
lbf Queue (LPath b)
q' gr a b
g'
         where (LP (p :: [LNode b]
p@((Node
v,b
_):[LNode b]
_)),Queue (LPath b)
q') = forall a. Queue a -> (a, Queue a)
queueGet Queue (LPath b)
q

lesp :: (Graph gr) => Node -> Node -> gr a b -> LPath b
lesp :: forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> Node -> gr a b -> LPath b
lesp Node
s Node
t = forall a. Node -> LRTree a -> LPath a
getLPath Node
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> LRTree b
lbft Node
s