Add predicate to generated protocols (1683cbb1) · Commits · i7 / peregrine

benchmarks/pp-print/src/PopulationProtocol.hs

+32 −5

Original line number	Diff line number	Diff line
		@@ -13,16 +13,19 @@ module PopulationProtocol ( PopulationProtocol (..)
		, createMLayerProtocol
		) where

		import Util
		import qualified Data.Set as S
		import qualified Data.MultiSet as MS
		import qualified Data.Map.Strict as M
		import Data.Tuple (swap)
		import Data.List (intercalate)
		import Data.Maybe (catMaybes, fromMaybe)

		data PopulationProtocol qs = PopulationProtocol { states :: [qs]
		, initial :: [qs]
		, trans :: (qs, qs) -> (qs, qs)
		, opinion :: qs -> Bool
		, predicate :: Maybe String
		}


		@@ -68,6 +71,7 @@ simpleProtocol = PopulationProtocol { states = [L 9, NL 2, NL 4, L 10, NL 1, NL
		, initial = [L 9]
		, trans = simpleTrans
		, opinion = \x -> True
		, predicate = Nothing
		} where
		simpleTrans (L 9, NL 2) = (L 10, NL 1)
		simpleTrans (L 9, NL 4) = (L 10, NL 3)
		@@ -79,6 +83,7 @@ createMLayerProtocol m = PopulationProtocol { states = [i \| i <- [1..(2*m)]]
		, initial = states (createMLayerProtocol m)
		, trans = layerTrans
		, opinion = \x -> True
		, predicate = Nothing
		} where
		layerTrans (q1, q2) = let boolToSign b = if b then 1 else -1
		boolToVal b = if b then 1 else 0 in
		@@ -98,14 +103,18 @@ createBroadcastProtocol :: PopulationProtocol Bool
		createBroadcastProtocol = PopulationProtocol { states = [True, False]
		, initial = states (createBroadcastProtocol)
		, trans = \(q1, q2) -> (q1 \|\| q2, q1 \|\| q2)
		, opinion = \q -> q}
		, opinion = \q -> q
		, predicate = Just (toVar True ++ " >= 1")
		}


		createVerifiableFlockOfBirdsProtocol :: Int -> VerifiableFlockOfBirdsProtocol
		createVerifiableFlockOfBirdsProtocol i = PopulationProtocol { states = [(b, j) \| b <- [True, False], j <- [0..i]]
		, initial = [((i == 1), 1)]
		, trans = verifiableFlockOfBirdsTrans
		, opinion = \(b, _) -> b} where
		, opinion = \(b, _) -> b
		, predicate = Nothing
		} where
		verifiableFlockOfBirdsTrans ((b1, n1), (b2, n2)) = if n1 + n2 < i then
		((b1, n1 + n2), (b2, 0))
		else
		@@ -117,32 +126,40 @@ createFlockOfBirdsProtocol i = PopulationProtocol { states = [0..i]
		, initial = [0, 1]
		, trans = flockOfBirdsTrans
		, opinion = flockOfBirdsOpinion
		, predicate = Just flockOfBirdsPredicate
		} where
		flockOfBirdsTrans (q1, q2) = if q1 + q2 < i then
		(q1 + q2, 0)
		else
		(i, i)
		flockOfBirdsOpinion x = (x == i)
		flockOfBirdsPredicate = (toVar 1) ++ " >= " ++ show i


		createNewBirdsProtocol :: Int -> PopulationProtocol Int
		createNewBirdsProtocol i = PopulationProtocol { states = [0..i]
		, initial = [0, 1]
		, trans = newBirdsTrans
		, opinion = (== i)} where
		, opinion = (== i)
		, predicate = Just newBirdsPredicate
		} where
		newBirdsTrans (q, q') \| (q == q' && q > 0 && q < i) = (q, q + 1)
		\| (q == i \|\| q' == i) = (i, i)
		\| otherwise = (q, q')
		newBirdsPredicate = (toVar 1) ++ " >= " ++ show i


		createOldThresholdProtocol :: Int -> Int -> OldThresholdProtocol
		createOldThresholdProtocol lmax c = PopulationProtocol { states = [OldThresholdState b1 b2 s \| b1 <- [True, False]
		, b2 <- [True, False]
		, s <- [-lmax..lmax]]
		, initial = [q \| q <- states (createOldThresholdProtocol lmax c) , leaderBit q]
		, initial = oldThresholdInitial
		, trans = oldThresholdTrans
		, opinion = outputBit
		, predicate = Just oldThresholdPredicate
		} where
		oldThresholdInitial = [q \| q <- states (createOldThresholdProtocol lmax c) , leaderBit q]

		oldThresholdTrans (q1, q2) = if leaderBit q1 \|\| leaderBit q2 then
		(OldThresholdState True (b q1 q2) (l q1 q2),
		OldThresholdState False (b q1 q2) (r q1 q2))
		@@ -152,12 +169,16 @@ createOldThresholdProtocol lmax c = PopulationProtocol { states = [OldThresholdS
		l q1 q2 = max (-lmax) (min lmax (numVal q1 + numVal q2))
		r q1 q2 = numVal q1 + numVal q2 - l q1 q2

		oldThresholdPredicate = (intercalate " + " [ show (numVal q) ++ " * " ++ toVar q \| q <- oldThresholdInitial ]) ++
		" < " ++ (show c)


		createModuloProtocol :: Int -> Int -> ModuloProtocol
		createModuloProtocol n c = PopulationProtocol { states = [Mod i \| i <- [0..(n-1)]] ++ [ModPassive True, ModPassive False]
		, initial = [Mod i \| i <- [0..(n-1)]]
		, trans = modTrans
		, opinion = modOpinion
		, predicate = Just modPredicate
		} where
		modTrans (Mod a, Mod b) = let c' = (a + b) `mod` n in (Mod c', ModPassive (c' == c))
		modTrans (Mod a, ModPassive b) = (Mod a, ModPassive (a == c))
		@@ -166,12 +187,17 @@ createModuloProtocol n c = PopulationProtocol { states = [Mod i \| i <- [0..(n-1)
		modOpinion (Mod a) = a == c
		modOpinion (ModPassive b) = b

		modPredicate = "EXISTS k : " ++
		(intercalate " + " [ show i ++ " * " ++ toVar (Mod i) \| i <- [0..(n-1)] ]) ++
		" = " ++ show c ++ " + " ++ show n ++ " * k"


		createMajorityProtocol :: MajorityProtocol
		createMajorityProtocol = PopulationProtocol { states = [A, B, Asmall, Bsmall]
		, initial = [A, B]
		, trans = majorityTrans
		, opinion = majorityOpinion
		, predicate = Just (toVar A ++ " > " ++ toVar B)
		} where
		majorityTrans (A, B) = (Asmall, Bsmall)
		majorityTrans (B, A) = (Bsmall, Asmall)
		@@ -197,6 +223,7 @@ createThresholdProtocol n c' = if n < 0 \|\| c' < 0 then
		, initial = [Neg i \| i <- [1..n]] ++ [Pos i \| i <- [0..n]]
		, trans = thresholdTrans
		, opinion = thresholdOpinion
		, predicate = Nothing
		}) where
		thresholdStates = [Neg i \| i <- [1..n]] ++
		[Pos i \| i <- [0..n]] ++

benchmarks/pp-print/src/ProtocolOutput.hs

+8 −12

Original line number	Diff line number	Diff line
		module ProtocolOutput where

		import Util
		import PopulationProtocol
		import Data.Char (toLower)

		transToVar :: (Show qs) => (qs, qs) -> String
		transToVar (q1, q2) = "x_" ++ toVar q1 ++ "_" ++ toVar q2


		toVar :: (Show a) => a -> String
		toVar = ('_':) . map toLower . filter (\x -> not (x `elem` " ,()")) . show


		nonSilentActions :: (Ord qs) => PopulationProtocol qs -> [(qs, qs)]
		nonSilentActions pp = [(q1, q2) \| q1 <- states pp
		@@ -35,4 +27,8 @@ protocolToPetriNet pp name =
		" initial {" ++ unwords (toVar <$> initial pp) ++ "}\n" ++
		" true {" ++ unwords (toVar <$> [q \| q <- states pp, (opinion pp) q]) ++ "}\n" ++
		" false {" ++ unwords (toVar <$> [q \| q <- states pp, not ((opinion pp) q)]) ++ "}\n" ++
		(case (predicate pp) of
		Nothing -> ""
		Just p -> " predicate { " ++ p ++ " }\n"
		) ++
		"}"

benchmarks/pp-print/src/Util.hs

0 → 100644

+10 −0

Original line number	Diff line number	Diff line
		module Util (transToVar, toVar) where

		import Data.Char (toLower)

		transToVar :: (Show qs) => (qs, qs) -> String
		transToVar (q1, q2) = "x_" ++ toVar q1 ++ "_" ++ toVar q2

		toVar :: (Show a) => a -> String
		toVar = ('_':) . map toLower . filter (\x -> not (x `elem` " ,()")) . show