Commit e3bce867 authored by Stefan Jaax's avatar Stefan Jaax

Fix bug in construction of arcs

parent 36ab546f
...@@ -165,7 +165,7 @@ data RecordPP = RecordPP { ...@@ -165,7 +165,7 @@ data RecordPP = RecordPP {
initialStates :: [String], initialStates :: [String],
trueStates :: [String], trueStates :: [String],
predicate :: Maybe (QuantFormula String), predicate :: Maybe (QuantFormula String),
description :: Maybe String description :: Maybe String
} deriving (Show) } deriving (Show)
$(deriveJSON defaultOptions ''RecordTransition) $(deriveJSON defaultOptions ''RecordTransition)
...@@ -173,11 +173,10 @@ $(deriveJSON defaultOptions ''RecordPP) ...@@ -173,11 +173,10 @@ $(deriveJSON defaultOptions ''RecordPP)
recordPP2PopulationProtocol :: RecordPP -> PopulationProtocol recordPP2PopulationProtocol :: RecordPP -> PopulationProtocol
recordPP2PopulationProtocol r = recordPP2PopulationProtocol r =
makePopulationProtocolFromStrings (title r) (states r) (map name (transitions r)) (initialStates r) (trueStates r) falseStates p arcs where makePopulationProtocolFromStrings (title r) (states r) (map name (transitions r)) (initialStates r) (trueStates r) falseStates p arcs where
falseStates = [q | q <- states r, not (S.member q (S.fromList (trueStates r)))] falseStates = [q | q <- states r, not (S.member q (S.fromList (trueStates r)))]
count = \x -> fromIntegral . length . (filter (== x)) arcs = [(q, name t, 1) | t <- transitions r, q <- pre t] ++
arcs = [(q, name t, (count q) (pre t)) | t <- transitions r, q <- pre t] ++ [(name t, q, 1) | t <- transitions r, q <- post t]
[(name t, q, (count q) (post t)) | t <- transitions r, q <- post t]
p = case predicate r of Nothing -> ExQuantFormula [] FTrue p = case predicate r of Nothing -> ExQuantFormula [] FTrue
(Just p') -> p' (Just p') -> p'
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment