Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
i7
peregrine
Commits
3ce8c40a
Commit
3ce8c40a
authored
Feb 07, 2017
by
Philipp J. Meyer
Browse files
added refinement with generalized siphons
parent
f8ce8a20
Changes
2
Hide whitespace changes
Inline
Side-by-side
src/Main.hs
View file @
3ce8c40a
...
...
@@ -475,10 +475,10 @@ refineTerminalMarkingsUniqueConsensusProperty :: PetriNet ->
[
Trap
]
->
[
Siphon
]
->
[
StableInequality
]
->
TerminalMarkingsUniqueConsensusCounterExample
->
OptIO
(
Maybe
TerminalMarkingsUniqueConsensusCounterExample
,
[
Trap
],
[
Siphon
],
[
StableInequality
])
refineTerminalMarkingsUniqueConsensusProperty
net
traps
siphons
inequalities
c
@
(
m0
,
m1
,
m2
,
x1
,
x2
)
=
do
r1
<-
checkSatMin
$
Solver
.
TerminalMarkingsUniqueConsensus
.
check
UnmarkedTrapSat
net
m0
m1
m2
x1
x2
r1
<-
checkSatMin
$
Solver
.
TerminalMarkingsUniqueConsensus
.
find
UnmarkedTrapSat
net
m0
m1
m2
x1
x2
case
r1
of
Nothing
->
do
r2
<-
checkSatMin
$
Solver
.
TerminalMarkingsUniqueConsensus
.
check
GeneralizedSiphonConstraintsSat
net
m0
m1
m2
x1
x2
r2
<-
checkSatMin
$
Solver
.
TerminalMarkingsUniqueConsensus
.
find
GeneralizedSiphonConstraintsSat
net
m0
m1
m2
x1
x2
case
r2
of
Nothing
->
do
return
(
Just
c
,
traps
,
siphons
,
inequalities
)
...
...
src/Solver/TerminalMarkingsUniqueConsensus.hs
View file @
3ce8c40a
...
...
@@ -3,8 +3,8 @@
module
Solver.TerminalMarkingsUniqueConsensus
(
checkTerminalMarkingsUniqueConsensusSat
,
TerminalMarkingsUniqueConsensusCounterExample
,
check
UnmarkedTrapSat
,
check
GeneralizedSiphonConstraintsSat
,
find
UnmarkedTrapSat
,
find
GeneralizedSiphonConstraintsSat
,
checkGeneralizedCoTrapSat
,
StableInequality
)
where
...
...
@@ -48,8 +48,7 @@ initialMarkingConstraints net m0 =
differentConsensusConstraints
::
PetriNet
->
SIMap
Place
->
SIMap
Place
->
SBool
differentConsensusConstraints
net
m1
m2
=
(
sum
(
mval
m1
(
yesStates
net
))
.>
0
&&&
sum
(
mval
m2
(
noStates
net
))
.>
0
)
|||
(
sum
(
mval
m1
(
noStates
net
))
.>
0
&&&
sum
(
mval
m2
(
yesStates
net
))
.>
0
)
(
sum
(
mval
m1
(
yesStates
net
))
.>
0
&&&
sum
(
mval
m2
(
noStates
net
))
.>
0
)
checkTrap
::
PetriNet
->
SIMap
Place
->
SIMap
Place
->
SIMap
Place
->
SIMap
Transition
->
SIMap
Transition
->
Trap
->
SBool
checkTrap
net
m0
m1
m2
x1
x2
trap
=
...
...
@@ -61,16 +60,16 @@ checkTrapConstraints :: PetriNet -> SIMap Place -> SIMap Place -> SIMap Place ->
checkTrapConstraints
net
m0
m1
m2
x1
x2
traps
=
bAnd
$
map
(
checkTrap
net
m0
m1
m2
x1
x2
)
traps
checkSiphon
::
PetriNet
->
SIMap
Place
->
SIMap
Place
->
SIMap
Place
->
SIMap
Transition
->
SIMap
Transition
->
Siphon
->
SBool
checkSiphon
net
m0
m1
m2
x1
x2
siphon
=
noTransitionEnabledByMarking
m0
==>
(
notPresetOfSequence
x1
&&&
notPresetOfSequence
x2
)
where
noTransitionEnabledByMarking
m
=
bAnd
$
map
(
notEnabledByMarkingInSiphon
m
)
$
mpost
net
siphon
notEnabledByMarkingInSiphon
m
t
=
bOr
$
[
val
m
p
.<
literal
w
|
(
p
,
w
)
<-
lpre
net
t
,
p
`
elem
`
siphon
]
notPresetOf
Sequence
x
=
sum
(
m
val
x
(
mpost
net
siphon
)
)
.==
0
check
Generalized
Siphon
::
PetriNet
->
SIMap
Place
->
SIMap
Place
->
SIMap
Place
->
SIMap
Transition
->
SIMap
Transition
->
Siphon
->
SBool
check
Generalized
Siphon
net
m0
m1
m2
x1
x2
siphon
=
((
unmarkedByMarking
m0
&&&
unmarkedBySequence
x1
)
==>
(
unmarkedByMarking
m1
))
&&&
((
unmarkedByMarking
m0
&&&
unmarkedBySequence
x2
)
==>
(
unmarkedByMarking
m2
))
where
unmarkedByMarking
m
=
sum
(
mval
m
siphon
)
.==
0
unmarkedBy
Sequence
x
=
sum
[
val
x
t
|
t
<-
(
mpre
net
siphon
\\
mpost
net
siphon
)
]
.==
0
checkSiphonConstraints
::
PetriNet
->
SIMap
Place
->
SIMap
Place
->
SIMap
Place
->
SIMap
Transition
->
SIMap
Transition
->
[
Siphon
]
->
SBool
checkSiphonConstraints
net
m0
m1
m2
x1
x2
siphons
=
bAnd
$
map
(
checkSiphon
net
m0
m1
m2
x1
x2
)
siphons
check
Generalized
SiphonConstraints
::
PetriNet
->
SIMap
Place
->
SIMap
Place
->
SIMap
Place
->
SIMap
Transition
->
SIMap
Transition
->
[
Siphon
]
->
SBool
check
Generalized
SiphonConstraints
net
m0
m1
m2
x1
x2
siphons
=
bAnd
$
map
(
check
Generalized
Siphon
net
m0
m1
m2
x1
x2
)
siphons
checkInequalityConstraint
::
PetriNet
->
SIMap
Place
->
SIMap
Place
->
SIMap
Place
->
StableInequality
->
SBool
checkInequalityConstraint
net
m0
m1
m2
(
k
,
c
)
=
...
...
@@ -96,8 +95,7 @@ checkTerminalMarkingsUniqueConsensus net m0 m1 m2 x1 x2 traps siphons inequaliti
terminalConstraints
net
m2
&&&
differentConsensusConstraints
net
m1
m2
&&&
checkTrapConstraints
net
m0
m1
m2
x1
x2
traps
&&&
checkSiphonConstraints
net
m0
m1
m2
x1
x2
siphons
&&&
checkSubnetSiphonConstraints
net
m0
m1
m2
x1
x2
siphons
&&&
checkGeneralizedSiphonConstraints
net
m0
m1
m2
x1
x2
siphons
&&&
checkInequalityConstraints
net
m0
m1
m2
inequalities
checkTerminalMarkingsUniqueConsensusSat
::
PetriNet
->
[
Trap
]
->
[
Siphon
]
->
[
StableInequality
]
->
ConstraintProblem
Integer
TerminalMarkingsUniqueConsensusCounterExample
...
...
@@ -118,11 +116,11 @@ markingsFromAssignment m0 m1 m2 x1 x2 =
-- trap and siphon refinement constraints
s
iphonConstraints
::
PetriNet
->
Marking
->
SIMap
Place
->
SBool
s
iphonConstraints
net
m0
b
=
bAnd
$
map
siphonConstraint
$
transitions
net
generalizedS
iphonConstraints
::
PetriNet
->
FiringVector
->
SIMap
Place
->
SBool
generalizedS
iphonConstraints
net
x
b
=
bAnd
[
siphonConstraint
t
|
t
<-
elems
x
]
where
siphonConstraint
t
=
sum
(
mval
b
$
post
net
t
)
.>
0
==>
sum
(
mval
b
$
pre
net
t
)
.>
0
sum
(
mval
b
$
post
net
t
)
.>
0
==>
sum
(
mval
b
$
pre
net
t
)
.>
0
trapConstraints
::
PetriNet
->
SIMap
Place
->
SBool
trapConstraints
net
b
=
...
...
@@ -167,41 +165,40 @@ minimizeMethod 1 curSize = "size smaller than " ++ show curSize
minimizeMethod
2
curSize
=
"size larger than "
++
show
curSize
minimizeMethod
_
_
=
error
"minimization method not supported"
checkUnmarkedTrap
::
PetriNet
->
Marking
->
Marking
->
Marking
->
FiringVector
->
FiringVector
->
SIMap
Place
->
Maybe
(
Int
,
Integer
)
->
SBool
checkUnmarkedTrap
net
m0
m1
m2
x1
x2
b
sizeLimit
=
trapConstraints
net
b
&&&
nonemptySet
b
&&&
findUnmarkedTrap
::
PetriNet
->
Marking
->
Marking
->
Marking
->
FiringVector
->
FiringVector
->
SIMap
Place
->
Maybe
(
Int
,
Integer
)
->
SBool
findUnmarkedTrap
net
m0
m1
m2
x1
x2
b
sizeLimit
=
placesMarkedByMarking
net
m0
b
&&&
checkSizeLimit
b
sizeLimit
&&&
checkBinary
b
&&&
(
(
placesMarkedByMarking
net
m0
b
&&&
(
placesUnmarkedByMarking
net
m1
b
|||
placesUnmarkedByMarking
net
m2
b
))
)
trapConstraints
net
b
&&&
((
placesUnmarkedByMarking
net
m1
b
|||
placesUnmarkedByMarking
net
m2
b
))
check
UnmarkedTrapSat
::
PetriNet
->
Marking
->
Marking
->
Marking
->
FiringVector
->
FiringVector
->
MinConstraintProblem
Integer
Trap
Integer
check
UnmarkedTrapSat
net
m0
m1
m2
x1
x2
=
find
UnmarkedTrapSat
::
PetriNet
->
Marking
->
Marking
->
Marking
->
FiringVector
->
FiringVector
->
MinConstraintProblem
Integer
Trap
Integer
find
UnmarkedTrapSat
net
m0
m1
m2
x1
x2
=
let
b
=
makeVarMap
$
places
net
in
(
minimizeMethod
,
\
sizeLimit
->
(
"trap marked in m and unmarked in m1 or m2, or marked by x1 and unmarked in m1, or marked by x2 and unmarked in m2"
,
"trap"
,
getNames
b
,
\
fm
->
check
UnmarkedTrap
net
m0
m1
m2
x1
x2
(
fmap
fm
b
)
sizeLimit
,
\
fm
->
find
UnmarkedTrap
net
m0
m1
m2
x1
x2
(
fmap
fm
b
)
sizeLimit
,
\
fm
->
placesFromAssignment
(
fmap
fm
b
)))
checkGeneralizedSiphonConstraints
::
PetriNet
->
Marking
->
Marking
->
Marking
->
FiringVector
->
FiringVector
->
SIMap
Place
->
Maybe
(
Int
,
Integer
)
->
SBool
checkGeneralizedSiphonConstraints
net
m0
m1
m2
x1
x2
b
sizeLimit
=
siphonConstraints
net
m0
b
&&&
nonemptySet
b
&&&
findGeneralizedSiphonConstraints
::
PetriNet
->
Marking
->
Marking
->
Marking
->
FiringVector
->
FiringVector
->
SIMap
Place
->
Maybe
(
Int
,
Integer
)
->
SBool
findGeneralizedSiphonConstraints
net
m0
m1
m2
x1
x2
b
sizeLimit
=
placesUnmarkedByMarking
net
m0
b
&&&
checkSizeLimit
b
sizeLimit
&&&
checkBinary
b
&&&
noOutputTransitionEnabled
net
m0
b
&&&
(
placesPresetOfSequence
net
x1
b
|||
placesPresetOfSequence
net
x2
b
)
(
(
generalizedSiphonConstraints
net
x1
b
&&&
placesMarkedByMarking
net
m1
b
)
|||
(
generalizedSiphonConstraints
net
x2
b
&&&
placesMarkedByMarking
net
m2
b
)
)
check
GeneralizedSiphonConstraintsSat
::
PetriNet
->
Marking
->
Marking
->
Marking
->
FiringVector
->
FiringVector
->
MinConstraintProblem
Integer
Siphon
Integer
check
GeneralizedSiphonConstraintsSat
net
m0
m1
m2
x1
x2
=
find
GeneralizedSiphonConstraintsSat
::
PetriNet
->
Marking
->
Marking
->
Marking
->
FiringVector
->
FiringVector
->
MinConstraintProblem
Integer
Siphon
Integer
find
GeneralizedSiphonConstraintsSat
net
m0
m1
m2
x1
x2
=
let
b
=
makeVarMap
$
places
net
in
(
minimizeMethod
,
\
sizeLimit
->
(
"siphon
not enabling any output transitions in m0 and used as input
in
x
1 or
x
2"
,
"siphon"
,
(
"siphon
(w.r.t. x1 or x2) not marked in m0 and marked
in
m
1 or
m
2"
,
"siphon"
,
getNames
b
,
\
fm
->
check
GeneralizedSiphonConstraints
net
m0
m1
m2
x1
x2
(
fmap
fm
b
)
sizeLimit
,
\
fm
->
find
GeneralizedSiphonConstraints
net
m0
m1
m2
x1
x2
(
fmap
fm
b
)
sizeLimit
,
\
fm
->
placesFromAssignment
(
fmap
fm
b
)))
placesFromAssignment
::
IMap
Place
->
([
Place
],
Integer
)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment