added option to check reachability of non-consensus states

src/Main.hs

@@ -38,6 +38,7 @@ import Solver.SComponentWithCut
 import Solver.SComponent
 import Solver.Simplifier
 import Solver.UniqueTerminalMarking
+import Solver.NonConsensusState
 --import Solver.Interpolant
 --import Solver.CommFreeReachability
 
@@ -165,7 +166,7 @@ transformNet (net, props) TerminationByReachability =
                         (places net))
             -- TODO: map existing liveness properties
         in  (makePetriNetWithTrans (name net) ps ts is
-                (ghostTransitions net) (fixedTraps net) (fixedSiphons net), prop : props)
+                (ghostTransitions net) (fixedTraps net) (fixedSiphons net) (yesStates net) (noStates net), prop : props)
 transformNet (net, props) ValidateIdentifiers =
         (renamePetriNetPlacesAndTransitions validateId net,
          map (renameProperty validateId) props)
@@ -217,6 +218,8 @@ makeImplicitProperty _ StructCommunicationFree =
         Property "communication free" $ Structural CommunicationFree
 makeImplicitProperty _ UniqueTerminalMarking =
         Property "unique terminal marking" $ Constraint UniqueTerminalMarkingConstraint
+makeImplicitProperty _ NonConsensusState =
+        Property "non-consensus state" $ Constraint NonConsensusStateConstraint
 
 checkProperty :: PetriNet -> Property -> OptIO PropResult
 checkProperty net p = do
@@ -444,6 +447,7 @@ checkConstraintProperty :: PetriNet -> ConstraintProperty -> OptIO PropResult
 checkConstraintProperty net cp =
         case cp of
             UniqueTerminalMarkingConstraint -> checkUniqueTerminalMarkingProperty net
+            NonConsensusStateConstraint -> checkNonConsensusStateProperty net
 
 checkUniqueTerminalMarkingProperty :: PetriNet -> OptIO PropResult
 checkUniqueTerminalMarkingProperty net = do
@@ -459,29 +463,66 @@ checkUniqueTerminalMarkingProperty' net traps siphons = do
         r <- checkSat $ checkUniqueTerminalMarkingSat net traps siphons
         case r of
             Nothing -> return (Nothing, traps, siphons)
-            Just m -> do
+            Just c -> do
                 refine <- opt optRefinementType
                 if isJust refine then
-                    refineUniqueTerminalMarkingProperty net traps siphons m
+                    refineUniqueTerminalMarkingProperty net traps siphons c
                 else
-                    return (Just m, traps, siphons)
+                    return (Just c, traps, siphons)
 
 refineUniqueTerminalMarkingProperty :: PetriNet ->
         [Trap] -> [Siphon] -> UniqueTerminalMarkingCounterExample ->
         OptIO (Maybe UniqueTerminalMarkingCounterExample, [Trap], [Siphon])
-refineUniqueTerminalMarkingProperty net traps siphons m@(m0, m1, m2, x1, x2) = do
-        r1 <- checkSatMin $ checkUnmarkedTrapSat net m0 m1 m2 x1 x2
+refineUniqueTerminalMarkingProperty net traps siphons c@(m0, m1, m2, x1, x2) = do
+        r1 <- checkSatMin $ Solver.UniqueTerminalMarking.checkUnmarkedTrapSat net m0 m1 m2 x1 x2
         case r1 of
             Nothing -> do
-                r2 <- checkSatMin $ checkUnmarkedSiphonSat net m0 m1 m2 x1 x2
+                r2 <- checkSatMin $ Solver.UniqueTerminalMarking.checkUnmarkedSiphonSat net m0 m1 m2 x1 x2
                 case r2 of
                     Nothing ->
-                        return (Just m, traps, siphons)
+                        return (Just c, traps, siphons)
                     Just siphon ->
                         checkUniqueTerminalMarkingProperty' net traps (siphon:siphons)
             Just trap ->
                 checkUniqueTerminalMarkingProperty' net (trap:traps) siphons
 
+checkNonConsensusStateProperty :: PetriNet -> OptIO PropResult
+checkNonConsensusStateProperty net = do
+        r <- checkNonConsensusStateProperty' net (fixedTraps net) (fixedSiphons net)
+        case r of
+            (Nothing, _, _) -> return Satisfied
+            (Just _, _, _) -> return Unknown
+
+checkNonConsensusStateProperty' :: PetriNet ->
+        [Trap] -> [Siphon] ->
+        OptIO (Maybe NonConsensusStateCounterExample, [Trap], [Siphon])
+checkNonConsensusStateProperty' net traps siphons = do
+        r <- checkSat $ checkNonConsensusStateSat net traps siphons
+        case r of
+            Nothing -> return (Nothing, traps, siphons)
+            Just c -> do
+                refine <- opt optRefinementType
+                if isJust refine then
+                    refineNonConsensusStateProperty net traps siphons c
+                else
+                    return (Just c, traps, siphons)
+
+refineNonConsensusStateProperty :: PetriNet ->
+        [Trap] -> [Siphon] -> NonConsensusStateCounterExample ->
+        OptIO (Maybe NonConsensusStateCounterExample, [Trap], [Siphon])
+refineNonConsensusStateProperty net traps siphons c@(m0, m, x) = do
+        r1 <- checkSatMin $ Solver.NonConsensusState.checkUnmarkedTrapSat net m0 m x
+        case r1 of
+            Nothing -> do
+                r2 <- checkSatMin $ Solver.NonConsensusState.checkUnmarkedSiphonSat net m0 m x
+                case r2 of
+                    Nothing ->
+                        return (Just c, traps, siphons)
+                    Just siphon ->
+                        checkNonConsensusStateProperty' net traps (siphon:siphons)
+            Just trap ->
+                checkNonConsensusStateProperty' net (trap:traps) siphons
+
 main :: IO ()
 main = do
         putStrLn "SLAPnet - Safety and Liveness Analysis of Petri Nets with SMT solvers\n"

src/Options.hs

@@ -32,6 +32,7 @@ data ImplicitProperty = Termination
                       | StructFinalPlace
                       | StructCommunicationFree
                       | UniqueTerminalMarking
+                      | NonConsensusState
                       deriving (Show,Read)
 
 data RefinementType = TrapRefinement | SComponentRefinement | SComponentWithCutRefinement
@@ -184,6 +185,12 @@ options =
                }))
         "Prove that all markings of the net have a unique terminal marking"
 
+        , Option "" ["non-consensus-state"]
+        (NoArg (\opt -> Right opt {
+                   optProperties = NonConsensusState : optProperties opt
+               }))
+        "Prove that no non-consensus terminal state is reachable from an initial marking"
+
         , Option "i" ["invariant"]
         (NoArg (\opt -> Right opt { optInvariant = True }))
         "Generate an invariant"

src/Parser/LOLA.hs

@@ -57,7 +57,7 @@ net = do
         initial <- option [] markingList
         _ <- semi
         ts <- many1 transition
-        return $ makePetriNetWithTransFromStrings "" ps ts initial [] [] []
+        return $ makePetriNetWithTransFromStrings "" ps ts initial [] [] [] [] []
 
 placeLists :: Parser [String]
 placeLists =

src/Parser/MIST.hs

@@ -58,7 +58,7 @@ net = do
         reserved "init"
         (is,initTrans) <- initial
         return $ makePetriNetWithTransFromStrings "" ps (initTrans ++ ts) is
-                 (map fst initTrans) [] []
+                 (map fst initTrans) [] [] [] []
 
 prop :: Parser Property
 prop = do

src/Parser/PNET.hs

@@ -87,6 +87,12 @@ trap = reserved "trap" *> identList
 siphon :: Parser [String]
 siphon = reserved "siphon" *> identList
 
+yesStates :: Parser [String]
+yesStates = reserved "yes" *> identList
+
+noStates :: Parser [String]
+noStates = reserved "no" *> identList
+
 arc :: Parser [(String,String,Integer)]
 arc = do
         lhs <- identList
@@ -108,7 +114,8 @@ arcs = do
 
 data Statement = Places [String] | Transitions [String] |
                  Arcs [(String,String,Integer)] | Initial [(String,Integer)] |
-                 TrapStatement [String] | SiphonStatement [String]
+                 TrapStatement [String] | SiphonStatement [String] |
+                 YesStatement [String] | NoStatement [String]
 
 statement :: Parser Statement
 statement = Places <$> places <|>
@@ -116,7 +123,9 @@ statement = Places <$> places <|>
             Arcs <$> arcs <|>
             Initial <$> initial <|>
             TrapStatement <$> trap <|>
-            SiphonStatement <$> siphon
+            SiphonStatement <$> siphon <|>
+            YesStatement <$> yesStates <|>
+            NoStatement <$> noStates
 
 petriNet :: Parser PetriNet
 petriNet = do
@@ -124,16 +133,18 @@ petriNet = do
             reserved "net"
             name <- option "" ident
             statements <- braces (many statement)
-            let (p,t,a,i,traps,siphons) = foldl splitStatement ([],[],[],[],[],[]) statements
-            return $ makePetriNetFromStrings name p t a i [] traps siphons
+            let (p,t,a,i,traps,siphons,yesStates,noStates) = foldl splitStatement ([],[],[],[],[],[],[],[]) statements
+            return $ makePetriNetFromStrings name p t a i [] traps siphons yesStates noStates
         where
-            splitStatement (ps,ts,as,is,traps,siphons) stmnt = case stmnt of
-                  Places p -> (p ++ ps,ts,as,is,traps,siphons)
-                  Transitions t -> (ps,t ++ ts,as,is,traps,siphons)
-                  Arcs a -> (ps,ts,a ++ as,is,traps,siphons)
-                  Initial i -> (ps,ts,as,i ++ is,traps,siphons)
-                  TrapStatement trap -> (ps,ts,as,is,trap:traps,siphons)
-                  SiphonStatement siphon -> (ps,ts,as,is,traps,siphon:siphons)
+            splitStatement (ps,ts,as,is,traps,siphons,ys,ns) stmnt = case stmnt of
+                  Places p -> (p ++ ps,ts,as,is,traps,siphons,ys,ns)
+                  Transitions t -> (ps,t ++ ts,as,is,traps,siphons,ys,ns)
+                  Arcs a -> (ps,ts,a ++ as,is,traps,siphons,ys,ns)
+                  Initial i -> (ps,ts,as,i ++ is,traps,siphons,ys,ns)
+                  TrapStatement trap -> (ps,ts,as,is,trap:traps,siphons,ys,ns)
+                  SiphonStatement siphon -> (ps,ts,as,is,traps,siphon:siphons,ys,ns)
+                  YesStatement y -> (ps,ts,as,is,traps,siphons,y ++ ys,ns)
+                  NoStatement n -> (ps,ts,as,is,traps,siphons,ys,n ++ ns)
 
 binary :: String -> (a -> a -> a) -> Assoc -> Operator String () Identity a
 binary name fun = Infix  ( reservedOp name *> return fun )

src/Parser/TPN.hs

@@ -77,7 +77,7 @@ petriNet = do
         ts <- many transition
         let places = [ p | (p,_) <- ps ]
             initial = [ (p,i) | (p,Just i) <- ps ]
-        return $ makePetriNetWithTransFromStrings "" places ts initial [] [] []
+        return $ makePetriNetWithTransFromStrings "" places ts initial [] [] [] [] []
 
 parseContent :: Parser (PetriNet,[Property])
 parseContent = do

src/PetriNet.hs

@@ -8,6 +8,7 @@ module PetriNet
      name,showNetName,places,transitions,
      initialMarking,initial,initials,linitials,
      pre,lpre,post,lpost,mpre,mpost,context,ghostTransitions,fixedTraps,fixedSiphons,
+     yesStates,noStates,
      makePetriNet,makePetriNetWithTrans,
      makePetriNetFromStrings,makePetriNetWithTransFromStrings,Trap,Siphon,Cut,
      constructCut,SimpleCut,Invariant(..))
@@ -81,7 +82,9 @@ data PetriNet = PetriNet {
         initialMarking :: Marking,
         ghostTransitions :: [Transition],
         fixedTraps :: [Trap],
-        fixedSiphons :: [Siphon]
+        fixedSiphons :: [Siphon],
+        yesStates :: [Place],
+        noStates :: [Place]
 }
 
 initial :: PetriNet -> Place -> Integer
@@ -108,7 +111,9 @@ instance Show PetriNet where
                    "\nInitial: " ++ show (initialMarking net) ++
                    "\nGhost transitions: " ++ show (ghostTransitions net) ++
                    "\nFixed traps: " ++ show (fixedTraps net) ++
-                   "\nFixed siphons: " ++ show (fixedSiphons net)
+                   "\nFixed siphons: " ++ show (fixedSiphons net) ++
+                   "\nYes states: " ++ show (yesStates net) ++
+                   "\nNo states: " ++ show (noStates net)
                 where showContext (s,(l,r)) =
                           show l ++ " -> " ++ show s ++ " -> " ++ show r
 
@@ -149,7 +154,9 @@ renamePetriNetPlacesAndTransitions f net =
                 ghostTransitions =
                     listSet $ map (renameTransition f) $ ghostTransitions net,
                 fixedTraps = map (map $ renamePlace f) $ fixedTraps net,
-                fixedSiphons = map (map $ renamePlace f) $ fixedSiphons net
+                fixedSiphons = map (map $ renamePlace f) $ fixedSiphons net,
+                yesStates = map (renamePlace f) $ yesStates net,
+                noStates = map (renamePlace f) $ noStates net
             }
         where mapAdjacency f g m = M.mapKeys f (M.map (mapContext g) m)
               mapContext f (pre, post) =
@@ -157,8 +164,8 @@ renamePetriNetPlacesAndTransitions f net =
 
 makePetriNet :: String -> [Place] -> [Transition] ->
         [Either (Transition, Place, Integer) (Place, Transition, Integer)] ->
-        [(Place, Integer)] -> [Transition] -> [Trap] -> [Siphon] -> PetriNet
-makePetriNet name places transitions arcs initial gs fixedTraps fixedSiphons =
+        [(Place, Integer)] -> [Transition] -> [Trap] -> [Siphon] -> [Place] -> [Place] -> PetriNet
+makePetriNet name places transitions arcs initial gs fixedTraps fixedSiphons yesStates noStates =
             PetriNet {
                 name = name,
                 places = listSet places,
@@ -168,7 +175,9 @@ makePetriNet name places transitions arcs initial gs fixedTraps fixedSiphons =
                 initialMarking = buildVector initial,
                 ghostTransitions = listSet gs,
                 fixedTraps = map listSet fixedTraps,
-                fixedSiphons = map listSet fixedSiphons
+                fixedSiphons = map listSet fixedSiphons,
+                yesStates = listSet yesStates,
+                noStates = listSet noStates
             }
         where
             (adP, adT) = foldl buildMaps (M.empty, M.empty) arcs
@@ -190,8 +199,8 @@ makePetriNet name places transitions arcs initial gs fixedTraps fixedSiphons =
 
 makePetriNetFromStrings :: String -> [String] -> [String] ->
         [(String, String, Integer)] ->
-        [(String, Integer)] -> [String] -> [[String]] -> [[String]] -> PetriNet
-makePetriNetFromStrings name places transitions arcs initial gs fixedTraps fixedSiphons =
+        [(String, Integer)] -> [String] -> [[String]] -> [[String]] -> [String] -> [String] -> PetriNet
+makePetriNetFromStrings name places transitions arcs initial gs fixedTraps fixedSiphons yesStates noStates =
             makePetriNet
                 name
                 (map Place (S.toAscList placeSet))
@@ -201,6 +210,8 @@ makePetriNetFromStrings name places transitions arcs initial gs fixedTraps fixed
                 (map Transition gs)
                 (map (map Place) fixedTraps)
                 (map (map Place) fixedSiphons)
+                (map Place yesStates)
+                (map Place noStates)
         where
             placeSet = S.fromList places
             transitionSet = S.fromList transitions
@@ -225,17 +236,17 @@ makePetriNetFromStrings name places transitions arcs initial gs fixedTraps fixed
 
 makePetriNetWithTrans :: String -> [Place] ->
         [(Transition, ([(Place, Integer)], [(Place, Integer)]))] ->
-        [(Place, Integer)] -> [Transition] -> [Trap] -> [Siphon] ->PetriNet
-makePetriNetWithTrans name places ts fixedTraps fixedSiphons =
-            makePetriNet name places (map fst ts) arcs fixedTraps fixedSiphons
+        [(Place, Integer)] -> [Transition] -> [Trap] -> [Siphon] -> [Place] -> [Place] -> PetriNet
+makePetriNetWithTrans name places ts fixedTraps fixedSiphons yesStates noStates =
+            makePetriNet name places (map fst ts) arcs fixedTraps fixedSiphons yesStates noStates
         where
             arcs = [ Right (p,t,w) | (t,(is,_)) <- ts, (p,w) <- is ] ++
                    [ Left  (t,p,w) | (t,(_,os)) <- ts, (p,w) <- os ]
 
 makePetriNetWithTransFromStrings :: String -> [String] ->
         [(String, ([(String, Integer)], [(String, Integer)]))] ->
-        [(String, Integer)] -> [String] -> [[String]] -> [[String]] -> PetriNet
-makePetriNetWithTransFromStrings name places arcs initial gs fixedTraps fixedSiphons =
+        [(String, Integer)] -> [String] -> [[String]] -> [[String]] -> [String] -> [String] -> PetriNet
+makePetriNetWithTransFromStrings name places arcs initial gs fixedTraps fixedSiphons yesStates noStates =
             makePetriNetWithTrans
                 name
                 (map Place places)
@@ -244,6 +255,8 @@ makePetriNetWithTransFromStrings name places arcs initial gs fixedTraps fixedSip
                 (map Transition gs)
                 (map (map Place) fixedTraps)
                 (map (map Place) fixedSiphons)
+                (map Place yesStates)
+                (map Place noStates)
         where
             toTArc (t, (is, os)) =
                 (Transition t, (map (first Place) is, map (first Place) os))

src/Property.hs

@@ -93,9 +93,11 @@ data PropertyType = SafetyType
                   | ConstraintType
 
 data ConstraintProperty = UniqueTerminalMarkingConstraint
+                        | NonConsensusStateConstraint
 
 instance Show ConstraintProperty where
         show UniqueTerminalMarkingConstraint = "unique terminal marking"
+        show NonConsensusStateConstraint = "non-consensus state"
 
 data PropertyContent = Safety (Formula Place)
                   | Liveness (Formula Transition)

src/Solver/NonConsensusState.hs

+{-# LANGUAGE FlexibleContexts #-}
+
+module Solver.NonConsensusState
+    (checkNonConsensusStateSat,
+     NonConsensusStateCounterExample,
+     checkUnmarkedTrapSat,
+     checkUnmarkedSiphonSat)
+where
+
+import Data.SBV
+import qualified Data.Map as M
+import Data.List ((\\))
+
+import Util
+import PetriNet
+import Property
+import Solver
+
+type NonConsensusStateCounterExample = (RMarking, RMarking, RFiringVector)
+
+stateEquationConstraints :: PetriNet -> SRMap Place -> SRMap Place -> SRMap Transition -> SBool
+stateEquationConstraints net m0 m x =
+            bAnd $ map checkStateEquation $ places net
+        where checkStateEquation p =
+                let incoming = map addTransition $ lpre net p
+                    outgoing = map addTransition $ lpost net p
+                in  val m0 p + sum incoming - sum outgoing .== val m p
+              addTransition (t,w) = literal (fromInteger w) * val x t
+
+nonNegativityConstraints :: (Ord a, Show a) => SRMap a -> SBool
+nonNegativityConstraints m =
+            bAnd $ map checkVal $ vals m
+        where checkVal x = x .>= 0
+
+terminalMarkingConstraints :: PetriNet -> SRMap Place -> SBool
+terminalMarkingConstraints net m =
+            bAnd $ map checkTransition $ transitions net
+        where checkTransition t = bOr $ map checkPlace $ lpre net t
+              checkPlace (p,w) = val m p .== 0
+
+initialMarkingConstraints :: PetriNet -> SRMap Place -> SBool
+initialMarkingConstraints net m0 =
+        sum (mval m0 (places net \\ initials net)) .== 0
+
+nonConsensusStateConstraints :: PetriNet -> SRMap Place -> SBool
+nonConsensusStateConstraints net m =
+        sum (mval m (yesStates net)) .> 0 &&&
+        sum (mval m (noStates net)) .> 0
+
+checkTrap :: PetriNet -> SRMap Place -> SRMap Place -> SRMap Transition -> Trap -> SBool
+checkTrap net m0 m x trap =
+            (markedByMarking m0 ==> markedByMarking m) &&&
+            (markedBySequence x ==> markedByMarking m)
+        where markedByMarking m = sum (mval m trap) .> 0
+              markedBySequence x = sum (mval x (mpre net trap)) .> 0
+
+checkTrapConstraints :: PetriNet -> SRMap Place -> SRMap Place -> SRMap Transition -> [Trap] -> SBool
+checkTrapConstraints net m0 m x traps =
+        bAnd $ map (checkTrap net m0 m x) traps
+
+checkSiphon :: PetriNet -> SRMap Place -> SRMap Place -> SRMap Transition -> Siphon -> SBool
+checkSiphon net m0 m x siphon =
+            unmarkedByMarking m0 ==> (unmarkedByMarking m &&& notPresetOfSequence x)
+        where unmarkedByMarking m = sum (mval m siphon) .== 0
+              notPresetOfSequence x = sum (mval x (mpost net siphon)) .== 0
+
+checkSiphonConstraints :: PetriNet -> SRMap Place -> SRMap Place -> SRMap Transition -> [Siphon] -> SBool
+checkSiphonConstraints net m0 m x siphons =
+        bAnd $ map (checkSiphon net m0 m x) siphons
+
+checkNonConsensusState :: PetriNet -> SRMap Place -> SRMap Place -> SRMap Transition -> [Trap] -> [Siphon] -> SBool
+checkNonConsensusState net m0 m x traps siphons =
+        stateEquationConstraints net m0 m x &&&
+        nonNegativityConstraints m0 &&&
+        nonNegativityConstraints m &&&
+        nonNegativityConstraints x &&&
+        initialMarkingConstraints net m0 &&&
+        terminalMarkingConstraints net m &&&
+        nonConsensusStateConstraints net m &&&
+        checkTrapConstraints net m0 m x traps &&&
+        checkSiphonConstraints net m0 m x siphons
+
+checkNonConsensusStateSat :: PetriNet -> [Trap] -> [Siphon] -> ConstraintProblem AlgReal NonConsensusStateCounterExample
+checkNonConsensusStateSat net traps siphons =
+        let m0 = makeVarMap $ places net
+            m = makeVarMapWith prime $ places net
+            x = makeVarMap $ transitions net
+        in  ("non-consensus state", "(m0, m, x)",
+             getNames m0 ++ getNames m ++ getNames x,
+             \fm -> checkNonConsensusState net (fmap fm m0) (fmap fm m) (fmap fm x) traps siphons,
+             \fm -> markingsFromAssignment (fmap fm m0) (fmap fm m) (fmap fm x))
+
+markingsFromAssignment :: RMap Place -> RMap Place -> RMap Transition -> NonConsensusStateCounterExample
+markingsFromAssignment m0 m x =
+        (makeVector m0, makeVector m, makeVector x)
+
+-- trap and siphon refinement constraints
+
+siphonConstraints :: PetriNet -> SIMap Place -> SBool
+siphonConstraints net b =
+            bAnd $ map siphonConstraint $ transitions net
+        where siphonConstraint t =
+                  sum (mval b $ post net t) .> 0 ==> sum (mval b $ pre net t) .> 0
+
+trapConstraints :: PetriNet -> SIMap Place -> SBool
+trapConstraints net b =
+            bAnd $ map trapConstraint $ transitions net
+        where trapConstraint t =
+                  sum (mval b $ pre net t) .> 0 ==> sum (mval b $ post net t) .> 0
+
+placesMarkedByMarking :: PetriNet -> RMarking -> SIMap Place -> SBool
+placesMarkedByMarking net m b = sum (mval b $ elems m) .> 0
+
+placesUnmarkedByMarking :: PetriNet -> RMarking -> SIMap Place -> SBool
+placesUnmarkedByMarking net m b = sum (mval b $ elems m) .== 0
+
+placesPostsetOfSequence :: PetriNet -> RFiringVector -> SIMap Place -> SBool
+placesPostsetOfSequence net x b = sum (mval b $ mpost net $ elems x) .> 0
+
+placesPresetOfSequence :: PetriNet -> RFiringVector -> SIMap Place -> SBool
+placesPresetOfSequence net x b = sum (mval b $ mpre net $ elems x) .> 0
+
+nonemptySet :: (Ord a, Show a) => SIMap a -> SBool
+nonemptySet b = sum (vals b) .> 0
+
+checkBinary :: SIMap Place -> SBool
+checkBinary = bAnd . map (\x -> x .== 0 ||| x .== 1) . vals
+
+checkSizeLimit :: SIMap Place -> Maybe (Int, Integer) -> SBool
+checkSizeLimit _ Nothing = true
+checkSizeLimit b (Just (1, curSize)) = (.< literal curSize) $ sumVal b
+checkSizeLimit b (Just (2, curSize)) = (.> literal curSize) $ sumVal b
+checkSizeLimit _ (Just (_, _)) = error "minimization method not supported"
+
+minimizeMethod :: Int -> Integer -> String
+minimizeMethod 1 curSize = "size smaller than " ++ show curSize
+minimizeMethod 2 curSize = "size larger than " ++ show curSize
+minimizeMethod _ _ = error "minimization method not supported"
+
+checkUnmarkedTrap :: PetriNet -> RMarking -> RMarking -> RFiringVector -> SIMap Place -> Maybe (Int, Integer) -> SBool
+checkUnmarkedTrap net m0 m x b sizeLimit =
+        trapConstraints net b &&&
+        nonemptySet b &&&
+        checkSizeLimit b sizeLimit &&&
+        checkBinary b &&&
+        (
+            (placesMarkedByMarking net m0 b &&& placesUnmarkedByMarking net m b) |||
+            (placesPostsetOfSequence net x b &&& placesUnmarkedByMarking net m b)
+        )
+
+checkUnmarkedTrapSat :: PetriNet -> RMarking -> RMarking -> RFiringVector -> MinConstraintProblem Integer Trap Integer
+checkUnmarkedTrapSat net m0 m x =
+        let b = makeVarMap $ places net
+        in  (minimizeMethod, \sizeLimit ->
+            ("trap marked in m and unmarked in m, or marked by x and unmarked in m", "trap",
+             getNames b,
+             \fm -> checkUnmarkedTrap net m0 m x (fmap fm b) sizeLimit,
+             \fm -> placesFromAssignment (fmap fm b)))
+
+checkUnmarkedSiphon :: PetriNet -> RMarking -> RMarking -> RFiringVector -> SIMap Place -> Maybe (Int, Integer) -> SBool
+checkUnmarkedSiphon net m0 m x b sizeLimit =
+        siphonConstraints net b &&&
+        nonemptySet b &&&
+        checkSizeLimit b sizeLimit &&&
+        checkBinary b &&&
+        (placesUnmarkedByMarking net m0 b &&& (placesMarkedByMarking net m b ||| placesPresetOfSequence net x b))
+
+checkUnmarkedSiphonSat :: PetriNet -> RMarking -> RMarking -> RFiringVector -> MinConstraintProblem Integer Siphon Integer
+checkUnmarkedSiphonSat net m0 m x =
+        let b = makeVarMap $ places net
+        in  (minimizeMethod, \sizeLimit ->
+            ("siphon unmarked in m0 and marked in m or used as input in x", "siphon",
+             getNames b,
+             \fm -> checkUnmarkedSiphon net m0 m x (fmap fm b) sizeLimit,
+             \fm -> placesFromAssignment (fmap fm b)))
+
+placesFromAssignment :: IMap Place -> ([Place], Integer)
+placesFromAssignment b = (M.keys (M.filter (> 0) b), sum (M.elems b))