Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- -- Naive implementation of alpha algorithm for descovering petri-nets from event logs
- import Control.Monad
- import Data.Set (Set)
- import qualified Data.Set as Set
- data Arc p t
- = P2T p t
- | T2P t p
- deriving (Eq, Ord, Show)
- data Place a = I | O | P (Set a) (Set a)
- deriving (Eq, Ord, Show)
- alpha :: Ord t => Set [t] -> (Set (Place t), Set t, Set (Arc (Place t) t))
- alpha ts = (p_l, t_l, f_l)
- where
- directSuccessions = Set.fromList [(x,y) | sigma <- Set.toList ts, t <- sigma, not (null sigma), (x,y) <- zip sigma (tail sigma)]
- x > y = (x,y) `Set.member` directSuccessions
- x .->. y = x > y && not (y > x) -- causality
- x .||. y = x > y && y > x -- parallel
- x # y = not (x > y) && not (y > x) -- choice
- t_l = Set.fromList [t | sigma <- Set.toList ts, t <- sigma]
- t_i = Set.fromList [t | t:_ <- Set.toList ts]
- t_o = Set.fromList [t | t:_ <- map reverse (Set.toList ts)]
- x_l = Set.fromList $ do
- as <- subsets t_l
- guard $ not $ Set.null as
- bs <- subsets t_l
- guard $ not $ Set.null bs
- guard $ and [a1 # a2 | a1 <- Set.toList as, a2 <- Set.toList as]
- guard $ and [b1 # b2 | b1 <- Set.toList bs, b2 <- Set.toList bs]
- guard $ and [a .->. b | a <- Set.toList as, b <- Set.toList bs]
- return (as, bs)
- y_l = [(as,bs) | (as,bs) <- Set.toList x_l, and [not (as `Set.isSubsetOf` as' && bs `Set.isSubsetOf` bs') || (as==as' && bs==bs') | (as',bs') <- Set.toList x_l]]
- p_l = Set.fromList [I, O] `Set.union` Set.fromList [P as bs | (as,bs) <- y_l]
- f_l = Set.unions
- [ Set.fromList [T2P a (P as bs) | (as,bs) <- y_l, a <- Set.toList as]
- , Set.fromList [P2T (P as bs) b | (as,bs) <- y_l, b <- Set.toList bs]
- , Set.fromList [P2T I t | t <- Set.toList t_i]
- , Set.fromList [T2P t O | t <- Set.toList t_o]
- ]
- subsets :: Ord a => Set a -> [Set a]
- subsets xs = foldM f Set.empty (Set.toList xs)
- where
- f ys x = return ys `mplus` return (Set.insert x ys)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement