+++ /dev/null
-{-# LANGUAGE
- EmptyDataDecls,
- TypeFamilies
- #-}
-module Data.HList.Graph
- ( Context
- , Graph
-
- , Empty
- , IsEmpty
--- , Match
- )
- where
-
-import Data.HList.Prelude
-import Types.Data.Bool
-
--- Graph is a map from node ID to context
-data Context preNodes node sucNodes
-data Graph nodeMap
-
--- Empty
-type Empty = Graph Nil
-
--- IsEmpty
-type family IsEmpty g
-type instance IsEmpty (Graph Nil) = True
-type instance IsEmpty (Graph (Cons x xs)) = False
-
--- Match
---type Match n g
--- =
-
-{-
--- NodeSet
-class NodeSet ns
-instance NodeSet Nil
-instance NodeSet ns => NodeSet (Cons n ns)
-
--- NodeIDSet
-class NoDuplicates ids => NodeIDSet ids
-instance NodeIDSet Nil
-instance (OccursNot id ids, NodeIDSet ids) => NodeIDSet (Cons id ids)
-
--- LPath (list of labeled node IDs)
-class LPath p
-instance LPath Nil
-instance LPath p => LPath (Cons (Cons l id) p)
-
--- Node
-class NodeIDSet (LinksFrom n) => Node n
- where
- type NodeID n
- type LinksFrom n
-
--- NodeIDA
-data NodeIDA
-instance ApplyT NodeIDA n where
- type Apply NodeIDA n = NodeID n
-
--- Graph
-class ( NodeSet (Nodes g)
- , NoDuplicates (Map NodeIDA g)
- )
- => Graph g
- where
- type Empty g
- type Nodes g
-
--- IsEmpty
-type family IsEmpty g
--}
\ No newline at end of file
--- /dev/null
+{-# LANGUAGE
+ EmptyDataDecls,
+ TypeFamilies,
+ UndecidableInstances
+ #-}
+module Types.Data.Graph
+ ( Context
+ , Decomp
+ , LNode
+ , LPath
+ , Graph
+
+ , Empty
+ , IsEmpty
+
+ , Match
+ )
+ where
+
+import qualified Types.Data.List as L
+import qualified Types.Data.List.Ops as L
+import qualified Types.Data.Map as M
+
+import Types.Data.Bool
+import Types.Data.Maybe
+
+
+-- preNodes, sucNodes: map from node ID to edge label
+data Context preNodes nodeID nodeLabel sucNodes
+
+-- nodeMap: map from node ID to context
+data Graph nodeMap
+
+-- mContext: Maybe Context
+data Decomp mContext graph
+
+-- nodeID: natural number
+data LNode nodeID nodeLabel
+
+-- lNodes: list of LNode
+data LPath lNodes
+
+-- Empty
+type Empty = Graph M.Empty
+
+-- IsEmpty
+type family IsEmpty g
+type instance IsEmpty (Graph m) = M.Null m
+
+-- Match
+type Match node g = Match' (M.Lookup node g) node g
+
+type family Match' mContext node g
+type instance Match' Nothing node g = Decomp Nothing g
+type instance Match' (Just (Context p node' label s)) node g
+ = Decomp (Just (Context (M.Delete node p)
+ node
+ label
+ (M.Delete node s)))
+ (ClearSucc (ClearPred (M.Delete node g)
+ node
+ (M.Keys (M.Delete node s)))
+ node
+ (M.Keys (M.Delete node p)))
+
+-- ClearSucc
+type family ClearSucc g n ns
+type instance ClearSucc g n L.Null = g
+type instance ClearSucc g n (L.Cons s ss)
+ = ClearSucc (M.Adjust (ClearSucc' n) s g) n ss
+
+data ClearSucc' n
+type instance L.App (ClearSucc' n) (Context ps n' l ss)
+ = Context ps n' l (M.Delete n ss)
+
+-- ClearPred
+type family ClearPred g n ns
+type instance ClearPred g n L.Null = g
+type instance ClearPred g n (L.Cons p ps)
+ = ClearPred (M.Adjust (ClearPred' n) p g) n ps
+
+data ClearPred' n
+type instance L.App (ClearPred' n) (Context ps n' l ss)
+ = Context (M.Delete n ps) n' l ss
--- /dev/null
+{-# LANGUAGE
+ EmptyDataDecls,
+ TypeFamilies,
+ UndecidableInstances
+ #-}
+module Types.Data.Graph.Dijkstra
+ ( Dijkstra
+ , SpTree
+ , SpLength
+ , Sp
+ )
+ where
+
+import qualified Types.Data.Heap as H
+import qualified Types.Data.List as L
+import qualified Types.Data.List.Ops as L
+import qualified Types.Data.Map as M
+
+import Types.Data.Bool
+import Types.Data.Graph
+import Types.Data.Graph.RootPath
+import Types.Data.Maybe
+import Types.Data.Num
+
+-- Expand
+type family Expand distance lPath context
+type instance Expand d (LPath p) (Context ps n l ss)
+ = L.Map (Expand' d p) (M.Assocs ss)
+
+data Expand' distance path
+type instance L.App (Expand' d p) (L.Cons n d')
+ = H.Unit (d :+: d')
+ (LPath (L.Cons (LNode n (d :+: d')) p))
+
+-- Dijkstra
+type Dijkstra h g
+ = If (H.IsEmpty h :||: IsEmpty g)
+ L.Null
+ (Dijkstra' h g (H.SplitMin h))
+
+type family Dijkstra' heap graph min
+type instance Dijkstra' h g (L.Cons d (L.Cons (LPath (L.Cons (LNode n d') ps)) h'))
+ = Dijkstra'' n d' (LPath (L.Cons (LNode n d) ps)) h' (Match n g)
+
+type family Dijkstra'' node distance lPath heap' decomp
+type instance Dijkstra'' n d p h' (Decomp Nothing g') = Dijkstra h' g'
+type instance Dijkstra'' n d p h' (Decomp (Just c) g')
+ = L.Cons p (Dijkstra (H.MergeAll (L.Cons h' (Expand d p c))) g')
+
+-- SpTree
+type SpTree node graph
+ = Dijkstra (H.Unit D0 (LPath (L.Cons (LNode node D0) L.Null))) graph
+
+-- SpLength
+type SpLength node1 node2 graph
+ = GetDistance node2 (SpTree node1 graph)
+
+-- Sp
+type Sp node1 node2 graph
+ = GetLPathNodes node2 (SpTree node1 graph)
--- /dev/null
+{-# LANGUAGE
+ EmptyDataDecls,
+ TypeFamilies,
+ UndecidableInstances
+ #-}
+module Types.Data.Graph.RootPath
+ ( GetLPath
+ , GetDistance
+ , GetLPathNodes
+ )
+ where
+
+import qualified Types.Data.List as L
+import qualified Types.Data.List.Ops as L
+
+import Types.Data.Bool
+import Types.Data.Graph
+import Types.Data.Ord
+
+-- NodeID
+type family NodeID lNode
+type instance NodeID (LNode nodeID nodeLabel) = nodeID
+
+-- NodeIDA
+data NodeIDA
+type instance L.App NodeIDA lNode = NodeID lNode
+
+-- NodeLabel
+type family NodeLabel lNode
+type instance NodeLabel (LNode nodeID nodeLabel) = nodeLabel
+
+-- FindP
+type family FindP node lPaths
+type instance FindP n L.Null = L.Null
+type instance FindP n (L.Cons (LPath L.Null) ps) = FindP n ps
+type instance FindP n (L.Cons (LPath (L.Cons (LNode n' l) ns)) ps)
+ = If (n :==: n')
+ (L.Cons (LNode n' l) ns)
+ (FindP n ps)
+
+-- GetLPath
+type GetLPath node lPaths
+ = LPath (GetLPath' node lPaths)
+
+-- GetLPath'
+type GetLPath' node lPaths
+ = L.Reverse (FindP node lPaths)
+
+-- GetDistance
+type GetDistance node lPaths
+ = NodeLabel (L.Head (FindP node lPaths))
+
+-- GetLPathNodes
+type GetLPathNodes node lPaths
+ = L.Map NodeIDA (GetLPath' node lPaths)
TypeOperators,
UndecidableInstances
#-}
-module Data.HList.Heap
+module Types.Data.Heap
( Heap
, Empty
)
where
-import Data.HList
+import Types.Data.List
import Types.Data.Bool
import Types.Data.Ord
instance Heap Empty
instance Heap hs => Heap (Node k v hs)
-type Unit k v = Node k v Nil
+type Unit k v = Node k v Null
type family IsEmpty h
type instance IsEmpty Empty = True
(Node k2 v2 (Cons (Node k1 v1 hs1) hs2))
type family MergeAll hs
-type instance MergeAll Nil = Empty
-type instance MergeAll (Cons h Nil) = h
+type instance MergeAll Null = Empty
+type instance MergeAll (Cons h Null) = h
type instance MergeAll (Cons h (Cons h' hs))
= Merge (Merge h h') (MergeAll hs)
type instance Size (Bin s k v l r) = s
-- CompCase
-type CompCase a b ifLT ifGT ifEQ
- = If (IsLT (Compare a b))
- ifLT
- (If (IsGT (Compare a b))
- ifGT
- ifEQ)
+type family CompCase o ifLT ifGT ifEQ
+type instance CompCase LT ifLT ifGT ifEQ = ifLT
+type instance CompCase GT ifLT ifGT ifEQ = ifGT
+type instance CompCase EQ ifLT ifGT ifEQ = ifEQ
-- Lookup
type family Lookup k m
type instance Lookup k Tip = Nothing
type instance Lookup k (Bin s k' v l r)
- = CompCase k k'
+ = CompCase (Compare k k')
(Lookup k l)
(Lookup k r)
(Just v)
type family LookupAssoc k m
type instance LookupAssoc k Tip = Nothing
type instance LookupAssoc k (Bin s k' v l r)
- = CompCase k k'
+ = CompCase (Compare k k')
(LookupAssoc k l)
(LookupAssoc k r)
(Just (Cons k v))
type family Insert k v m
type instance Insert k v Tip = Singleton k v
type instance Insert k v (Bin s k' v' l r)
- = CompCase k k'
+ = CompCase (Compare k k')
(Balance k' v' (Insert k v l) r)
(Balance k' v' l (Insert k v r))
(Bin s k v l r)
type family Delete k m
type instance Delete k Tip = Tip
type instance Delete k (Bin s k' v l r)
- = CompCase k k'
+ = CompCase (Compare k k')
(Balance k' v (Delete k l) r)
(Balance k' v l (Delete k r))
(Glue l r)
type Balance k v l r
= If ((Size l :+: Size r) :<=: D1)
- (Bin (Size l :+: Size r :+: D1) k v l r)
+ (Bin (SizeX l r) k v l r)
(If (Size r :>=: (Delta :*: Size l))
(RotateL k v l r)
(If (Size l :>=: (Delta :*: Size r))
(RotateR k v l r)
- (Bin (Size l :+: Size r :+: D1) k v l r)))
+ (Bin (SizeX l r) k v l r)))
+
+type SizeX l r = Size l :+: Size r :+: D1
-- Rotate
type family RotateL k v l r
type family UpdateWithKey f k m
type instance UpdateWithKey f k Tip = Tip
type instance UpdateWithKey f k (Bin s k' v l r)
- = CompCase k k'
+ = CompCase (Compare k k')
(Balance k' v (UpdateWithKey f k l) r)
(Balance k' v l (UpdateWithKey f k r))
- (If (IsJust (App2 f k' v))
- (Bin s k' (FromJust (App2 f k' v)) l r)
- (Glue l r))
+ (UpdateWithKey' s k' (App2 f k' v) l r)
+
+type family UpdateWithKey' s k mv l r
+type instance UpdateWithKey' s k (Just v) l r = Bin s k v l r
+type instance UpdateWithKey' s k Nothing l r = Glue l r
-- Map
type MapValue f m = MapWithKey (MapValue' f) m
Database.RRDtool.Create
Database.RRDtool.Expression
Data.HList
- Data.HList.Heap
- Data.HList.Graph
Data.HList.Prelude
Data.HList.String
+ Types.Data.Graph
+ Types.Data.Graph.Dijkstra
+ Types.Data.Graph.RootPath
+ Types.Data.Heap
Types.Data.List.Ops
Types.Data.Map
Types.Data.Maybe
projects / hs-rrdtool.git / commitdiff