content: -- (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 f q g | queueEmpty q || isEmpty g = []
                     | otherwise                 =
         case match v g of
          (Just c, g')  -> f c:bfsnInternal f (queuePutList (suc' c) q') g'
          (Nothing, g') -> bfsnInternal f q' g'
          where (v,q') = queueGet q
  
  bfsnWith :: (Graph gr) => (Context a b -> c) -> [Node] -> gr a b -> [c]
  bfsnWith f vs = bfsnInternal f (queuePutList vs mkQueue)
  
  bfsn :: (Graph gr) => [Node] -> gr a b -> [Node]
  bfsn = bfsnWith node'
  
  bfsWith :: (Graph gr) => (Context a b -> c) -> Node -> gr a b -> [c]
  bfsWith f v = bfsnInternal f (queuePut v mkQueue)
  
  bfs :: (Graph gr) => Node -> gr a b -> [Node]
  bfs = bfsWith node'
  
  
  -- level (extension of bfs giving the depth of each node)
  --
  level :: (Graph gr) => Node -> gr a b -> [(Node,Int)]
  level v = leveln [(v,0)]
  
  suci :: Context a b -> Int -> [(Node, Int)]
  suci c i = zip (suc' c) (repeat i)
  
  leveln :: (Graph gr) => [(Node,Int)] -> gr a b -> [(Node,Int)]
  leveln []         _             = []
  leveln _          g | isEmpty g = []
  leveln ((v,j):vs) g = case match v g of
                          (Just c,g')  -> (v,j):leveln (vs++suci c (j+1)) g'
                          (Nothing,g') -> leveln vs g'
  
  
  -- bfe (breadth first edges)
  -- remembers predecessor information
  --
  bfenInternal :: (Graph gr) => Queue Edge -> gr a b -> [Edge]
  bfenInternal q g | queueEmpty q || isEmpty g = []
                   | otherwise                 =
        case match v g of
          (Just c, g')  -> (u,v):bfenInternal (queuePutList (outU c) q') g'
          (Nothing, g') -> bfenInternal q' g'
          where ((u,v),q') = queueGet q
  
  bfen :: (Graph gr) => [Edge] -> gr a b -> [Edge]
  bfen vs = bfenInternal (queuePutList vs mkQueue)
  
  bfe :: (Graph gr) => Node -> gr a b -> [Edge]
  bfe v = bfen [(v,v)]
  
  outU :: Context a b -> [Edge]
  outU c = map toEdge (out' 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 v = bf (queuePut [v] mkQueue)
  
  bf :: (Graph gr) => Queue Path -> gr a b -> RTree
  bf q g | queueEmpty q || isEmpty g = []
         | otherwise                 =
         case match v g of
           (Just c, g')  -> p:bf (queuePutList (map (:p) (suc' c)) q') g'
           (Nothing, g') -> bf q' g'
           where (p@(v:_),q') = queueGet q
  
  esp :: (Graph gr) => Node -> Node -> gr a b -> Path
  esp s t = getPath t . bft 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 v g = case out g v of
               []         -> [LP []]
               (v',_,l):_ -> lbf (queuePut (LP [(v',l)]) mkQueue) g
  
  lbf :: (Graph gr) => Queue (LPath b) -> gr a b -> LRTree b
  lbf q g | queueEmpty q || isEmpty g = []
          | otherwise                 =
         case match v g of
           (Just c, g') ->
               LP p:lbf (queuePutList (map (\v' -> LP (v':p)) (lsuc' c)) q') g'
           (Nothing, g') -> lbf q' g'
           where (LP (p@((v,_):_)),q') = queueGet q
  
  lesp :: (Graph gr) => Node -> Node -> gr a b -> LPath b
  lesp s t = getLPath t . lbft s
  