Commit c31e23ec authored by Stefan Jaax's avatar Stefan Jaax

Add benchmarks

parent 027c2e14
This diff is collapsed.
module ProtocolToPetrinet where
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
, q2 <- states pp
, q1 <= q2
, (trans pp) (q1, q2) /= (q1, q2)
, (trans pp) (q1, q2) /= (q2, q1)]
places :: (Show qs) => qs -> qs -> String
places q1 q2 = "{ " ++ toVar q1 ++ ", " ++ toVar q2 ++ " }"
protocolToPetriNet :: (Show qs, Ord qs) => PopulationProtocol qs -> String -> String
protocolToPetriNet pp name =
"petri net " ++ show name ++ " {" ++ "\n" ++
" places { " ++ unwords (toVar <$> states pp) ++ "}" ++ "\n" ++
" transitions { " ++ unwords (transToVar <$> nonSilentActions pp) ++ " }" ++ "\n" ++
" arcs {" ++ "\n" ++
unlines [" " ++ places q1 q2 ++ " -> " ++ transToVar (q1, q2) ++ " -> " ++ places q1' q2' |
(q1, q2) <- nonSilentActions pp, let (q1', q2') = (trans pp) (q1, q2)] ++
" }\n" ++
" initial {" ++ unwords (toVar <$> initial pp) ++ "}\n" ++
" yes {" ++ unwords (toVar <$> [q | q <- states pp, (opinion pp) q]) ++ "}\n" ++
" no {" ++ unwords (toVar <$> [q | q <- states pp, not ((opinion pp) q)]) ++ "}\n" ++
"}"
import System.Environment (getArgs)
import PopulationProtocol
import ProtocolToPetrinet
usageAction :: IO ()
usageAction = do
putStrLn "Usage: "
putStrLn "'./pp2petrinet majorityPP' converts Majority PP to PNet."
putStrLn "'./pp2petrinet broadCastPP' converts BroadCast PP to PNet."
putStrLn "'./pp2petrinet thresholdPP l c' converts threshold PP to PNet, where l and c are positive integers."
putStrLn "'./pp2petrinet moduloPP m c' converts Modulo PP to PNet, where m, c are positive integers."
putStrLn "'./pp2petrinet oldThresholdPP l c' converts Modulo PP to PNet, where l, c are positive integers."
putStrLn "'./pp2petrinet flockOfBirdsPP c' converts FlockOfBirds PP to PNet, where c is a positive integer."
putStrLn "'./pp2petrinet newBirdsPP c' converts NewBirds PP to PNet, where c is a positive integer."
putStrLn "'./pp2petrinet verifiableFlockOfBirdsPP c' converts VerifiableFlockOfBirds PP to PNet, where c is a positive integer."
putStrLn "'./pp2petrinet fastMajorityPP m d' converts FastMajority PP to PNet, where m, d must be odd and positive integers."
putStrLn "'./pp2petrinet layeredProtocol m' converts Protocol with m >= 1 termination layers to PNet."
majorityAction :: IO ()
majorityAction = putStr $ protocolToPetriNet createMajorityProtocol "Majority Protocol"
broadCastAction :: IO ()
broadCastAction = putStr $ protocolToPetriNet createBroadcastProtocol "BroadCast Protocol"
simpleAction :: IO ()
simpleAction = putStr $ protocolToPetriNet simpleProtocol "Simple Protocol"
newBirdsAction :: [String] -> IO ()
newBirdsAction [x] = let pp = createNewBirdsProtocol (read x) in
putStr $ protocolToPetriNet pp ("New birds protocol with c = " ++ x)
flockOfBirdsAction :: [String] -> IO ()
flockOfBirdsAction [x] = let pp = createFlockOfBirdsProtocol (read x) in
putStr $ protocolToPetriNet pp ("Flock of birds protocol with c = " ++ x)
verifiableFlockOfBirdsAction :: [String] -> IO ()
verifiableFlockOfBirdsAction [x] = let pp = createVerifiableFlockOfBirdsProtocol (read x) in
putStr $ protocolToPetriNet pp ("Verifiable flock of birds protocol with c = " ++ x)
oldThresholdAction :: [String] -> IO ()
oldThresholdAction [x, y] = let pp = createOldThresholdProtocol (read x) (read y) in
putStr $ protocolToPetriNet pp ("Old Threshold Protocol with l = " ++ x ++ " and c = " ++ y)
oldThresholdAction _ = usageAction
thresholdAction :: [String] -> IO ()
thresholdAction [x, y] = let (Just pp) = createThresholdProtocol (read x) (read y) in
putStr $ protocolToPetriNet pp ("Threshold Protocol with l = " ++ x ++ " and c = " ++ y)
thresholdAction _ = usageAction
moduloAction :: [String] -> IO ()
moduloAction [x, y] = let pp = createModuloProtocol (read x) (read y) in
putStr $ protocolToPetriNet pp ("Modulo Protocol with m = " ++ x ++ " and c = " ++ y)
moduloAction _ = usageAction
fastMajorityAction :: [String] -> IO ()
fastMajorityAction [m, d] = let pp = createAVCProtocol (read m) (read d) in
putStr $ protocolToPetriNet pp ("Fast majority with m = " ++ m ++ " and d = " ++ d)
fastMajorityAction _ = usageAction
layeredProtocolAction :: [String] -> IO ()
layeredProtocolAction [m] = let pp = createMLayerProtocol (read m) in
putStr $ protocolToPetriNet pp ("Layered Protocol with m = " ++ m ++ " layers.")
main = do
args <- getArgs
case args of
("majorityPP":_) -> majorityAction
("broadCastPP":_) -> broadCastAction
("thresholdPP":as) -> thresholdAction as
("oldThresholdPP":as) -> oldThresholdAction as
("moduloPP":as) -> moduloAction as
("flockOfBirdsPP":as) -> flockOfBirdsAction as
("newBirdsPP":as) -> newBirdsAction as
("verifiableFlockOfBirdsPP":as) -> verifiableFlockOfBirdsAction as
("simplePP":_) -> simpleAction
("fastMajorityPP":as) -> fastMajorityAction as
("layeredProtocol":as) -> layeredProtocolAction as
_ -> usageAction
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