teams 0.0.1 → 0.0.2
raw patch · 5 files changed
+123/−59 lines, 5 files
Files
- Data/Teams/Examples/MAB.hs +41/−0
- Data/Teams/Examples/Wit79.hs +1/−1
- Data/Teams/Graph.hs +70/−49
- Data/Teams/Structure.hs +9/−8
- teams.cabal +2/−1
+ Data/Teams/Examples/MAB.hs view
@@ -0,0 +1,41 @@+-- | Multiaccess broadcast +-- Based on the example in+-- Aditya Mahajan, Ashutosh Nayyar, and Demosthenis Teneketzis,+-- \"Identifying tractable decentralized problems +-- on the basis of information structures,\"+-- Proceedings of the 46th annual Allerton conference on +-- communication, control, and computing, pp. 1440-1449, +-- Monticello, IL, September 23-26, 2008.++module Data.Teams.Examples.MAB where++import Data.Teams.Structure++x1 = mkNonReward "x1" -- queue length of user 1+x2 = mkNonReward "x2" -- queue length of user 2+u1 = mkNonReward "u1" -- decision of user 1+u2 = mkNonReward "u2" -- decision of user 2+z1 = mkNonReward "z1" -- feedback to user 2 (= x1*u1)+z2 = mkNonReward "z2" -- feedback to user 1 (= x2*u2)+r = mkReward "r"++f1 = mkStochastic "f1"+f2 = mkStochastic "f2"+g1 = mkControl "g1"+g2 = mkControl "g2"+c1 = mkDeterministic "c1"+c2 = mkDeterministic "c2"+d = mkStochastic "d"++dynamics t = f1(t).$.(x1(t).|. if t==1 then [] else [x1(t-1), u1(t-1), z2(t-1)])+ ++ f2(t).$.(x2(t).|. if t==1 then [] else [x2(t-1), u2(t-1), z1(t-1)])+ ++ g1(t).$.(u1(t).|. map x1[1..t] ++ map u1[1..t-1] + ++ map z2[1..t-1])+ ++ g2(t).$.(u2(t).|. map x2[1..t] ++ map u2[1..t-1] + ++ map z1[1..t-1])+ ++ c1(t).$.(z1(t).|. [x1(t), u1(t)])+ ++ c2(t).$.(z2(t).|. [x2(t), u2(t)])+ ++ d(t).$.(r(t) .|. [x1(t), x2(t), u1(t), u2(t)])++mab = mkTeamTime dynamics 4+
Data/Teams/Examples/Wit79.hs view
@@ -1,7 +1,7 @@ -- | Real time source coding -- Based on -- Hans S. Witsenhausen --- "On the structure of real-time source coders,"+-- \"On the structure of real-time source coders,\" -- Bell Systems Technical Journal, -- vol 58, no 6, pp 1437-1451, July-August 1979
Data/Teams/Graph.hs view
@@ -31,7 +31,8 @@ , Edge , EdgeType (..) , Team -- * Constructors for nodes- , mkVertex , mkReward , mkNonReward , mkDynamics , mkControl+ , mkVertex , mkReward , mkNonReward , mkControl+ , mkDeterministic, mkStochastic -- * Constructor for edges , (.$.) , (.|.) -- * Constructors for teams@@ -62,8 +63,9 @@ deriving (Eq, Ord, Show) -- | Factor Vertexs-data Factor = Dynamics String -- ^ Factor node representing system dynamics- | Control String -- ^ Factor node representing control function+data Factor = Deterministic String -- ^ Factor node representing deterministic system dynamics+ | Stochastic String -- ^ Factor node representing stochastic system dynamics+ | Control String -- ^ Factor node representing control function deriving (Eq, Ord, Show) -- | Create a sequence of nodes of a specific type@@ -78,10 +80,14 @@ mkNonReward :: String -> Time -> Variable mkNonReward = mkVertex NonReward --- | Create a sequence of system dynamics nodes-mkDynamics :: String -> Time -> Factor-mkDynamics = mkVertex Dynamics+-- | Create a sequence of stochastic system dynamics nodes+mkStochastic :: String -> Time -> Factor+mkStochastic = mkVertex Stochastic +-- | Create a sequence of deterministic system dynamics nodes+mkDeterministic :: String -> Time -> Factor+mkDeterministic = mkVertex Deterministic+ -- | Create a sequence of control nodes mkControl :: String -> Time -> Factor mkControl = mkVertex Control@@ -92,27 +98,29 @@ -- | A type class for defining operations on all nodes class Vertex a where -- | Name of node @a@- name :: a -> String+ name :: a -> String -- | Name of a list of nodes- names :: [a] -> String+ names :: [a] -> String -- | Check if node @a@ is a reward node- isReward :: a -> Bool+ isReward :: a -> Bool -- | Check if node @a@ is a non reward node- isNonReward :: a -> Bool+ isNonReward :: a -> Bool -- | Check if node @a@ is a variable node- isVariable :: a -> Bool- -- | Check if node @a@ is a system dynamics- isDynamics :: a -> Bool+ isVariable :: a -> Bool+ -- | Check if node @a@ is a stochastic system dynamics+ isStochastic :: a -> Bool+ -- | Check if node @a@ is a deterministic stochastic system dynamics+ isDeterministic :: a -> Bool -- | Check if node @a@ is a control node- isControl :: a -> Bool+ isControl :: a -> Bool -- | Check if node @a@ is a factor node- isFactor :: a -> Bool+ isFactor :: a -> Bool -- | The attributes of the node. Used to contruct the dot file.- attribute :: a -> [G.Attribute]+ attribute :: a -> [G.Attribute] -- Default implmentation names xs = "[" ++ intercalate ", " (map name xs) ++ "]" isVariable = or . sequence [isReward, isNonReward]- isFactor = or . sequence [isControl, isDynamics]+ isFactor = or . sequence [isControl, isDeterministic, isStochastic] instance Vertex Variable where@@ -125,8 +133,9 @@ isNonReward (Reward _) = False isNonReward (NonReward _) = True - isDynamics _ = False- isControl _ = False+ isDeterministic _ = False+ isStochastic _ = False+ isControl _ = False attribute (Reward a) = [G.Style G.Filled, G.FillColor (G.RGB 0 255 0) , G.Shape G.Circle@@ -135,31 +144,42 @@ , G.Label a] instance Vertex Factor where- name (Dynamics a) = a- name (Control a) = a+ name (Deterministic a) = a+ name (Stochastic a) = a+ name (Control a) = a - isDynamics (Dynamics _) = True- isDynamics (Control _) = False+ isDeterministic (Deterministic _) = True+ isDeterministic (Stochastic _) = False+ isDeterministic (Control _) = False - isControl (Dynamics _) = False- isControl (Control _) = True+ isStochastic (Deterministic _) = False+ isStochastic (Stochastic _) = True+ isStochastic (Control _) = False + isControl (Deterministic _) = False+ isControl (Stochastic _) = False+ isControl (Control _) = True+ isReward _ = False isNonReward _ = False - attribute (Dynamics a) = [G.Shape G.Rectangle- , G.Label a]- attribute (Control a) = [G.Style G.Filled, G.FillColor (G.RGB 255 0 0)- , G.Shape G.Rectangle- , G.Label a]+ attribute (Deterministic a) = [G.Shape G.Rectangle+ , G.Label a]+ attribute (Stochastic a) = [G.Style G.Filled, G.FillColor (G.RGB 100 0 0)+ , G.Shape G.Rectangle+ , G.Label a]+ attribute (Control a) = [G.Style G.Filled, G.FillColor (G.RGB 255 0 0)+ , G.Shape G.Rectangle+ , G.Label a] instance (Vertex a, Vertex b) => Vertex (Either a b) where- name = either name name- isReward = either isReward isReward- isNonReward = either isNonReward isNonReward- isDynamics = either isDynamics isDynamics - isControl = either isControl isControl- attribute = either attribute attribute+ name = either name name+ isReward = either isReward isReward+ isNonReward = either isNonReward isNonReward+ isDeterministic = either isDeterministic isDeterministic+ isStochastic = either isStochastic isStochastic+ isControl = either isControl isControl+ attribute = either attribute attribute -- | An edge in a graph type Edge = (Node, Node, EdgeType)@@ -218,9 +238,9 @@ u = 'mkNonReward' \"u\" r = 'mkReward' \"r\" -f = 'mkDynamics' \"f\"-g = 'mkControl' \"g\"-d = 'mkDynamics' \"d\"+f = 'mkStochastic' \"f\"+g = 'mkControl' \"g\"+d = 'mkStochastic' \"d\" dynamics t = f(t-1).$.( x(t) .|. if t == 1 then [] else [x(t-1), u(t-1)] ) ++ g(t) .$.( u(t) .|. map x[1..t] ++ map u[1..t-1] )@@ -237,18 +257,18 @@ follows. @-m = 'NonReward' \"m\"-mhat = 'NonReward' \"mhat\"-r = 'Reward' \"r\"-h = 'Dynamics' \"h\"-g = 'Control' \"g\"-d = 'Dynamics' \"d\"+m = 'NonReward' \"m\"+mhat = 'NonReward' \"mhat\"+r = 'Reward' \"r\"+h = 'Stochastic' \"h\"+g = 'Control' \"g\"+d = 'Stochastic' \"d\" x = 'mkNonReward' \"x\" y = 'mkNonReward' \"y\" -f = 'mkControl' \"f\"-c = 'mkDynamics' \"c\"+f = 'mkControl' \"f\"+c = 'mkStochastic' \"c\" start = h .$.( m .|. [] ) dynamics t = f(t) .$. ( x(t) .|. m : map x [1..t-1] ++ map y [1..t-1] )@@ -328,8 +348,9 @@ -- | Pretty print the team specification showTeam :: Team -> String-showTeam team = showTeamBy team isDynamics "Dynamics:" ++ "\n"- ++ showTeamBy team isControl "Control :" ++ "\n"+showTeam team = showTeamBy team isStochastic "Stochastic:" ++ "\n"+ ++ showTeamBy team isDeterministic "Deterministic" ++ "\n"+ ++ showTeamBy team isControl "Control :" ++ "\n" showTeamBy :: Team -> (Node -> Bool) -> String -> String showTeamBy team p str = if null equations
Data/Teams/Structure.hs view
@@ -133,8 +133,9 @@ mkClean v@(NonReward _) = VMarked v NotMarked NotScheduled NotVisited instance Initializable Factor where- mkClean f@(Dynamics _) = FMarked f NotMarked NotScheduled NotVisited- mkClean f@(Control _) = FMarked f NotMarked NotScheduled NotVisited+ mkClean f@(Deterministic _) = FMarked f NotMarked NotScheduled NotVisited+ mkClean f@(Stochastic _) = FMarked f NotMarked NotScheduled NotVisited+ mkClean f@(Control _) = FMarked f NotMarked NotScheduled NotVisited instance (Initializable a, Initializable b) => Initializable (Either a b) where mkClean (Left a) = mkClean a@@ -195,7 +196,7 @@ bottomVisit | x `elem` condition = id | otherwise = checkAction . markBottom -- Check if a node is a deterministic node or not. - checkAction | isDeterministic gr x = id+ checkAction | isFunctional gr x = id | otherwise = markTop -- When the visit is from the top, is the node is in the -- conditioning node and its bottom is not marked, mark its bottom@@ -231,12 +232,12 @@ markVisited{- g -} = visitNode x -- g markClean {- g -} = cleanNode x -- g --- | Check if a node is deterministic. Currently we simply check if its parent--- is a control node.-isDeterministic :: MTeam -> G.Node -> Bool-isDeterministic mteam x = case G.pre mteam x of +-- | Check if a node is functionally deterministic. We check if its parent+-- is a control node or a deterministic+isFunctional :: MTeam -> G.Node -> Bool+isFunctional mteam x = case G.pre mteam x of [] -> True- [y] -> isControl. node . label mteam $ y+ [y] -> or . sequence [isControl, isDeterministic] . node . label mteam $ y _ -> False -- | Modify a marked node
teams.cabal view
@@ -1,5 +1,5 @@ Name: teams-Version: 0.0.1+Version: 0.0.2 Description: Graphical modeling tools for sequential teams License: GPL License-file: LICENSE@@ -16,4 +16,5 @@ Data.Teams.Structure Data.Teams.Examples.Wit79 Data.Teams.Examples.DecMdp+ Data.Teams.Examples.MAB ghc-options: -Wall