Currently job artifacts in CI/CD pipelines on LRZ GitLab never expire. Starting from Wed 26.1.2022 the default expiration time will be 30 days (GitLab default). Currently existing artifacts in already completed jobs will not be affected by the change. The latest artifacts for all jobs in the latest successful pipelines will be kept. More information: https://gitlab.lrz.de/help/user/admin_area/settings/continuous_integration.html#default-artifacts-expiration

Commit 2dd17b45 authored by Philipp Meyer's avatar Philipp Meyer
Browse files

Added trap refinement

parent 9a38c04e
......@@ -9,12 +9,25 @@ import Solver
checkProperty :: PetriNet -> Property -> IO ()
checkProperty net p = do
r <- checkPropertyConstraintsSat net p
r <- checkPropertyConstraintsSat net p []
case r of
Nothing -> putStrLn "Property satisfied"
Just m -> putStrLn "Property not satisfied, model:" >> print m
Just m -> putStrLn "Property may not satisfied, model:" >> print m
--checkPropertyWithTrapRefinement :: PetriNet -> Property -> IO ()
checkPropertyWithTrapRefinement :: PetriNet -> Property -> [[String]] -> IO ()
checkPropertyWithTrapRefinement net p traps = do
r <- checkPropertyConstraintsSat net p traps
case r of
Nothing -> putStrLn "Property satisfied"
Just m -> do
putStrLn "Property not satisfied, model:" >> print m
r2 <- checkTrapConstraintsSat net m
case r2 of
Nothing -> putStrLn "No trap found"
Just m2 -> do
let trap = map fst $ filter snd m2
putStrLn "Trap found:" >> print trap
checkPropertyWithTrapRefinement net p (trap:traps)
main :: IO ()
main = do
......@@ -26,6 +39,6 @@ main = do
putStrLn $ "Analyzing " ++ showName net
mapM_ (\p -> do
putStrLn $ "Checking " ++ show p
checkProperty net p
checkPropertyWithTrapRefinement net p []
) properties
......@@ -11,7 +11,7 @@ import Property
type ModelSI = M.Map String SInteger
type ModelSB = M.Map String SBool
type ModelI = M.Map String Integer
type ModelB = M.Map String Bool
--type ModelB = M.Map String Bool
type ModelLI = [(String, Integer)]
type ModelLB = [(String, Bool)]
......@@ -73,21 +73,26 @@ checkTrapConstraints m net =
checkTrapMarked :: ModelSB -> PetriNet -> SBool
checkTrapMarked m net =
let marked = map fst $ filter (( > 0) . snd) $ (initials net)
let marked = map fst $ filter (( > 0) . snd) $ initials net
in bOr $ map (m M.!) marked
checkTrapUnassigned :: ModelSB -> ModelI -> SBool
checkTrapUnassigned mt ma =
let assigned = map fst $ filter (( > 0) . snd) $ M.toList ma
checkTrapUnassigned :: ModelSB -> ModelI -> PetriNet -> SBool
checkTrapUnassigned mt ma net =
let assigned = filter (( > 0) . (ma M.!)) $ places net
in bAnd $ map (bnot . (mt M.!)) assigned
checkAllTrapConstraints :: ModelSB -> ModelI -> PetriNet -> SBool
checkAllTrapConstraints mt ma net =
let tc = checkTrapConstraints mt net
tm = checkTrapMarked mt net
tu = checkTrapUnassigned mt ma
tu = checkTrapUnassigned mt ma net
in tc &&& tm &&& tu
checkTrapDeltaConstraints :: ModelSI -> [String] -> SBool
checkTrapDeltaConstraints m trap =
let tokens = map (m M.!) trap
in sum tokens .>= 1
checkPropertyConstraints :: ModelSI -> PetriNet -> Property -> SBool
checkPropertyConstraints m net p =
let netConstraints = case ptype p of
......@@ -97,6 +102,13 @@ checkPropertyConstraints m net p =
propertyConstraint = evaluateFormula m (pformula p)
in netConstraints &&& nonnegativityConstraint &&& propertyConstraint
checkPropertyPlusTrapConstraints :: ModelSI -> PetriNet -> Property ->
[[String]] -> SBool
checkPropertyPlusTrapConstraints m net p traps =
let propConstraints = checkPropertyConstraints m net p
trapConstraints = map (checkTrapDeltaConstraints m) traps
in propConstraints &&& bAnd trapConstraints
symConstraints :: SymWord a => [String] -> ([(String, SBV a)] -> SBool) ->
Symbolic SBool
symConstraints vars constraint = do
......@@ -114,15 +126,15 @@ checkSat vars constraint = do
result <- sat $ symConstraints vars constraint
return $ rebuildModel vars $ getModel result
checkPropertyConstraintsSat :: PetriNet -> Property -> IO (Maybe ModelLI)
checkPropertyConstraintsSat net p =
checkPropertyConstraintsSat :: PetriNet -> Property -> [[String]] -> IO (Maybe ModelLI)
checkPropertyConstraintsSat net p traps =
let vars = places net ++ transitions net
cons m = checkPropertyConstraints (M.fromList m) net p
cons m = checkPropertyPlusTrapConstraints (M.fromList m) net p traps
in checkSat vars cons
checkTrapConstraintsSat :: PetriNet -> ModelI -> IO (Maybe ModelLB)
checkTrapConstraintsSat :: PetriNet -> ModelLI -> IO (Maybe ModelLB)
checkTrapConstraintsSat net ma =
let vars = transitions net
cons m = checkAllTrapConstraints (M.fromList m) ma net
let vars = places net
cons m = checkAllTrapConstraints (M.fromList m) (M.fromList ma) net
in checkSat vars cons
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