-- (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,
    -- * Types used
    LRTree
) where

import           Data.Graph.Inductive.Graph
import qualified Data.Graph.Inductive.Internal.Heap     as H
import           Data.Graph.Inductive.Internal.RootPath


newEdges :: LPath b -> Context a b -> [H.Heap b (LPath b)]
newEdges :: forall b a. LPath b -> Context a b -> [Heap b (LPath b)]
newEdges (LP [LNode b]
p) (Adj b
_,Node
_,a
_,Adj b
s) = forall a b. (a -> b) -> [a] -> [b]
map (\(b
l,Node
v)->forall a b. a -> b -> Heap a b
H.unit b
l (forall a. [LNode a] -> LPath a
LP ((Node
v,b
l)forall a. a -> [a] -> [a]
:[LNode b]
p))) Adj b
s

prim :: (Graph gr,Real b) => H.Heap b (LPath b) -> gr a b -> LRTree b
prim :: forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Heap b (LPath b) -> gr a b -> LRTree b
prim Heap b (LPath b)
h gr a b
g | forall a b. Heap a b -> Bool
H.isEmpty Heap b (LPath b)
h Bool -> Bool -> Bool
|| forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = []
prim Heap b (LPath b)
h gr a b
g =
    case 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')  -> LPath b
pforall a. a -> [a] -> [a]
:forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Heap b (LPath b) -> gr a b -> LRTree b
prim (forall a b. Ord a => [Heap a b] -> Heap a b
H.mergeAll (Heap b (LPath b)
h'forall a. a -> [a] -> [a]
:forall b a. LPath b -> Context a b -> [Heap b (LPath b)]
newEdges LPath b
p Context a b
c)) gr a b
g'
         (MContext a b
Nothing,gr a b
g') -> forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Heap b (LPath b) -> gr a b -> LRTree b
prim Heap b (LPath b)
h' gr a b
g'
    where (b
_,p :: LPath b
p@(LP ((Node
v,b
_):[LNode b]
_)),Heap b (LPath b)
h') = forall a b. Ord a => Heap a b -> (a, b, Heap a b)
H.splitMin Heap b (LPath b)
h

msTreeAt :: (Graph gr,Real b) => Node -> gr a b -> LRTree b
msTreeAt :: forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Node -> gr a b -> LRTree b
msTreeAt Node
v = forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Heap b (LPath b) -> gr a b -> LRTree b
prim (forall a b. a -> b -> Heap a b
H.unit b
0 (forall a. [LNode a] -> LPath a
LP [(Node
v,b
0)]))

msTree :: (Graph gr,Real b) => gr a b -> LRTree b
msTree :: forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
gr a b -> LRTree b
msTree gr a b
g = forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Node -> gr a b -> LRTree b
msTreeAt Node
v gr a b
g where ((Adj b
_,Node
v,a
_,Adj b
_),gr a b
_) = forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> GDecomp gr a b
matchAny gr a b
g

msPath :: LRTree b -> Node -> Node -> Path
msPath :: forall b. LRTree b -> Node -> Node -> Path
msPath LRTree b
t Node
a Node
b = Path -> Path -> Path
joinPaths (forall a. Node -> LRTree a -> Path
getLPathNodes Node
a LRTree b
t) (forall a. Node -> LRTree a -> Path
getLPathNodes Node
b LRTree b
t)

joinPaths :: Path -> Path -> Path
joinPaths :: Path -> Path -> Path
joinPaths Path
p = Node -> Path -> Path -> Path
joinAt (forall a. [a] -> a
head Path
p) Path
p

joinAt :: Node -> Path -> Path -> Path
joinAt :: Node -> Path -> Path -> Path
joinAt Node
_ (Node
v:Path
vs) (Node
w:Path
ws) | Node
vforall a. Eq a => a -> a -> Bool
==Node
w = Node -> Path -> Path -> Path
joinAt Node
v Path
vs Path
ws
joinAt Node
x Path
p      Path
q             = forall a. [a] -> [a]
reverse Path
pforall a. [a] -> [a] -> [a]
++(Node
xforall a. a -> [a] -> [a]
:Path
q)