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