Skip to content

Instantly share code, notes, and snippets.

@msakai

msakai/CausalNet.hs

Last active Aug 29, 2015
Embed
What would you like to do?
Learning of dependency graph and causal net from event logs
-- | Naive implementation of alpha algorithm for descovering petri-nets from event logs
--
-- References:
--
-- * Wil van der Aalst, "Process Mining: Data science in Action", Week 2,
-- https://www.coursera.org/course/procmin
import Control.Monad
import Data.MultiSet (MultiSet) -- http://hackage.haskell.org/package/multiset
import qualified Data.MultiSet as MultiSet
import Data.Set (Set)
import qualified Data.Set as Set
type PetriNet p t = (Set p, Set t, MultiSet (PetriNetArc p t))
data PetriNetArc p t
= P2T p t
| T2P t p
deriving (Eq, Ord, Show)
data AlphaPlace a = I | O | P (Set a) (Set a)
deriving (Eq, Ord, Show)
alpha :: Ord t => MultiSet [t] -> PetriNet (AlphaPlace t) t
alpha ts = (p_l, t_l, f_l)
where
directSuccessions = Set.fromList [(x,y) | sigma <- MultiSet.distinctElems 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 <- MultiSet.distinctElems ts, t <- sigma]
t_i = Set.fromList [t | t:_ <- MultiSet.distinctElems ts]
t_o = Set.fromList [t | t:_ <- map reverse (MultiSet.distinctElems 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 = MultiSet.fromSet $ 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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.