-- (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 :: (Context a b -> c) -> Queue Node -> gr a b -> [c]
bfsnInternal Context a b -> c
f Queue Node
q gr a b
g | Queue Node -> Bool
forall a. Queue a -> Bool
queueEmpty Queue Node
q Bool -> Bool -> Bool
|| gr a b -> Bool
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = []
                   | Bool
otherwise                 =
       case Node -> gr a b -> Decomp gr a b
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
cc -> [c] -> [c]
forall a. a -> [a] -> [a]
:(Context a b -> c) -> Queue Node -> gr a b -> [c]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c) -> Queue Node -> gr a b -> [c]
bfsnInternal Context a b -> c
f ([Node] -> Queue Node -> Queue Node
forall a. [a] -> Queue a -> Queue a
queuePutList (Context a b -> [Node]
forall a b. Context a b -> [Node]
suc' Context a b
c) Queue Node
q') gr a b
g'
        (Maybe (Context a b)
Nothing, gr a b
g') -> (Context a b -> c) -> Queue Node -> gr a b -> [c]
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') = Queue Node -> (Node, Queue Node)
forall a. Queue a -> (a, Queue a)
queueGet Queue Node
q

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

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

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

bfs :: (Graph gr) => Node -> gr a b -> [Node]
bfs :: Node -> gr a b -> [Node]
bfs = (Context a b -> Node) -> Node -> gr a b -> [Node]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c) -> Node -> gr a b -> [c]
bfsWith Context a b -> Node
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 :: Node -> gr a b -> [(Node, Node)]
level Node
v = [(Node, Node)] -> gr a b -> [(Node, Node)]
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 :: Context a b -> Node -> [(Node, Node)]
suci Context a b
c Node
i = [Node] -> [Node] -> [(Node, Node)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Context a b -> [Node]
forall a b. Context a b -> [Node]
suc' Context a b
c) (Node -> [Node]
forall a. a -> [a]
repeat Node
i)

leveln :: (Graph gr) => [(Node,Int)] -> gr a b -> [(Node,Int)]
leveln :: [(Node, Node)] -> gr a b -> [(Node, Node)]
leveln []         gr a b
_             = []
leveln [(Node, Node)]
_          gr a b
g | gr a b -> Bool
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 Node -> gr a b -> Decomp gr a b
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)(Node, Node) -> [(Node, Node)] -> [(Node, Node)]
forall a. a -> [a] -> [a]
:[(Node, Node)] -> gr a b -> [(Node, Node)]
forall (gr :: * -> * -> *) a b.
Graph gr =>
[(Node, Node)] -> gr a b -> [(Node, Node)]
leveln ([(Node, Node)]
vs[(Node, Node)] -> [(Node, Node)] -> [(Node, Node)]
forall a. [a] -> [a] -> [a]
++Context a b -> Node -> [(Node, Node)]
forall a b. Context a b -> Node -> [(Node, Node)]
suci Context a b
c (Node
jNode -> Node -> Node
forall a. Num a => a -> a -> a
+Node
1)) gr a b
g'
                        (Maybe (Context a b)
Nothing,gr a b
g') -> [(Node, Node)] -> gr a b -> [(Node, Node)]
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 :: Queue (Node, Node) -> gr a b -> [(Node, Node)]
bfenInternal Queue (Node, Node)
q gr a b
g | Queue (Node, Node) -> Bool
forall a. Queue a -> Bool
queueEmpty Queue (Node, Node)
q Bool -> Bool -> Bool
|| gr a b -> Bool
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = []
                 | Bool
otherwise                 =
      case Node -> gr a b -> Decomp gr a b
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)(Node, Node) -> [(Node, Node)] -> [(Node, Node)]
forall a. a -> [a] -> [a]
:Queue (Node, Node) -> gr a b -> [(Node, Node)]
forall (gr :: * -> * -> *) a b.
Graph gr =>
Queue (Node, Node) -> gr a b -> [(Node, Node)]
bfenInternal ([(Node, Node)] -> Queue (Node, Node) -> Queue (Node, Node)
forall a. [a] -> Queue a -> Queue a
queuePutList (Context a b -> [(Node, Node)]
forall a b. Context a b -> [(Node, Node)]
outU Context a b
c) Queue (Node, Node)
q') gr a b
g'
        (Maybe (Context a b)
Nothing, gr a b
g') -> Queue (Node, Node) -> gr a b -> [(Node, Node)]
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') = Queue (Node, Node) -> ((Node, Node), Queue (Node, Node))
forall a. Queue a -> (a, Queue a)
queueGet Queue (Node, Node)
q

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

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

outU :: Context a b -> [Edge]
outU :: Context a b -> [(Node, Node)]
outU Context a b
c = (LEdge b -> (Node, Node)) -> [LEdge b] -> [(Node, Node)]
forall a b. (a -> b) -> [a] -> [b]
map LEdge b -> (Node, Node)
forall b. LEdge b -> (Node, Node)
toEdge (Context a b -> [LEdge b]
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 :: Node -> gr a b -> RTree
bft Node
v = Queue [Node] -> gr a b -> RTree
forall (gr :: * -> * -> *) a b.
Graph gr =>
Queue [Node] -> gr a b -> RTree
bf ([Node] -> Queue [Node] -> Queue [Node]
forall a. a -> Queue a -> Queue a
queuePut [Node
v] Queue [Node]
forall a. Queue a
mkQueue)

bf :: (Graph gr) => Queue Path -> gr a b -> RTree
bf :: Queue [Node] -> gr a b -> RTree
bf Queue [Node]
q gr a b
g | Queue [Node] -> Bool
forall a. Queue a -> Bool
queueEmpty Queue [Node]
q Bool -> Bool -> Bool
|| gr a b -> Bool
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = []
       | Bool
otherwise                 =
       case Node -> gr a b -> Decomp gr a b
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]
p[Node] -> RTree -> RTree
forall a. a -> [a] -> [a]
:Queue [Node] -> gr a b -> RTree
forall (gr :: * -> * -> *) a b.
Graph gr =>
Queue [Node] -> gr a b -> RTree
bf (RTree -> Queue [Node] -> Queue [Node]
forall a. [a] -> Queue a -> Queue a
queuePutList ((Node -> [Node]) -> [Node] -> RTree
forall a b. (a -> b) -> [a] -> [b]
map (Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:[Node]
p) (Context a b -> [Node]
forall a b. Context a b -> [Node]
suc' Context a b
c)) Queue [Node]
q') gr a b
g'
         (Maybe (Context a b)
Nothing, gr a b
g') -> Queue [Node] -> gr a b -> RTree
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') = Queue [Node] -> ([Node], Queue [Node])
forall a. Queue a -> (a, Queue a)
queueGet Queue [Node]
q

esp :: (Graph gr) => Node -> Node -> gr a b -> Path
esp :: Node -> Node -> gr a b -> [Node]
esp Node
s Node
t = Node -> RTree -> [Node]
getPath Node
t (RTree -> [Node]) -> (gr a b -> RTree) -> gr a b -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> gr a b -> RTree
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 :: Node -> gr a b -> LRTree b
lbft Node
v gr a b
g = case gr a b -> Node -> [LEdge b]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> [LEdge b]
out gr a b
g Node
v of
             []         -> [[LNode b] -> LPath b
forall a. [LNode a] -> LPath a
LP []]
             (Node
v',Node
_,b
l):[LEdge b]
_ -> Queue (LPath b) -> gr a b -> LRTree b
forall (gr :: * -> * -> *) b a.
Graph gr =>
Queue (LPath b) -> gr a b -> LRTree b
lbf (LPath b -> Queue (LPath b) -> Queue (LPath b)
forall a. a -> Queue a -> Queue a
queuePut ([LNode b] -> LPath b
forall a. [LNode a] -> LPath a
LP [(Node
v',b
l)]) Queue (LPath b)
forall a. Queue a
mkQueue) gr a b
g

lbf :: (Graph gr) => Queue (LPath b) -> gr a b -> LRTree b
lbf :: Queue (LPath b) -> gr a b -> LRTree b
lbf Queue (LPath b)
q gr a b
g | Queue (LPath b) -> Bool
forall a. Queue a -> Bool
queueEmpty Queue (LPath b)
q Bool -> Bool -> Bool
|| gr a b -> Bool
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = []
        | Bool
otherwise                 =
       case Node -> gr a b -> Decomp gr a b
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') ->
             [LNode b] -> LPath b
forall a. [LNode a] -> LPath a
LP [LNode b]
pLPath b -> LRTree b -> LRTree b
forall a. a -> [a] -> [a]
:Queue (LPath b) -> gr a b -> LRTree b
forall (gr :: * -> * -> *) b a.
Graph gr =>
Queue (LPath b) -> gr a b -> LRTree b
lbf (LRTree b -> Queue (LPath b) -> Queue (LPath b)
forall a. [a] -> Queue a -> Queue a
queuePutList ((LNode b -> LPath b) -> [LNode b] -> LRTree b
forall a b. (a -> b) -> [a] -> [b]
map (\LNode b
v' -> [LNode b] -> LPath b
forall a. [LNode a] -> LPath a
LP (LNode b
v'LNode b -> [LNode b] -> [LNode b]
forall a. a -> [a] -> [a]
:[LNode b]
p)) (Context a b -> [LNode b]
forall a b. Context a b -> [(Node, b)]
lsuc' Context a b
c)) Queue (LPath b)
q') gr a b
g'
         (Maybe (Context a b)
Nothing, gr a b
g') -> Queue (LPath b) -> gr a b -> LRTree b
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') = Queue (LPath b) -> (LPath b, Queue (LPath b))
forall a. Queue a -> (a, Queue a)
queueGet Queue (LPath b)
q

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