teams 0.0.2.1 → 0.0.2.3
raw patch · 6 files changed
+31/−26 lines, 6 filesdep ~basedep ~graphviz
Dependency ranges changed: base, graphviz
Files
- Data/Teams/Examples/DecMdp.hs +1/−1
- Data/Teams/Examples/MAB.hs +3/−3
- Data/Teams/Examples/Wit79.hs +1/−3
- Data/Teams/Graph.hs +17/−11
- Data/Teams/Structure.hs +7/−6
- teams.cabal +2/−2
Data/Teams/Examples/DecMdp.hs view
@@ -14,7 +14,7 @@ g2 = mkControl "g2" d = mkStochastic "d" -dynamics t = f(t).$.(x(t) .|. if t == 1 then [] else [x(t-1), u1(t-1), u2(t-1)])+dynamics t = f(t).$.(x(t) .|. onlyif (t /= 1) [x(t-1), u1(t-1), u2(t-1)]) ++ g1(t).$.(u1(t) .|. map x[1..t] ++ map u1[1..t-1]) ++ g2(t).$.(u2(t) .|. map x[1..t] ++ map u2[1..t-1]) ++ d(t) .$.(r(t) .|. [x(t), u1(t), u2(t)])
Data/Teams/Examples/MAB.hs view
@@ -27,15 +27,15 @@ 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)])+dynamics t = f1(t).$.(x1(t).|. onlyif (t /= 1) [x1(t-1), u1(t-1), z2(t-1)])+ ++ f2(t).$.(x2(t).|. onlyif (t /= 1) [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)])+ ++ d(t) .$.(r(t) .|. [x1(t), x2(t), u1(t), u2(t)]) mab = mkTeamTime dynamics 4
Data/Teams/Examples/Wit79.hs view
@@ -32,7 +32,5 @@ ++ l(t).$.(m(t) .|. [y(t), m(t-1)]) ++ d(t).$.(r(t) .|. [x(t), x'(t)]) -rt = mkTeamTime dynamics 4--rt' = simplify rt+rt = mkTeamTime dynamics 3
Data/Teams/Graph.hs view
@@ -46,6 +46,8 @@ , printTeam , showTeam , graphToDot , printGraph -- * Utility functions for "Data.Graph.Inductive" , label, labels+ -- * Utility functions for "Control.Monad"+ , onlyif ) where import qualified Data.Graph.Inductive as G@@ -53,6 +55,7 @@ import Data.Maybe (fromJust) import Data.List (nub, intercalate, delete) import Text.Printf (printf)+import Control.Monad (MonadPlus, mzero) -- | Time type Time = Int@@ -137,11 +140,11 @@ isStochastic _ = False isControl _ = False - attribute (Reward a) = [G.Style G.Filled, G.FillColor (G.RGB 0 255 0)+ attribute (Reward a) = [G.Style [G.SItem G.Filled []], G.FillColor (G.RGB 255 204 255) , G.Shape G.Circle- , G.Label a]+ , G.Label (G.StrLabel a)] attribute (NonReward a) = [G.Shape G.Circle- , G.Label a]+ , G.Label (G.StrLabel a)] instance Vertex Factor where name (Deterministic a) = a@@ -164,13 +167,13 @@ isNonReward _ = False 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.Label (G.StrLabel a)]+ attribute (Stochastic a) = [-- G.Style [G.SItem G.Filled []], G.FillColor (G.RGB 100 255 255)+ {-,-} G.Shape G.Rectangle+ , G.Label (G.StrLabel a)]+ attribute (Control a) = [G.Style [G.SItem G.Filled []], G.FillColor (G.RGB 204 255 255) , G.Shape G.Rectangle- , G.Label a]+ , G.Label (G.StrLabel a)] instance (Vertex a, Vertex b) => Vertex (Either a b) where name = either name name@@ -212,6 +215,9 @@ infixr 4 .|. infixr 6 .$. +onlyif :: MonadPlus m => Bool -> m a -> m a+onlyif p a = if p then a else mzero+ -- | A sequential team as a directed acyclic factor graph (DAFG) type Team = G.Gr Node EdgeType @@ -368,8 +374,8 @@ -- * Convert to Graphviz graphs -- | Convert the graph to a dot file-graphToDot :: Team -> G.DotGraph-graphToDot team = G.graphToDot team [] (attribute.snd) +graphToDot :: Team -> G.DotGraph G.Node+graphToDot team = G.graphToDot True team [] (attribute.snd) (edgeAttribute. \(_,_,b) -> b) -- | Convert the dot file to a pdf
Data/Teams/Structure.hs view
@@ -155,9 +155,8 @@ -- Then schedule all reward nodes to be visited from bottom. mteam = G.gmap initialize . G.nmap mkClean $ team initialize (pre,idx,lab,suc) = (pre, idx, lab', suc) - where lab' = if idx `elem` reward - then addSchedule BottomScheduled lab - else lab+ where lab' | idx `elem` reward = addSchedule BottomScheduled lab + | otherwise = lab -- | The main loop of the Bayes Ball algorithm doBayesBall :: [G.Node] -> MTeam -> MTeam@@ -294,6 +293,7 @@ effective :: Team -> [G.Node] -> [G.Node] -> [G.Node] effective team conditioned reward = (determined team conditioned `intersect` ancestoral team reward) \\ conditioned+-- effective team conditioned reward = determined team conditioned \\ conditioned -- | The graph restructuring algorithm of the paper. simplifyAt :: Team -> G.Node -> Team@@ -319,7 +319,8 @@ simplify :: Team -> Team simplify team = untilEqual . zip stream $ [(1::Int)..] where stream = iterate simplifyOnce team- untilEqual ((a,n):as@((b,_):_)) = trace ("Simplify : Iteration " ++ show n) $- if G.equal a b then a- else untilEqual as+ untilEqual ((a,n):as@((b,_):_)) + | G.equal a b = a+ | otherwise = trace ("Simplify : Iteration " ++ show n) + (untilEqual as) untilEqual _ = error "Infinite stream ended. This should not happen"
teams.cabal view
@@ -1,5 +1,5 @@ Name: teams-Version: 0.0.2.1+Version: 0.0.2.3 Description: Graphical modeling tools for sequential teams License: GPL License-file: LICENSE@@ -11,7 +11,7 @@ Stability: experimental Synopsis: Graphical modeling tools for sequential teams Library- Build-Depends: base, fgl>=5.4, containers, graphviz>=2009.5.1+ Build-Depends: base<5.0, fgl>=5.4, containers, graphviz>=2909.6.0.0 Exposed-modules: Data.Teams.Graph Data.Teams.Structure Data.Teams.Examples.Wit79