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

Added refinement via s-components for t-invariants

parent d6b41fdc
......@@ -3,6 +3,7 @@ module Main where
import System.Environment (getArgs)
import System.Exit
import qualified Data.Map as M
import Parser (parseFile)
import PetriNet
import Property
......@@ -30,31 +31,31 @@ checkSafetyProperty net f traps = do
putStrLn $ "Trap found with places " ++ show trap
checkSafetyProperty net f (trap:traps)
checkLivenessProperty :: PetriNet -> Formula -> IO Bool
checkLivenessProperty net f = do
r <- checkSat $ checkTransitionInvariantSat net f
checkLivenessProperty :: PetriNet -> Formula -> [([String],[String])] -> IO Bool
checkLivenessProperty net f strans = do
r <- checkSat $ checkTransitionInvariantSat net f strans
case r of
Nothing -> return True
Just a -> do
let fired = firedTransitionsFromAssignment a
Just ax -> do
let fired = firedTransitionsFromAssignment ax
putStrLn $ "Assignment found firing " ++ show fired
rt <- checkSat $ checkSComponentSat net a
rt <- checkSat $ checkSComponentSat net ax
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
Just as -> do
let sOutIn = getSComponentInOut net ax as
putStrLn $ "S-component found: " ++ show (M.filter (> 0) as)
putStrLn $ "Out/In: " ++ show sOutIn
checkLivenessProperty net f (sOutIn:strans)
checkProperty :: PetriNet -> Property -> IO Bool
checkProperty net p = do
putStrLn $ "\nChecking " ++ showPropertyName p
r <- case ptype p of
Safety -> checkSafetyProperty net (pformula p) []
Liveness -> checkLivenessProperty net (pformula p)
Liveness -> checkLivenessProperty net (pformula p) []
putStrLn $ if r then "Property is satisfied."
else "Property may not be satisfied."
return r
......
module Solver.SComponent
(checkSComponent,checkSComponentSat)
(checkSComponent,checkSComponentSat,
getSComponentInOut)
where
import Data.SBV
import qualified Data.Map as M
import Data.List (partition)
import PetriNet
import Solver
......@@ -11,9 +13,15 @@ import Solver
mElem :: ModelSI -> String -> SBool
mElem m x = (m M.! x) .== 1
mElemI :: ModelI -> String -> Bool
mElemI m x = (m M.! x) == 1
mNotElem :: ModelSI -> String -> SBool
mNotElem m x = (m M.! x) .== 0
mNotElemI :: ModelI -> String -> Bool
mNotElemI m x = (m M.! x) == 0
countElem :: ModelSI -> [String] -> SInteger
countElem m xs = sum $ map (m M.!) xs
......@@ -47,12 +55,12 @@ checkNotEmpty :: [String] -> ModelSI -> SBool
checkNotEmpty fired m = countElem m (map prime fired) .> 0
checkClosed :: PetriNet -> ModelI -> ModelSI -> SBool
checkClosed net a m =
checkClosed net ax m =
bAnd (map checkPlaceClosed (places net))
where checkPlaceClosed p = mElem m p ==>
bAnd (map checkTransition
[(t,t') | t <- pre net p, t' <- post net p,
a M.! t > 0 , a M.! t' > 0 ])
ax M.! t > 0 , ax M.! t' > 0 ])
checkTransition (t,t') =
mElem m (prime t) &&& mElem m t' ==> mElem m (prime t')
......@@ -65,17 +73,22 @@ checkBinary :: ModelSI -> SBool
checkBinary m = bAnd $ map (\x -> x .== 0 ||| x .== 1) $ M.elems m
checkSComponent :: PetriNet -> [String] -> ModelI -> ModelSI -> SBool
checkSComponent net fired a m =
checkSComponent net fired ax m =
checkPrePostPlaces net m &&&
checkPrePostTransitions net m &&&
checkSubsetTransitions fired m &&&
checkNotEmpty fired m &&&
checkClosed net a m &&&
checkClosed net ax m &&&
checkTokens net m &&&
checkBinary m
checkSComponentSat :: PetriNet -> ModelI -> ([String], ModelSI -> SBool)
checkSComponentSat net a =
let fired = M.keys $ M.filter (> 0) a
checkSComponentSat net ax =
let fired = M.keys $ M.filter (> 0) ax
in (places net ++ transitions net ++ map prime fired,
checkSComponent net fired a)
checkSComponent net fired ax)
getSComponentInOut :: PetriNet -> ModelI -> ModelI -> ([String], [String])
getSComponentInOut net ax as =
partition (mElemI ax) $ filter (mElemI as) (transitions net)
......@@ -26,16 +26,25 @@ finalInvariantConstraints m = sum (M.elems m) .> 0
nonnegativityConstraints :: ModelSI -> SBool
nonnegativityConstraints m = bAnd $ map (.>= 0) $ M.elems m
checkTransitionInvariant :: PetriNet -> Formula -> ModelSI -> SBool
checkTransitionInvariant net f m =
checkSComponentTransitions :: [([String],[String])] -> ModelSI -> SBool
checkSComponentTransitions strans m = bAnd $ map checkInOut strans
where checkInOut (sOut,sIn) =
bAnd (map (\t -> m M.! t .> 0) sOut) ==>
bOr (map (\t -> m M.! t .> 0) sIn)
checkTransitionInvariant :: PetriNet -> Formula -> [([String],[String])] ->
ModelSI -> SBool
checkTransitionInvariant net f strans m =
tInvariantConstraints net m &&&
nonnegativityConstraints m &&&
finalInvariantConstraints m &&&
checkSComponentTransitions strans m &&&
evaluateFormula f m
checkTransitionInvariantSat :: PetriNet -> Formula -> ([String], ModelSI -> SBool)
checkTransitionInvariantSat net f =
(transitions net, checkTransitionInvariant net f)
checkTransitionInvariantSat :: PetriNet -> Formula -> [([String],[String])] ->
([String], ModelSI -> SBool)
checkTransitionInvariantSat net f strans =
(transitions net, checkTransitionInvariant net f strans)
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