2.12.2021, 9:00 - 11:00: Due to updates GitLab may be unavailable for some minutes between 09:00 and 11:00.

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

Extended solver logic for safety and liveness properties

parent e6b6495e
...@@ -8,8 +8,9 @@ import PetriNet ...@@ -8,8 +8,9 @@ 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
...@@ -35,11 +36,19 @@ checkLivenessProperty net f = do ...@@ -35,11 +36,19 @@ 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
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 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