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