StructuralComputation.hs 1.49 KB
 Philipp J. Meyer committed Jan 26, 2017 1 2 3 4 5 6 7 8 9 10 11 12 ``````module StructuralComputation (Triplet ,generateTriplets ,trivialTriplet ,emptyTriplet) where import PetriNet import qualified Data.Map as M type Triplet = (Transition, Transition, [Transition]) `````` Philipp J. Meyer committed Jan 31, 2017 13 ``````-- TODO: optimize `````` Philipp J. Meyer committed Jan 26, 2017 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 ``````generateTriplets :: PetriNet -> [Triplet] generateTriplets net = let prePostMultiset t = let (pre, post) = context net t in (M.fromList pre, M.fromList post) prePostMultisets = M.fromList \$ [(t, prePostMultiset t) | t <- transitions net] multiSetDifference a b = if a > b then Just (a - b) else Nothing findT' s t = let (sPre, sPost) = prePostMultisets M.! s (tPre, tPost) = prePostMultisets M.! t stSet = M.unionWith (+) sPre (M.differenceWith multiSetDifference tPre sPost) in [t' | t' <- transitions net, t' /= s, checkTriple stSet t'] checkTriple stMultiset t' = let (tPre, _) = prePostMultisets M.! t' differenceMultiset = M.differenceWith multiSetDifference tPre stMultiset in M.null differenceMultiset in [(s, t, findT' s t) | s <- transitions net, t <- transitions net, s /= t] trivialTriplet :: Triplet -> Bool trivialTriplet (_, t, ts) = elem t ts emptyTriplet :: Triplet -> Bool emptyTriplet (_, _, ts) = null ts``````