1-- (c) 2000-2005 by Martin Erwig [see file COPYRIGHT]
2-- | Minimum-Spanning-Tree Algorithms
3
4module Data.Graph.Inductive.Query.MST (
5    msTreeAt,msTree,
6    -- * Path in MST
7    msPath,
8    -- * Types used
9    LRTree
10) where
11
12import           Data.Graph.Inductive.Graph
13import qualified Data.Graph.Inductive.Internal.Heap     as H
14import           Data.Graph.Inductive.Internal.RootPath
15
16
17newEdges :: LPath b -> Context a b -> [H.Heap b (LPath b)]
18newEdges (LP p) (_,_,_,s) = map (\(l,v)->H.unit l (LP ((v,l):p))) s
19
20prim :: (Graph gr,Real b) => H.Heap b (LPath b) -> gr a b -> LRTree b
21prim h g | H.isEmpty h || isEmpty g = []
22prim h g =
23    case match v g of
24         (Just c,g')  -> p:prim (H.mergeAll (h':newEdges p c)) g'
25         (Nothing,g') -> prim h' g'
26    where (_,p@(LP ((v,_):_)),h') = H.splitMin h
27
28msTreeAt :: (Graph gr,Real b) => Node -> gr a b -> LRTree b
29msTreeAt v = prim (H.unit 0 (LP [(v,0)]))
30
31msTree :: (Graph gr,Real b) => gr a b -> LRTree b
32msTree g = msTreeAt v g where ((_,v,_,_),_) = matchAny g
33
34msPath :: LRTree b -> Node -> Node -> Path
35msPath t a b = joinPaths (getLPathNodes a t) (getLPathNodes b t)
36
37joinPaths :: Path -> Path -> Path
38joinPaths p = joinAt (head p) p
39
40joinAt :: Node -> Path -> Path -> Path
41joinAt _ (v:vs) (w:ws) | v==w = joinAt v vs ws
42joinAt x p      q             = reverse p++(x:q)
43