]> gitweb @ CieloNegro.org - hs-rrdtool.git/blob - Types/Data/Graph/Dijkstra.hs
9a70ee92a7b021b3d8918b64c5fd47690a9e3352
[hs-rrdtool.git] / Types / Data / Graph / Dijkstra.hs
1 {-# LANGUAGE
2   EmptyDataDecls,
3   TypeFamilies,
4   UndecidableInstances
5   #-}
6 module Types.Data.Graph.Dijkstra
7     ( Dijkstra
8     , SpTree
9     , SpLength
10     , Sp
11     )
12     where
13
14 import qualified Types.Data.Heap     as H
15 import qualified Types.Data.List     as L
16 import qualified Types.Data.List.Ops as L
17 import qualified Types.Data.Map      as M
18
19 import Types.Data.Bool
20 import Types.Data.Graph
21 import Types.Data.Graph.RootPath
22 import Types.Data.Maybe
23 import Types.Data.Num
24
25 -- Expand
26 type family   Expand distance lPath context
27 type instance Expand d (LPath p) (Context ps n l ss)
28     = L.Map (Expand' d p) (M.Assocs ss)
29
30 data Expand' distance path
31 type instance L.App (Expand' d p) (L.Cons n d')
32     = H.Unit (d :+: d')
33              (LPath (L.Cons (LNode n (d :+: d')) p))
34
35 -- Dijkstra
36 type Dijkstra h g
37     = If (H.IsEmpty h :||: IsEmpty g)
38          L.Null
39          (Dijkstra' h g (H.SplitMin h))
40
41 type family   Dijkstra' heap graph min
42 type instance Dijkstra' h g (L.Cons d (L.Cons (LPath (L.Cons (LNode n d') ps)) h'))
43     = Dijkstra'' n d' (LPath (L.Cons (LNode n d) ps)) h' (Match n g)
44
45 type family   Dijkstra'' node distance lPath heap' decomp
46 type instance Dijkstra'' n d p h' (Decomp Nothing  g') = Dijkstra h' g'
47 type instance Dijkstra'' n d p h' (Decomp (Just c) g')
48     = L.Cons p (Dijkstra (H.MergeAll (L.Cons h' (Expand d p c))) g')
49
50 -- SpTree
51 type SpTree node graph
52     = Dijkstra (H.Unit D0 (LPath (L.Cons (LNode node D0) L.Null))) graph
53
54 -- SpLength
55 type SpLength node1 node2 graph
56     = GetDistance node2 (SpTree node1 graph)
57
58 -- Sp
59 type Sp node1 node2 graph
60     = GetLPathNodes node2 (SpTree node1 graph)