Notice to GitKraken users: A vulnerability has been found in the SSH key generation of GitKraken versions 7.6.0 to 8.0.0 (https://www.gitkraken.com/blog/weak-ssh-key-fix). If you use GitKraken and have generated a SSH key using one of these versions, please remove it both from your local workstation and from your LRZ GitLab profile.

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