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 by Philipp Meyer

### 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!