Types/Data/Graph/Dijkstra.hs

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