{-# LANGUAGE FlexibleContexts #-}
module Modelling.ActivityDiagram.Isomorphism (
  isAdIsomorphic,
  isPetriIsomorphic,
  petriHasMultipleAutomorphisms,
  petriToGraph,
) where

import qualified Data.Map as M (keys)

import Modelling.ActivityDiagram.Datatype (UMLActivityDiagram)
import Modelling.ActivityDiagram.PetriNet (convertToSimple)
import Modelling.PetriNet.Types (Net (..))
import Data.Graph (Graph, graphFromEdges')
import Data.Graph.Automorphism          (automorphisms, isIsomorphic)

isAdIsomorphic :: UMLActivityDiagram -> UMLActivityDiagram -> Bool
isAdIsomorphic :: UMLActivityDiagram -> UMLActivityDiagram -> Bool
isAdIsomorphic UMLActivityDiagram
ad1 UMLActivityDiagram
ad2 =
  PetriLike SimpleNode PetriKey
-> PetriLike SimpleNode PetriKey -> Bool
forall (p :: (* -> *) -> * -> *) (n :: * -> *)
       (p' :: (* -> *) -> * -> *) (n' :: * -> *) a.
(Net p n, Net p' n', Ord a) =>
p n a -> p' n' a -> Bool
isPetriIsomorphic (UMLActivityDiagram -> PetriLike SimpleNode PetriKey
convertToSimple UMLActivityDiagram
ad1) (UMLActivityDiagram -> PetriLike SimpleNode PetriKey
convertToSimple UMLActivityDiagram
ad2)

petriHasMultipleAutomorphisms :: (Net p n, Ord a) => p n a -> Bool
petriHasMultipleAutomorphisms :: forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
p n a -> Bool
petriHasMultipleAutomorphisms =
  Bool -> Bool
not (Bool -> Bool) -> (p n a -> Bool) -> p n a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Permutation] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Permutation] -> Bool)
-> (p n a -> [Permutation]) -> p n a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Permutation] -> [Permutation]
forall a. HasCallStack => [a] -> [a]
tail ([Permutation] -> [Permutation])
-> (p n a -> [Permutation]) -> p n a -> [Permutation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Permutation], Graph) -> [Permutation]
forall a b. (a, b) -> a
fst (([Permutation], Graph) -> [Permutation])
-> (p n a -> ([Permutation], Graph)) -> p n a -> [Permutation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Partition -> Graph -> ([Permutation], Graph)
automorphisms [] (Graph -> ([Permutation], Graph))
-> (p n a -> Graph) -> p n a -> ([Permutation], Graph)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p n a -> Graph
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
p n a -> Graph
petriToGraph

isPetriIsomorphic
  :: (Net p n, Net p' n', Ord a)
  => p n a
  -> p' n' a
  -> Bool
isPetriIsomorphic :: forall (p :: (* -> *) -> * -> *) (n :: * -> *)
       (p' :: (* -> *) -> * -> *) (n' :: * -> *) a.
(Net p n, Net p' n', Ord a) =>
p n a -> p' n' a -> Bool
isPetriIsomorphic p n a
p1 p' n' a
p2 =
  Graph -> Graph -> Bool
isIsomorphic (p n a -> Graph
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
p n a -> Graph
petriToGraph p n a
p1) (p' n' a -> Graph
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
p n a -> Graph
petriToGraph p' n' a
p2)

petriToGraph :: (Net p n, Ord a) => p n a -> Graph
petriToGraph :: forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
p n a -> Graph
petriToGraph p n a
petri =
  let keys :: [a]
keys = Map a (n a) -> [a]
forall k a. Map k a -> [k]
M.keys (Map a (n a) -> [a]) -> Map a (n a) -> [a]
forall a b. (a -> b) -> a -> b
$ p n a -> Map a (n a)
forall a. Ord a => p n a -> Map a (n a)
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
p n a -> Map a (n a)
nodes p n a
petri
      keyToEdgeList :: a -> [a]
keyToEdgeList a
k = Map a Int -> [a]
forall k a. Map k a -> [k]
M.keys (Map a Int -> [a]) -> Map a Int -> [a]
forall a b. (a -> b) -> a -> b
$ a -> p n a -> Map a Int
forall a. Ord a => a -> p n a -> Map a Int
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
a -> p n a -> Map a Int
outFlow a
k p n a
petri
  in (Graph, Int -> (a, a, [a])) -> Graph
forall a b. (a, b) -> a
fst ((Graph, Int -> (a, a, [a])) -> Graph)
-> (Graph, Int -> (a, a, [a])) -> Graph
forall a b. (a -> b) -> a -> b
$ [(a, a, [a])] -> (Graph, Int -> (a, a, [a]))
forall key node.
Ord key =>
[(node, key, [key])] -> (Graph, Int -> (node, key, [key]))
graphFromEdges' ([(a, a, [a])] -> (Graph, Int -> (a, a, [a])))
-> [(a, a, [a])] -> (Graph, Int -> (a, a, [a]))
forall a b. (a -> b) -> a -> b
$ (a -> (a, a, [a])) -> [a] -> [(a, a, [a])]
forall a b. (a -> b) -> [a] -> [b]
map (\a
k -> (a
k, a
k, a -> [a]
keyToEdgeList a
k)) [a]
keys