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

Commit 2542d046 authored by Philipp Meyer's avatar Philipp Meyer
Browse files

Added option to simplify formulas used for invariants

parent 1371c6be
...@@ -275,14 +275,25 @@ checkLivenessProperty net f = do ...@@ -275,14 +275,25 @@ checkLivenessProperty net f = do
case r of case r of
(Nothing, cuts) -> do (Nothing, cuts) -> do
invariant <- opt optInvariant invariant <- opt optInvariant
if invariant then do if invariant then
r' <- checkSat $ checkLivenessInvariantSat net f cuts getLivenessInvariant net f cuts >>= printInvariant
printInvariant r'
else else
return Satisfied return Satisfied
(Just _, _) -> (Just _, _) ->
return Unknown return Unknown
getLivenessInvariant :: PetriNet -> Formula Transition -> [Cut] -> OptIO (Maybe [LivenessInvariant])
getLivenessInvariant net f cuts = do
verbosePut 2 $ "Number of cuts: " ++ show (length cuts)
simp <- opt optSimpFormula
let dnfCuts = generateCuts f cuts
verbosePut 2 $ "Number of disjuncts: " ++ show (length dnfCuts)
let simpCuts = if simp then simplifyCuts dnfCuts else dnfCuts
verbosePut 2 $ "Number of simplified disjuncts: " ++ show (length simpCuts)
rs <- mapM (checkSat . checkLivenessInvariantSat net) simpCuts
let added = map (Just . cutToLivenessInvariant) cuts
return $ sequence (rs ++ added)
checkLivenessProperty' :: PetriNet -> checkLivenessProperty' :: PetriNet ->
Formula Transition -> [Cut] -> OptIO (Maybe FiringVector, [Cut]) Formula Transition -> [Cut] -> OptIO (Maybe FiringVector, [Cut])
checkLivenessProperty' net f cuts = do checkLivenessProperty' net f cuts = do
......
...@@ -43,6 +43,7 @@ data Options = Options { inputFormat :: InputFormat ...@@ -43,6 +43,7 @@ data Options = Options { inputFormat :: InputFormat
, optProperties :: [ImplicitProperty] , optProperties :: [ImplicitProperty]
, optTransformations :: [NetTransformation] , optTransformations :: [NetTransformation]
, optRefine :: Bool , optRefine :: Bool
, optSimpFormula :: Bool
, optRefinementType :: RefinementType , optRefinementType :: RefinementType
, optInvariant :: Bool , optInvariant :: Bool
, optOutput :: Maybe String , optOutput :: Maybe String
...@@ -59,6 +60,7 @@ startOptions = Options { inputFormat = PNET ...@@ -59,6 +60,7 @@ startOptions = Options { inputFormat = PNET
, optProperties = [] , optProperties = []
, optTransformations = [] , optTransformations = []
, optRefine = True , optRefine = True
, optSimpFormula = True
, optRefinementType = SComponentRefinement , optRefinementType = SComponentRefinement
, optInvariant = False , optInvariant = False
, optOutput = Nothing , optOutput = Nothing
...@@ -216,6 +218,12 @@ options = ...@@ -216,6 +218,12 @@ options =
})) }))
"Do not use the properties given in the input file" "Do not use the properties given in the input file"
, Option "" ["no-simp"]
(NoArg (\opt -> Right opt {
optSimpFormula = False
}))
"Do not simplify formula for invariant generation"
, Option "v" ["verbose"] , Option "v" ["verbose"]
(NoArg (\opt -> Right opt { optVerbosity = optVerbosity opt + 1 })) (NoArg (\opt -> Right opt { optVerbosity = optVerbosity opt + 1 }))
"Increase verbosity (may be specified more than once)" "Increase verbosity (may be specified more than once)"
......
module Solver.LivenessInvariant ( module Solver.LivenessInvariant (
checkLivenessInvariantSat checkLivenessInvariantSat
, LivenessInvariant , LivenessInvariant
, generateCuts
, simplifyCuts
, cutToLivenessInvariant
) where ) where
import Data.SBV import Data.SBV
...@@ -14,8 +17,8 @@ import PetriNet ...@@ -14,8 +17,8 @@ import PetriNet
import qualified Data.Set as S import qualified Data.Set as S
data LivenessInvariant = data LivenessInvariant =
RankingFunction (String, SimpleCut, Vector Place) RankingFunction (SimpleCut, Vector Place)
| ComponentCut (String, SimpleCut, [Trap]) | ComponentCut (SimpleCut, [Trap])
showSimpleCuts :: SimpleCut -> Bool -> String showSimpleCuts :: SimpleCut -> Bool -> String
showSimpleCuts cs inv = intercalate " ∧ " (showSimpleCut cs) showSimpleCuts cs inv = intercalate " ∧ " (showSimpleCut cs)
...@@ -33,26 +36,40 @@ showSimpleCuts cs inv = intercalate " ∧ " (showSimpleCut cs) ...@@ -33,26 +36,40 @@ showSimpleCuts cs inv = intercalate " ∧ " (showSimpleCut cs)
intercalate " ∧ " (map (\t -> show t ++ " ∉ σ") (S.toList ts)) intercalate " ∧ " (map (\t -> show t ++ " ∉ σ") (S.toList ts))
instance Show LivenessInvariant where instance Show LivenessInvariant where
show (RankingFunction (n, cs, xs)) = n ++ show (RankingFunction (cs, xs)) =
" [" ++ showSimpleCuts cs True ++ "]: " ++ "[" ++ showSimpleCuts cs True ++ "]: " ++
intercalate " + " (map showWeighted (items xs)) intercalate " + " (map showWeighted (items xs))
show (ComponentCut (n, cs, ps)) = n ++ show (ComponentCut (cs, ps)) =
" [" ++ showSimpleCuts cs False ++ "]: " ++ "[" ++ showSimpleCuts cs False ++ "]: " ++
show ps show ps
type SimpleCut = (S.Set Transition, [S.Set Transition]) type SimpleCut = (S.Set Transition, [S.Set Transition])
type NamedCut = (String, (S.Set Transition, [(String, S.Set Transition)])) type NamedCut = (S.Set Transition, [(String, S.Set Transition)])
placeName :: String -> Place -> String placeName :: Place -> String
placeName n p = n ++ "@p" ++ show p placeName p = "@p" ++ show p
generateCuts :: Formula Transition -> [Cut] -> [NamedCut] generateCuts :: Formula Transition -> [Cut] -> [SimpleCut]
generateCuts f cuts = generateCuts f cuts =
let dnfCuts = foldl combine [formulaToCut f] (map cutToSimpleDNFCuts cuts) foldl combine [formulaToCut f] (map cutToSimpleDNFCuts cuts)
in zipWith nameCut (numPref "@r") $ removeWith isMoreGeneralCut dnfCuts
where where
nameCut n (c0, cs) = (n, (c0, numPref "@comp" `zip` cs)) combine cs1 cs2 = [ (c1c0 `S.union` c2c0, c1cs ++ c2cs)
combine cs1 cs2 = concat [ combineCuts c1 c2 | c1 <- cs1, c2 <- cs2 ] | (c1c0, c1cs) <- cs1, (c2c0, c2cs) <- cs2 ]
simplifyCuts :: [SimpleCut] -> [SimpleCut]
simplifyCuts = removeWith isMoreGeneralCut . concatMap simplifyCut
simplifyCut :: SimpleCut -> [SimpleCut]
simplifyCut (c0, cs) =
let remove b a = a `S.difference` b
cs' = removeWith S.isSubsetOf $ map (remove c0) cs
in if any S.null cs' then
[]
else
[(c0, cs')]
nameCut :: SimpleCut -> NamedCut
nameCut (c0, cs) = (c0, numPref "@comp" `zip` cs)
removeWith :: (a -> a -> Bool) -> [a] -> [a] removeWith :: (a -> a -> Bool) -> [a] -> [a]
removeWith f = removeCuts' [] removeWith f = removeCuts' []
...@@ -61,27 +78,15 @@ removeWith f = removeCuts' [] ...@@ -61,27 +78,15 @@ removeWith f = removeCuts' []
removeCuts' acc (x:xs) = removeCuts' (x : cutFilter x acc) (cutFilter x xs) removeCuts' acc (x:xs) = removeCuts' (x : cutFilter x acc) (cutFilter x xs)
cutFilter cut = filter (not . f cut) cutFilter cut = filter (not . f cut)
combineCuts :: SimpleCut -> SimpleCut -> [SimpleCut]
combineCuts (c1c0, c1cs) (c2c0, c2cs) =
let remove b a = a `S.difference` b
c0 = c1c0 `S.union` c2c0
cs = removeWith S.isSubsetOf $ map (remove c0) $ c1cs ++ c2cs
in if any S.null cs then
[]
else
[(c0, cs)]
isMoreGeneralCut :: SimpleCut -> SimpleCut -> Bool isMoreGeneralCut :: SimpleCut -> SimpleCut -> Bool
isMoreGeneralCut (c1c0, c1cs) (c2c0, c2cs) = isMoreGeneralCut (c1c0, c1cs) (c2c0, c2cs) =
c1c0 `S.isSubsetOf` c2c0 && all (\c1 -> any (`S.isSubsetOf` c1) c2cs) c1cs c1c0 `S.isSubsetOf` c2c0 && all (\c1 -> any (`S.isSubsetOf` c1) c2cs) c1cs
varNames :: PetriNet -> [NamedCut] -> [String] cutNames :: PetriNet -> NamedCut -> [String]
varNames net = concatMap cutNames cutNames net (_, c) =
where ["@yone", "@comp0"] ++
cutNames (n, (_, c)) = map placeName (places net) ++
[n ++ "@yone"] ++ [n ++ "@comp0"] ++ map fst c
map (placeName n) (places net) ++
map (\(n', _) -> n ++ n') c
cutToSimpleDNFCuts :: Cut -> [SimpleCut] cutToSimpleDNFCuts :: Cut -> [SimpleCut]
cutToSimpleDNFCuts (ts, u) = (S.empty, [S.fromList u]) : map (\(_, t) -> (S.fromList t, [])) ts cutToSimpleDNFCuts (ts, u) = (S.empty, [S.fromList u]) : map (\(_, t) -> (S.fromList t, [])) ts
...@@ -90,7 +95,7 @@ cutToSimpleCNFCut :: Cut -> SimpleCut ...@@ -90,7 +95,7 @@ cutToSimpleCNFCut :: Cut -> SimpleCut
cutToSimpleCNFCut (ts, u) = (S.fromList u, map (\(_, t) -> S.fromList t) ts) cutToSimpleCNFCut (ts, u) = (S.fromList u, map (\(_, t) -> S.fromList t) ts)
toSimpleCut :: NamedCut -> SimpleCut toSimpleCut :: NamedCut -> SimpleCut
toSimpleCut (_, (c0, ncs)) = (c0, map snd ncs) toSimpleCut (c0, ncs) = (c0, map snd ncs)
formulaToCut :: Formula Transition -> SimpleCut formulaToCut :: Formula Transition -> SimpleCut
formulaToCut = transformF formulaToCut = transformF
...@@ -117,50 +122,43 @@ formulaToCut = transformF ...@@ -117,50 +122,43 @@ formulaToCut = transformF
transformTerm t = transformTerm t =
error $ "term not supported for invariant: " ++ show t error $ "term not supported for invariant: " ++ show t
checkCut :: PetriNet -> SIMap String -> NamedCut -> SBool checkLivenessInvariant :: PetriNet -> NamedCut -> SIMap String -> SBool
checkCut net m (n, (comp0, comps)) = checkLivenessInvariant net (comp0, comps) m =
bAnd (map checkTransition (transitions net)) &&& bAnd (map checkTransition (transitions net)) &&&
val m (n ++ "@yone") + sum (map addComp comps) .> 0 &&& val m "@yone" + sum (map addComp comps) .> 0 &&&
bAnd (map (checkNonNegativity . placeName n) (places net)) &&& bAnd (map (checkNonNegativity . placeName) (places net)) &&&
checkNonNegativity (n ++ "@yone") &&& checkNonNegativity "@yone" &&&
checkNonNegativity (n ++ "@comp0") &&& checkNonNegativity "@comp0" &&&
bAnd (map (\(n', _) -> checkNonNegativity (n ++ n')) comps) bAnd (map (\(n, _) -> checkNonNegativity n) comps)
where checkTransition t = where checkTransition t =
let incoming = map addPlace $ lpre net t let incoming = map addPlace $ lpre net t
outgoing = map addPlace $ lpost net t outgoing = map addPlace $ lpost net t
yone = val m (n ++ "@yone") yone = val m "@yone"
addCompT (n', ts) = if t `S.member` ts then val m (n ++ n') else 0 addCompT (n, ts) = if t `S.member` ts then val m n else 0
comp0Val = addCompT ("@comp0", comp0) comp0Val = addCompT ("@comp0", comp0)
compsVal = sum $ map addCompT comps compsVal = sum $ map addCompT comps
in sum outgoing - sum incoming + yone + compsVal .<= comp0Val in sum outgoing - sum incoming + yone + compsVal .<= comp0Val
addPlace (p,w) = literal w * val m (placeName n p) addPlace (p,w) = literal w * val m (placeName p)
addComp (n', _) = val m (n ++ n') addComp (n, _) = val m n
checkNonNegativity x = val m x .>= 0 checkNonNegativity x = val m x .>= 0
checkLivenessInvariant :: PetriNet -> [NamedCut] -> SIMap String -> SBool checkLivenessInvariantSat :: PetriNet -> SimpleCut -> ConstraintProblem Integer LivenessInvariant
checkLivenessInvariant net cuts m = checkLivenessInvariantSat net cut =
bAnd (map (checkCut net m) cuts) let namedCut = nameCut cut
names = cutNames net namedCut
-- TODO: split up into many smaller sat problems
checkLivenessInvariantSat :: PetriNet -> Formula Transition -> [Cut] ->
ConstraintProblem Integer [LivenessInvariant]
checkLivenessInvariantSat net f cuts =
let namedCuts = generateCuts f cuts
names = varNames net namedCuts
myVarMap fvm = M.fromList $ names `zip` fmap fvm names myVarMap fvm = M.fromList $ names `zip` fmap fvm names
in ("liveness invariant constraints", "liveness invariant", in ("liveness invariant constraints", "liveness invariant",
names, names,
checkLivenessInvariant net namedCuts . myVarMap, checkLivenessInvariant net namedCut . myVarMap,
getLivenessInvariant net cuts namedCuts . myVarMap) getLivenessInvariant net namedCut . myVarMap)
getLivenessInvariant :: PetriNet -> [Cut] -> [NamedCut] -> IMap String -> cutToLivenessInvariant :: Cut -> LivenessInvariant
[LivenessInvariant] cutToLivenessInvariant c = ComponentCut (cutToSimpleCNFCut c, map fst (fst c))
getLivenessInvariant net cuts namedCuts y =
map rankCut namedCuts ++ zipWith compCut (numPref "@cut") cuts getLivenessInvariant :: PetriNet -> NamedCut -> IMap String -> LivenessInvariant
where rankCut cut@(n, _) = RankingFunction getLivenessInvariant net cut y =
(n, toSimpleCut cut, RankingFunction
buildVector (map (\p -> (p, val y (placeName n p))) (places net))) (toSimpleCut cut,
compCut n c = ComponentCut buildVector (map (\p -> (p, val y (placeName p))) (places net)))
(n, cutToSimpleCNFCut c, map fst (fst c))
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