Commit b12fc08d authored by Philipp Meyer's avatar Philipp Meyer
Browse files

Extended solver logic for safety and liveness properties

parent e6b6495e
...@@ -8,38 +8,47 @@ import PetriNet ...@@ -8,38 +8,47 @@ import PetriNet
import Property import Property
import Solver import Solver
import Solver.StateEquation import Solver.StateEquation
import Solver.TransitionInvariant
import Solver.TrapConstraints import Solver.TrapConstraints
import Solver.TransitionInvariant
import Solver.SComponent
checkSafetyProperty :: PetriNet -> Formula -> [[String]] -> IO Bool checkSafetyProperty :: PetriNet -> Formula -> [[String]] -> IO Bool
checkSafetyProperty net f traps = do checkSafetyProperty net f traps = do
r <- checkSat $ checkStateEquationSat net f traps r <- checkSat $ checkStateEquationSat net f traps
case r of case r of
Nothing -> return True Nothing -> return True
Just a -> do Just a -> do
--print a --print a
let assigned = markedPlacesFromAssignment net a let assigned = markedPlacesFromAssignment net a
putStrLn $ "Assignment found marking " ++ show assigned putStrLn $ "Assignment found marking " ++ show assigned
rt <- checkSat $ checkTrapSat net assigned rt <- checkSat $ checkTrapSat net assigned
case rt of case rt of
Nothing -> do Nothing -> do
putStrLn "No trap found." putStrLn "No trap found."
return False return False
Just at -> do Just at -> do
let trap = trapFromAssignment at let trap = trapFromAssignment at
putStrLn $ "Trap found with places " ++ show trap putStrLn $ "Trap found with places " ++ show trap
checkSafetyProperty net f (trap:traps) checkSafetyProperty net f (trap:traps)
checkLivenessProperty :: PetriNet -> Formula -> IO Bool checkLivenessProperty :: PetriNet -> Formula -> IO Bool
checkLivenessProperty net f = do checkLivenessProperty net f = do
r <- checkSat $ checkTransitionInvariantSat net f r <- checkSat $ checkTransitionInvariantSat net f
case r of case r of
Nothing -> return True Nothing -> return True
Just m -> do Just a -> do
putStrLn "Assignment found:" let fired = firedTransitionsFromAssignment a
print m putStrLn $ "Assignment found firing " ++ show fired
return False rt <- checkSat $ checkSComponentSat net a
case rt of
Nothing -> do
putStrLn "No S-component found"
return False
Just at -> do
--let trap = trapFromAssignment at
putStrLn $ "S-component found: " ++ show at
-- checkLivenessProperty net f (trap:traps)
return False
checkProperty :: PetriNet -> Property -> IO Bool checkProperty :: PetriNet -> Property -> IO Bool
checkProperty net p = do checkProperty net p = do
......
...@@ -12,8 +12,7 @@ import Solver ...@@ -12,8 +12,7 @@ import Solver
import Solver.Formula import Solver.Formula
placeConstraints :: PetriNet -> ModelSI -> SBool placeConstraints :: PetriNet -> ModelSI -> SBool
placeConstraints net m = placeConstraints net m = bAnd $ map checkPlaceEquation $ places net
bAnd $ map checkPlaceEquation $ places net
where checkPlaceEquation p = where checkPlaceEquation p =
let incoming = map addTransition $ lpre net p let incoming = map addTransition $ lpre net p
outgoing = map addTransition $ lpost net p outgoing = map addTransition $ lpost net p
...@@ -21,20 +20,17 @@ placeConstraints net m = ...@@ -21,20 +20,17 @@ placeConstraints net m =
in pinit + sum incoming - sum outgoing .== (m M.! p) in pinit + sum incoming - sum outgoing .== (m M.! p)
addTransition (t,w) = literal w * (m M.! t) addTransition (t,w) = literal w * (m M.! t)
nonnegativityConstraints :: PetriNet -> ModelSI -> SBool nonnegativityConstraints :: ModelSI -> SBool
nonnegativityConstraints net m = nonnegativityConstraints m = bAnd $ map (.>= 0) $ M.elems m
bAnd $ map checkPT $ places net ++ transitions net
where checkPT x = (m M.! x) .>= 0
checkTraps :: [[String]] -> ModelSI -> SBool checkTraps :: [[String]] -> ModelSI -> SBool
checkTraps traps m = checkTraps traps m = bAnd $ map checkTrapDelta traps
bAnd $ map checkTrapDelta traps
where checkTrapDelta trap = sum (map (m M.!) trap) .>= 1 where checkTrapDelta trap = sum (map (m M.!) trap) .>= 1
checkStateEquation :: PetriNet -> Formula -> [[String]] -> ModelSI -> SBool checkStateEquation :: PetriNet -> Formula -> [[String]] -> ModelSI -> SBool
checkStateEquation net f traps m = checkStateEquation net f traps m =
placeConstraints net m &&& placeConstraints net m &&&
nonnegativityConstraints net m &&& nonnegativityConstraints m &&&
checkTraps traps m &&& checkTraps traps m &&&
evaluateFormula f m evaluateFormula f m
......
module Solver.TransitionInvariant module Solver.TransitionInvariant
(checkTransitionInvariant,checkTransitionInvariantSat) (checkTransitionInvariant,checkTransitionInvariantSat,
firedTransitionsFromAssignment)
where where
import Data.SBV import Data.SBV
...@@ -14,22 +15,27 @@ tInvariantConstraints :: PetriNet -> ModelSI -> SBool ...@@ -14,22 +15,27 @@ tInvariantConstraints :: PetriNet -> ModelSI -> SBool
tInvariantConstraints net m = tInvariantConstraints net m =
bAnd $ map checkTransitionEquation $ places net bAnd $ map checkTransitionEquation $ places net
where checkTransitionEquation p = where checkTransitionEquation p =
let incoming = map addPlace $ lpre net p let incoming = map addTransition $ lpre net p
outgoing = map addPlace $ lpost net p outgoing = map addTransition $ lpost net p
in sum outgoing - sum incoming .>= 0 in sum outgoing - sum incoming .>= 0
addPlace (t,w) = literal w * (m M.! t) addTransition (t,w) = literal w * (m M.! t)
nonnegativityConstraints :: PetriNet -> ModelSI -> SBool finalInvariantConstraints :: ModelSI -> SBool
nonnegativityConstraints net m = finalInvariantConstraints m = sum (M.elems m) .> 0
bAnd $ map checkT $ transitions net
where checkT t = (m M.! t) .>= 0 nonnegativityConstraints :: ModelSI -> SBool
nonnegativityConstraints m = bAnd $ map (.>= 0) $ M.elems m
checkTransitionInvariant :: PetriNet -> Formula -> ModelSI -> SBool checkTransitionInvariant :: PetriNet -> Formula -> ModelSI -> SBool
checkTransitionInvariant net f m = checkTransitionInvariant net f m =
tInvariantConstraints net m &&& tInvariantConstraints net m &&&
nonnegativityConstraints net m &&& nonnegativityConstraints m &&&
finalInvariantConstraints m &&&
evaluateFormula f m evaluateFormula f m
checkTransitionInvariantSat :: PetriNet -> Formula -> ([String], ModelSI -> SBool) checkTransitionInvariantSat :: PetriNet -> Formula -> ([String], ModelSI -> SBool)
checkTransitionInvariantSat net f = checkTransitionInvariantSat net f =
(transitions net, checkTransitionInvariant net f) (transitions net, checkTransitionInvariant net f)
firedTransitionsFromAssignment :: ModelI -> [String]
firedTransitionsFromAssignment a = M.keys $ M.filter ( > 0) a
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