module Data.Graph.Inductive.Query.MST (
msTreeAt,msTree,
msPath,
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 :: LPath b -> Context a b -> [Heap b (LPath b)]
newEdges (LP p :: [LNode b]
p) (_,_,_,s :: Adj b
s) = ((b, Node) -> Heap b (LPath b)) -> Adj b -> [Heap b (LPath b)]
forall a b. (a -> b) -> [a] -> [b]
map (\(l :: b
l,v :: Node
v)->b -> LPath b -> Heap b (LPath b)
forall a b. a -> b -> Heap a b
H.unit b
l ([LNode b] -> LPath b
forall a. [LNode a] -> LPath a
LP ((Node
v,b
l)LNode b -> [LNode b] -> [LNode b]
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 :: Heap b (LPath b) -> gr a b -> LRTree b
prim h :: Heap b (LPath b)
h g :: gr a b
g | Heap b (LPath b) -> Bool
forall a b. Heap a b -> Bool
H.isEmpty Heap b (LPath b)
h Bool -> Bool -> Bool
|| gr a b -> Bool
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = []
prim h :: Heap b (LPath b)
h g :: gr a b
g =
case Node -> gr a b -> Decomp gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> Decomp gr a b
match Node
v gr a b
g of
(Just c :: Context a b
c,g' :: gr a b
g') -> LPath b
pLPath b -> LRTree b -> LRTree b
forall a. a -> [a] -> [a]
:Heap b (LPath b) -> gr a b -> LRTree b
forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Heap b (LPath b) -> gr a b -> LRTree b
prim ([Heap b (LPath b)] -> Heap b (LPath b)
forall a b. Ord a => [Heap a b] -> Heap a b
H.mergeAll (Heap b (LPath b)
h'Heap b (LPath b) -> [Heap b (LPath b)] -> [Heap b (LPath b)]
forall a. a -> [a] -> [a]
:LPath b -> Context a b -> [Heap b (LPath b)]
forall b a. LPath b -> Context a b -> [Heap b (LPath b)]
newEdges LPath b
p Context a b
c)) gr a b
g'
(Nothing,g' :: gr a b
g') -> Heap b (LPath b) -> gr a b -> LRTree b
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 (_,p :: LPath b
p@(LP ((v :: Node
v,_):_)),h' :: Heap b (LPath b)
h') = Heap b (LPath b) -> (b, LPath b, Heap b (LPath b))
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 :: Node -> gr a b -> LRTree b
msTreeAt v :: Node
v = Heap b (LPath b) -> gr a b -> LRTree b
forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Heap b (LPath b) -> gr a b -> LRTree b
prim (b -> LPath b -> Heap b (LPath b)
forall a b. a -> b -> Heap a b
H.unit 0 ([LNode b] -> LPath b
forall a. [LNode a] -> LPath a
LP [(Node
v,0)]))
msTree :: (Graph gr,Real b) => gr a b -> LRTree b
msTree :: gr a b -> LRTree b
msTree g :: gr a b
g = Node -> gr a b -> LRTree b
forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Node -> gr a b -> LRTree b
msTreeAt Node
v gr a b
g where ((_,v :: Node
v,_,_),_) = gr a b -> ((Adj b, Node, 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 :: LRTree b -> Node -> Node -> Path
msPath t :: LRTree b
t a :: Node
a b :: Node
b = Path -> Path -> Path
joinPaths (Node -> LRTree b -> Path
forall a. Node -> LRTree a -> Path
getLPathNodes Node
a LRTree b
t) (Node -> LRTree b -> Path
forall a. Node -> LRTree a -> Path
getLPathNodes Node
b LRTree b
t)
joinPaths :: Path -> Path -> Path
joinPaths :: Path -> Path -> Path
joinPaths p :: Path
p = Node -> Path -> Path -> Path
joinAt (Path -> Node
forall a. [a] -> a
head Path
p) Path
p
joinAt :: Node -> Path -> Path -> Path
joinAt :: Node -> Path -> Path -> Path
joinAt _ (v :: Node
v:vs :: Path
vs) (w :: Node
w:ws :: Path
ws) | Node
vNode -> Node -> Bool
forall a. Eq a => a -> a -> Bool
==Node
w = Node -> Path -> Path -> Path
joinAt Node
v Path
vs Path
ws
joinAt x :: Node
x p :: Path
p q :: Path
q = Path -> Path
forall a. [a] -> [a]
reverse Path
pPath -> Path -> Path
forall a. [a] -> [a] -> [a]
++(Node
xNode -> Path -> Path
forall a. a -> [a] -> [a]
:Path
q)