{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, MonadComprehensions #-}
module Math.FiniteCategories.SafeCompositionGraph
(
SCGMorphism(..),
getLabelS,
SafeCompositionGraph,
supportS,
lawS,
maxCycles,
safeCompositionGraph,
unsafeSafeCompositionGraph,
readSCGString,
unsafeReadSCGString,
readSCGFile,
unsafeReadSCGFile,
safeCompositionGraphFromCompositionGraph,
compositionGraphFromSafeCompositionGraph,
writeSCGString,
writeSCGFile,
unsafeReadSCGDString,
readSCGDString,
unsafeReadSCGDFile,
readSCGDFile,
writeSCGDString,
writeSCGDFile,
constructRandomSafeCompositionGraph,
defaultConstructRandomSafeCompositionGraph,
defaultConstructRandomSafeDiagram,
)
where
import Data.WeakSet (Set)
import qualified Data.WeakSet as Set
import Data.WeakSet.Safe
import Data.WeakMap (Map)
import qualified Data.WeakMap as Map
import Data.WeakMap.Safe
import Data.List (intercalate, elemIndex, splitAt)
import Data.Text (Text, singleton, cons, unpack, pack)
import Math.Category
import Math.FiniteCategory
import Math.FiniteCategories.CompositionGraph
import Math.FiniteCategoryError
import Math.IO.PrettyPrint
import Math.Categories.FinGrph
import Math.Categories.FunctorCategory
import System.Directory (createDirectoryIfMissing)
import System.FilePath.Posix (takeDirectory)
import System.Random (RandomGen, uniformR)
data SCGMorphism a b = SCGMorphism {forall a b. SCGMorphism a b -> Path a b
pathS :: Path a b
,forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS :: CompositionLaw a b
,forall a b. SCGMorphism a b -> Int
maxNbCycles :: Int} deriving (Int -> SCGMorphism a b -> ShowS
[SCGMorphism a b] -> ShowS
SCGMorphism a b -> String
(Int -> SCGMorphism a b -> ShowS)
-> (SCGMorphism a b -> String)
-> ([SCGMorphism a b] -> ShowS)
-> Show (SCGMorphism a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> SCGMorphism a b -> ShowS
forall a b. (Show a, Show b) => [SCGMorphism a b] -> ShowS
forall a b. (Show a, Show b) => SCGMorphism a b -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> SCGMorphism a b -> ShowS
showsPrec :: Int -> SCGMorphism a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => SCGMorphism a b -> String
show :: SCGMorphism a b -> String
$cshowList :: forall a b. (Show a, Show b) => [SCGMorphism a b] -> ShowS
showList :: [SCGMorphism a b] -> ShowS
Show, SCGMorphism a b -> SCGMorphism a b -> Bool
(SCGMorphism a b -> SCGMorphism a b -> Bool)
-> (SCGMorphism a b -> SCGMorphism a b -> Bool)
-> Eq (SCGMorphism a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
SCGMorphism a b -> SCGMorphism a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
SCGMorphism a b -> SCGMorphism a b -> Bool
== :: SCGMorphism a b -> SCGMorphism a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
SCGMorphism a b -> SCGMorphism a b -> Bool
/= :: SCGMorphism a b -> SCGMorphism a b -> Bool
Eq)
instance (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => PrettyPrint (SCGMorphism a b) where
pprint :: SCGMorphism a b -> String
pprint SCGMorphism {pathS :: forall a b. SCGMorphism a b -> Path a b
pathS=(a
s,[]),compositionLawS :: forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS=CompositionLaw a b
cl} = String
"Id"String -> ShowS
forall a. [a] -> [a] -> [a]
++(a -> String
forall a. PrettyPrint a => a -> String
pprint a
s)
pprint SCGMorphism {pathS :: forall a b. SCGMorphism a b -> Path a b
pathS=(a
_,RawPath a b
rp),compositionLawS :: forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS=CompositionLaw a b
cl} = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" o " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (b -> String
forall a. PrettyPrint a => a -> String
pprint(b -> String) -> (Arrow a b -> b) -> Arrow a b -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Arrow a b -> b
forall n e. Arrow n e -> e
labelArrow) (Arrow a b -> String) -> RawPath a b -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawPath a b
rp
getLabelS :: SCGMorphism a b -> Maybe b
getLabelS :: forall a b. SCGMorphism a b -> Maybe b
getLabelS SCGMorphism{pathS :: forall a b. SCGMorphism a b -> Path a b
pathS=(a
s,RawPath a b
rp), compositionLawS :: forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS=CompositionLaw a b
_, maxNbCycles :: forall a b. SCGMorphism a b -> Int
maxNbCycles=Int
_}
| RawPath a b -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null RawPath a b
rp = Maybe b
forall a. Maybe a
Nothing
| RawPath a b -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null(RawPath a b -> Bool)
-> (RawPath a b -> RawPath a b) -> RawPath a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RawPath a b -> RawPath a b
forall a. HasCallStack => [a] -> [a]
tail (RawPath a b -> Bool) -> RawPath a b -> Bool
forall a b. (a -> b) -> a -> b
$ RawPath a b
rp = b -> Maybe b
forall a. a -> Maybe a
Just (Arrow a b -> b
forall n e. Arrow n e -> e
labelArrow(Arrow a b -> b) -> (RawPath a b -> Arrow a b) -> RawPath a b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RawPath a b -> Arrow a b
forall a. HasCallStack => [a] -> a
head (RawPath a b -> b) -> RawPath a b -> b
forall a b. (a -> b) -> a -> b
$ RawPath a b
rp)
| Bool
otherwise = Maybe b
forall a. Maybe a
Nothing
rawpathToListOfVertices :: RawPath a b -> [a]
rawpathToListOfVertices :: forall a b. RawPath a b -> [a]
rawpathToListOfVertices [] = []
rawpathToListOfVertices [Arrow a b]
rp = ((Arrow a b -> a
forall n e. Arrow n e -> n
targetArrow(Arrow a b -> a) -> ([Arrow a b] -> Arrow a b) -> [Arrow a b] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Arrow a b] -> Arrow a b
forall a. HasCallStack => [a] -> a
head ([Arrow a b] -> a) -> [Arrow a b] -> a
forall a b. (a -> b) -> a -> b
$ [Arrow a b]
rp)a -> [a] -> [a]
forall a. a -> [a] -> [a]
:(Arrow a b -> a
forall n e. Arrow n e -> n
sourceArrow (Arrow a b -> a) -> [Arrow a b] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Arrow a b]
rp))
simplifyOnce :: (Eq a, Eq b) => CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplifyOnce :: forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplifyOnce CompositionLaw a b
_ Int
_ [] = []
simplifyOnce CompositionLaw a b
_ Int
_ [Arrow a b
e] = [Arrow a b
e]
simplifyOnce CompositionLaw a b
cl Int
nb RawPath a b
list
| RawPath a b
new_list RawPath a b -> RawPath a b -> Bool
forall a. Eq a => a -> a -> Bool
== [] = []
| Bool
isCycle Bool -> Bool -> Bool
&& Bool
tooManyCycles = []
| RawPath a b
new_list RawPath a b -> RawPath a b -> Bool
forall a. Eq a => a -> a -> Bool
/= RawPath a b
list = RawPath a b
new_list
| RawPath a b
simple_tail RawPath a b -> RawPath a b -> Bool
forall a. Eq a => a -> a -> Bool
/= (RawPath a b -> RawPath a b
forall a. HasCallStack => [a] -> [a]
tail RawPath a b
list) = (RawPath a b -> Arrow a b
forall a. HasCallStack => [a] -> a
head RawPath a b
list)Arrow a b -> RawPath a b -> RawPath a b
forall a. a -> [a] -> [a]
:RawPath a b
simple_tail
| RawPath a b
simple_init RawPath a b -> RawPath a b -> Bool
forall a. Eq a => a -> a -> Bool
/= (RawPath a b -> RawPath a b
forall a. HasCallStack => [a] -> [a]
init RawPath a b
list) = RawPath a b
simple_initRawPath a b -> RawPath a b -> RawPath a b
forall a. [a] -> [a] -> [a]
++[(RawPath a b -> Arrow a b
forall a. HasCallStack => [a] -> a
last RawPath a b
list)]
| Bool
otherwise = RawPath a b
list
where
listOfVertices :: [a]
listOfVertices = RawPath a b -> [a]
forall a b. RawPath a b -> [a]
rawpathToListOfVertices RawPath a b
list
isCycle :: Bool
isCycle = ([a] -> a
forall a. HasCallStack => [a] -> a
head [a]
listOfVertices) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== ([a] -> a
forall a. HasCallStack => [a] -> a
last [a]
listOfVertices)
tooManyCycles :: Bool
tooManyCycles = ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (([a] -> a
forall a. HasCallStack => [a] -> a
head [a]
listOfVertices) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) [a]
listOfVertices) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
nbInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
new_list :: RawPath a b
new_list = RawPath a b -> RawPath a b -> CompositionLaw a b -> RawPath a b
forall k a. Eq k => a -> k -> Map k a -> a
Map.findWithDefault RawPath a b
list RawPath a b
list CompositionLaw a b
cl
simple_tail :: RawPath a b
simple_tail = CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplifyOnce CompositionLaw a b
cl Int
nb (RawPath a b -> RawPath a b
forall a. HasCallStack => [a] -> [a]
tail RawPath a b
list)
simple_init :: RawPath a b
simple_init = CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplifyOnce CompositionLaw a b
cl Int
nb (RawPath a b -> RawPath a b
forall a. HasCallStack => [a] -> [a]
init RawPath a b
list)
simplify :: (Eq a, Eq b) => CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplify :: forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplify CompositionLaw a b
_ Int
_ [] = []
simplify CompositionLaw a b
cl Int
nb RawPath a b
rp
| RawPath a b
simple_one RawPath a b -> RawPath a b -> Bool
forall a. Eq a => a -> a -> Bool
== RawPath a b
rp = RawPath a b
rp
| Bool
otherwise = CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplify CompositionLaw a b
cl Int
nb RawPath a b
simple_one
where simple_one :: RawPath a b
simple_one = CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplifyOnce CompositionLaw a b
cl Int
nb RawPath a b
rp
instance (Eq a, Eq b) => Morphism (SCGMorphism a b) a where
@? :: SCGMorphism a b -> SCGMorphism a b -> Maybe (SCGMorphism a b)
(@?) m2 :: SCGMorphism a b
m2@SCGMorphism{pathS :: forall a b. SCGMorphism a b -> Path a b
pathS=(a
s2,[Arrow a b]
rp2), compositionLawS :: forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS=CompositionLaw a b
cl2, maxNbCycles :: forall a b. SCGMorphism a b -> Int
maxNbCycles=Int
nb2} m1 :: SCGMorphism a b
m1@SCGMorphism{pathS :: forall a b. SCGMorphism a b -> Path a b
pathS=(a
s1,[Arrow a b]
rp1), compositionLawS :: forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS=CompositionLaw a b
cl1, maxNbCycles :: forall a b. SCGMorphism a b -> Int
maxNbCycles=Int
nb1}
| Int
nb1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
nb2 = Maybe (SCGMorphism a b)
forall a. Maybe a
Nothing
| CompositionLaw a b
cl1 CompositionLaw a b -> CompositionLaw a b -> Bool
forall a. Eq a => a -> a -> Bool
/= CompositionLaw a b
cl2 = Maybe (SCGMorphism a b)
forall a. Maybe a
Nothing
| SCGMorphism a b -> a
forall m o. Morphism m o => m -> o
source SCGMorphism a b
m2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= SCGMorphism a b -> a
forall m o. Morphism m o => m -> o
target SCGMorphism a b
m1 = Maybe (SCGMorphism a b)
forall a. Maybe a
Nothing
| Bool
otherwise = SCGMorphism a b -> Maybe (SCGMorphism a b)
forall a. a -> Maybe a
Just SCGMorphism{pathS :: (a, [Arrow a b])
pathS=(a
s1,(CompositionLaw a b -> Int -> [Arrow a b] -> [Arrow a b]
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplify CompositionLaw a b
cl1 Int
nb1 ([Arrow a b]
rp2[Arrow a b] -> [Arrow a b] -> [Arrow a b]
forall a. [a] -> [a] -> [a]
++[Arrow a b]
rp1))), compositionLawS :: CompositionLaw a b
compositionLawS=CompositionLaw a b
cl1, maxNbCycles :: Int
maxNbCycles=Int
nb1}
source :: SCGMorphism a b -> a
source SCGMorphism{pathS :: forall a b. SCGMorphism a b -> Path a b
pathS=(a
s,[Arrow a b]
_), compositionLawS :: forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS=CompositionLaw a b
_, maxNbCycles :: forall a b. SCGMorphism a b -> Int
maxNbCycles=Int
_} = a
s
target :: SCGMorphism a b -> a
target SCGMorphism{pathS :: forall a b. SCGMorphism a b -> Path a b
pathS=(a
s,[]), compositionLawS :: forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS=CompositionLaw a b
_, maxNbCycles :: forall a b. SCGMorphism a b -> Int
maxNbCycles=Int
_} = a
s
target SCGMorphism{pathS :: forall a b. SCGMorphism a b -> Path a b
pathS=(a
_,[Arrow a b]
rp), compositionLawS :: forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS=CompositionLaw a b
_, maxNbCycles :: forall a b. SCGMorphism a b -> Int
maxNbCycles=Int
_} = Arrow a b -> a
forall n e. Arrow n e -> n
targetArrow ([Arrow a b] -> Arrow a b
forall a. HasCallStack => [a] -> a
head [Arrow a b]
rp)
mkSCGMorphism :: CompositionLaw a b -> Int -> Arrow a b -> SCGMorphism a b
mkSCGMorphism :: forall a b.
CompositionLaw a b -> Int -> Arrow a b -> SCGMorphism a b
mkSCGMorphism CompositionLaw a b
cl Int
nb Arrow a b
e = SCGMorphism {pathS :: Path a b
pathS=(Arrow a b -> a
forall n e. Arrow n e -> n
sourceArrow Arrow a b
e,[Arrow a b
e]),compositionLawS :: CompositionLaw a b
compositionLawS=CompositionLaw a b
cl, maxNbCycles :: Int
maxNbCycles=Int
nb}
findInwardEdges :: (Eq a) => Graph a b -> a -> Set (Arrow a b)
findInwardEdges :: forall a b. Eq a => Graph a b -> a -> Set (Arrow a b)
findInwardEdges Graph a b
g a
o = (Arrow a b -> Bool) -> Set (Arrow a b) -> Set (Arrow a b)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\Arrow a b
e -> (Arrow a b -> a
forall n e. Arrow n e -> n
targetArrow Arrow a b
e) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
o Bool -> Bool -> Bool
&& (Arrow a b -> a
forall n e. Arrow n e -> n
sourceArrow Arrow a b
e) a -> Set a -> Bool
forall a. Eq a => a -> Set a -> Bool
`isIn` (Graph a b -> Set a
forall n e. Graph n e -> Set n
nodes Graph a b
g)) (Graph a b -> Set (Arrow a b)
forall n e. Graph n e -> Set (Arrow n e)
edges Graph a b
g)
findAcyclicRawPaths :: (Eq a, Eq b) => Graph a b -> a -> a -> Set (RawPath a b)
findAcyclicRawPaths :: forall a b.
(Eq a, Eq b) =>
Graph a b -> a -> a -> Set (RawPath a b)
findAcyclicRawPaths Graph a b
g a
s a
t = Graph a b -> a -> a -> Set a -> Set [Arrow a b]
forall {t} {e}.
(Eq t, Eq e) =>
Graph t e -> t -> t -> Set t -> Set [Arrow t e]
findAcyclicRawPathsVisitedNodes Graph a b
g a
s a
t Set a
forall a. Set a
Set.empty where
findAcyclicRawPathsVisitedNodes :: Graph t e -> t -> t -> Set t -> Set [Arrow t e]
findAcyclicRawPathsVisitedNodes Graph t e
g t
s t
t Set t
v
| t
t t -> Set t -> Bool
forall a. Eq a => a -> Set a -> Bool
`isIn` Set t
v = Set [Arrow t e]
forall a. Set a
Set.empty
| t
s t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
t = [[Arrow t e]] -> Set [Arrow t e]
forall a. [a] -> Set a
set [[]]
| Bool
otherwise = [[Arrow t e]] -> Set [Arrow t e]
forall a. [a] -> Set a
set ([[[Arrow t e]]] -> [[Arrow t e]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((([[Arrow t e]] -> [[Arrow t e]])
-> [[Arrow t e]] -> [[Arrow t e]])
-> [[[Arrow t e]] -> [[Arrow t e]]]
-> [[[Arrow t e]]]
-> [[[Arrow t e]]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([[Arrow t e]] -> [[Arrow t e]]) -> [[Arrow t e]] -> [[Arrow t e]]
forall a b. (a -> b) -> a -> b
($) ((([Arrow t e] -> [Arrow t e]) -> [[Arrow t e]] -> [[Arrow t e]])
-> [[Arrow t e] -> [Arrow t e]] -> [[[Arrow t e]] -> [[Arrow t e]]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Arrow t e] -> [Arrow t e]) -> [[Arrow t e]] -> [[Arrow t e]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Arrow t e -> [Arrow t e] -> [Arrow t e])
-> [Arrow t e] -> [[Arrow t e] -> [Arrow t e]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:) [Arrow t e]
inwardEdges)) ((Arrow t e -> [[Arrow t e]]) -> [Arrow t e] -> [[[Arrow t e]]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Arrow t e
x -> Set [Arrow t e] -> [[Arrow t e]]
forall a. Eq a => Set a -> [a]
setToList (Graph t e -> t -> t -> Set t -> Set [Arrow t e]
findAcyclicRawPathsVisitedNodes Graph t e
g t
s (Arrow t e -> t
forall n e. Arrow n e -> n
sourceArrow Arrow t e
x) (t -> Set t -> Set t
forall a. a -> Set a -> Set a
Set.insert t
t Set t
v))) [Arrow t e]
inwardEdges)))
where
inwardEdges :: [Arrow t e]
inwardEdges = (Set (Arrow t e) -> [Arrow t e]
forall a. Eq a => Set a -> [a]
setToList (Graph t e -> t -> Set (Arrow t e)
forall a b. Eq a => Graph a b -> a -> Set (Arrow a b)
findInwardEdges Graph t e
g t
t))
findElementaryCycles :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
findElementaryCycles :: forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
findElementaryCycles Graph a b
g CompositionLaw a b
cl Int
nb a
o = [[Arrow a b]] -> Set [Arrow a b]
forall a. [a] -> Set a
set ([[Arrow a b]] -> Set [Arrow a b])
-> [[Arrow a b]] -> Set [Arrow a b]
forall a b. (a -> b) -> a -> b
$ (CompositionLaw a b -> Int -> [Arrow a b] -> [Arrow a b]
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplify CompositionLaw a b
cl Int
nb ([Arrow a b] -> [Arrow a b]) -> [[Arrow a b]] -> [[Arrow a b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [][Arrow a b] -> [[Arrow a b]] -> [[Arrow a b]]
forall a. a -> [a] -> [a]
:([[[Arrow a b]]] -> [[Arrow a b]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (([Arrow a b -> [Arrow a b]] -> Arrow a b -> [[Arrow a b]])
-> [[Arrow a b -> [Arrow a b]]] -> [Arrow a b] -> [[[Arrow a b]]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Arrow a b -> [Arrow a b]] -> Arrow a b -> [[Arrow a b]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (([[Arrow a b]] -> [Arrow a b -> [Arrow a b]])
-> [[[Arrow a b]]] -> [[Arrow a b -> [Arrow a b]]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Arrow a b] -> Arrow a b -> [Arrow a b])
-> [[Arrow a b]] -> [Arrow a b -> [Arrow a b]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Arrow a b]
x Arrow a b
y -> (Arrow a b
yArrow a b -> [Arrow a b] -> [Arrow a b]
forall a. a -> [a] -> [a]
:[Arrow a b]
x))) ((Arrow a b -> [[Arrow a b]]) -> [Arrow a b] -> [[[Arrow a b]]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Arrow a b
x -> Set [Arrow a b] -> [[Arrow a b]]
forall a. Eq a => Set a -> [a]
setToList (Graph a b -> a -> a -> Set [Arrow a b]
forall a b.
(Eq a, Eq b) =>
Graph a b -> a -> a -> Set (RawPath a b)
findAcyclicRawPaths Graph a b
g a
o (Arrow a b -> a
forall n e. Arrow n e -> n
sourceArrow Arrow a b
x))) [Arrow a b]
inEdges)) [Arrow a b]
inEdges)))
where
inEdges :: [Arrow a b]
inEdges = (Set (Arrow a b) -> [Arrow a b]
forall a. Eq a => Set a -> [a]
setToList (Graph a b -> a -> Set (Arrow a b)
forall a b. Eq a => Graph a b -> a -> Set (Arrow a b)
findInwardEdges Graph a b
g a
o))
findCycles :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
findCycles :: forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
findCycles Graph a b
g CompositionLaw a b
cl Int
nb a
o = Graph a b
-> CompositionLaw a b
-> a
-> Set (RawPath a b)
-> Set (RawPath a b)
forall {t} {b}.
(Eq t, Eq b) =>
Graph t b
-> Map (RawPath t b) (RawPath t b)
-> t
-> Set (RawPath t b)
-> Set (RawPath t b)
findCyclesWithPreviousCycles Graph a b
g CompositionLaw a b
cl a
o (Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
findElementaryCycles Graph a b
g CompositionLaw a b
cl Int
nb a
o)
where
findCyclesWithPreviousCycles :: Graph t b
-> Map (RawPath t b) (RawPath t b)
-> t
-> Set (RawPath t b)
-> Set (RawPath t b)
findCyclesWithPreviousCycles Graph t b
g Map (RawPath t b) (RawPath t b)
cl t
o Set (RawPath t b)
p
| Set (RawPath t b)
newCycles Set (RawPath t b) -> Set (RawPath t b) -> Bool
forall a. Eq a => a -> a -> Bool
== Set (RawPath t b)
p = Set (RawPath t b)
newCycles
| Bool
otherwise = Graph t b
-> Map (RawPath t b) (RawPath t b)
-> t
-> Set (RawPath t b)
-> Set (RawPath t b)
findCyclesWithPreviousCycles Graph t b
g Map (RawPath t b) (RawPath t b)
cl t
o Set (RawPath t b)
newCycles
where
newCycles :: Set (RawPath t b)
newCycles = (Map (RawPath t b) (RawPath t b)
-> Int -> RawPath t b -> RawPath t b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplify Map (RawPath t b) (RawPath t b)
cl Int
nb) (RawPath t b -> RawPath t b)
-> Set (RawPath t b) -> Set (RawPath t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RawPath t b -> RawPath t b -> RawPath t b
forall a. [a] -> [a] -> [a]
(++) (RawPath t b -> RawPath t b -> RawPath t b)
-> Set (RawPath t b) -> Set (RawPath t b -> RawPath t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (RawPath t b)
p Set (RawPath t b -> RawPath t b)
-> Set (RawPath t b) -> Set (RawPath t b)
forall a b. Set (a -> b) -> Set a -> Set b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Graph t b
-> Map (RawPath t b) (RawPath t b) -> Int -> t -> Set (RawPath t b)
forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
findElementaryCycles Graph t b
g Map (RawPath t b) (RawPath t b)
cl Int
nb t
o)
intertwine :: [a] -> [a] -> [a]
intertwine :: forall a. [a] -> [a] -> [a]
intertwine [] [a]
l = [a]
l
intertwine [a]
l [] = [a]
l
intertwine l1 :: [a]
l1@(a
x1:[a]
xs1) l2 :: [a]
l2@(a
x2:[a]
xs2) = (a
x1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a
x2a -> [a] -> [a]
forall a. a -> [a] -> [a]
:([a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
intertwine [a]
xs1 [a]
xs2)))
intertwineWithCycles :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> Int -> a -> RawPath a b -> Set (RawPath a b)
intertwineWithCycles :: forall a b.
(Eq a, Eq b) =>
Graph a b
-> CompositionLaw a b
-> Int
-> a
-> RawPath a b
-> Set (RawPath a b)
intertwineWithCycles Graph a b
g CompositionLaw a b
cl Int
nb a
_ p :: [Arrow a b]
p@(Arrow a b
x:[Arrow a b]
xs) = [[Arrow a b]] -> Set [Arrow a b]
forall a. [a] -> Set a
set ([[Arrow a b]] -> Set [Arrow a b])
-> [[Arrow a b]] -> Set [Arrow a b]
forall a b. (a -> b) -> a -> b
$ [[Arrow a b]] -> [Arrow a b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Arrow a b]] -> [Arrow a b]) -> [[[Arrow a b]]] -> [[Arrow a b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((([[Arrow a b]] -> [[Arrow a b]] -> [[Arrow a b]])
-> ([[Arrow a b]], [[Arrow a b]]) -> [[Arrow a b]]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [[Arrow a b]] -> [[Arrow a b]] -> [[Arrow a b]]
forall a. [a] -> [a] -> [a]
intertwine) (([[Arrow a b]], [[Arrow a b]]) -> [[Arrow a b]])
-> [([[Arrow a b]], [[Arrow a b]])] -> [[[Arrow a b]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[[Arrow a b]]]
-> [[[Arrow a b]]] -> [([[Arrow a b]], [[Arrow a b]])]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set [[Arrow a b]] -> [[[Arrow a b]]]
forall a. Eq a => Set a -> [a]
setToList Set [[Arrow a b]]
prodCycles) ([[Arrow a b]] -> [[[Arrow a b]]]
forall a. a -> [a]
repeat ((Arrow a b -> [Arrow a b] -> [Arrow a b]
forall a. a -> [a] -> [a]
:[]) (Arrow a b -> [Arrow a b]) -> [Arrow a b] -> [[Arrow a b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Arrow a b]
p))) where
prodCycles :: Set [[Arrow a b]]
prodCycles = [Set [Arrow a b]] -> Set [[Arrow a b]]
forall (m :: * -> *) a.
(Monoid (m a), Monad m, Foldable m, Eq a) =>
m (Set a) -> Set (m a)
cartesianProductOfSets [Set [Arrow a b]]
cycles
cycles :: [Set [Arrow a b]]
cycles = ((Graph a b -> CompositionLaw a b -> Int -> a -> Set [Arrow a b]
forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
findCycles Graph a b
g CompositionLaw a b
cl Int
nb (Arrow a b -> a
forall n e. Arrow n e -> n
targetArrow Arrow a b
x)))Set [Arrow a b] -> [Set [Arrow a b]] -> [Set [Arrow a b]]
forall a. a -> [a] -> [a]
:(((\Arrow a b
y -> (Graph a b -> CompositionLaw a b -> Int -> a -> Set [Arrow a b]
forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
findCycles Graph a b
g CompositionLaw a b
cl Int
nb (Arrow a b -> a
forall n e. Arrow n e -> n
sourceArrow Arrow a b
y)))) (Arrow a b -> Set [Arrow a b]) -> [Arrow a b] -> [Set [Arrow a b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Arrow a b]
p)
intertwineWithCycles Graph a b
g CompositionLaw a b
cl Int
nb a
s [] = (Graph a b -> CompositionLaw a b -> Int -> a -> Set [Arrow a b]
forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> Int -> a -> Set (RawPath a b)
findCycles Graph a b
g CompositionLaw a b
cl Int
nb a
s)
mkAr :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> Int -> a -> a -> Set (SCGMorphism a b)
mkAr :: forall a b.
(Eq a, Eq b) =>
Graph a b
-> CompositionLaw a b -> Int -> a -> a -> Set (SCGMorphism a b)
mkAr Graph a b
g CompositionLaw a b
cl Int
nb a
s a
t = (\RawPath a b
p -> SCGMorphism{pathS :: Path a b
pathS=(a
s,RawPath a b
p),compositionLawS :: CompositionLaw a b
compositionLawS=CompositionLaw a b
cl,maxNbCycles :: Int
maxNbCycles=Int
nb}) (RawPath a b -> SCGMorphism a b)
-> Set (RawPath a b) -> Set (SCGMorphism a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (RawPath a b)
allPaths where
acyclicPaths :: Set (RawPath a b)
acyclicPaths = (CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplify CompositionLaw a b
cl Int
nb) (RawPath a b -> RawPath a b)
-> Set (RawPath a b) -> Set (RawPath a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Graph a b -> a -> a -> Set (RawPath a b)
forall a b.
(Eq a, Eq b) =>
Graph a b -> a -> a -> Set (RawPath a b)
findAcyclicRawPaths Graph a b
g a
s a
t)
allPaths :: Set (RawPath a b)
allPaths = (CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplify CompositionLaw a b
cl Int
nb (RawPath a b -> RawPath a b)
-> Set (RawPath a b) -> Set (RawPath a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Set (RawPath a b)] -> Set (RawPath a b)
forall (f :: * -> *) a. Foldable f => f (Set a) -> Set a
Set.unions (Set (Set (RawPath a b)) -> [Set (RawPath a b)]
forall a. Eq a => Set a -> [a]
setToList ((Graph a b
-> CompositionLaw a b
-> Int
-> a
-> RawPath a b
-> Set (RawPath a b)
forall a b.
(Eq a, Eq b) =>
Graph a b
-> CompositionLaw a b
-> Int
-> a
-> RawPath a b
-> Set (RawPath a b)
intertwineWithCycles Graph a b
g CompositionLaw a b
cl Int
nb a
s) (RawPath a b -> Set (RawPath a b))
-> Set (RawPath a b) -> Set (Set (RawPath a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (RawPath a b)
acyclicPaths)))
data SafeCompositionGraph a b = SafeCompositionGraph {
forall a b. SafeCompositionGraph a b -> Graph a b
supportS :: Graph a b,
forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS :: CompositionLaw a b,
forall a b. SafeCompositionGraph a b -> Int
maxCycles :: Int
} deriving (SafeCompositionGraph a b -> SafeCompositionGraph a b -> Bool
(SafeCompositionGraph a b -> SafeCompositionGraph a b -> Bool)
-> (SafeCompositionGraph a b -> SafeCompositionGraph a b -> Bool)
-> Eq (SafeCompositionGraph a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
SafeCompositionGraph a b -> SafeCompositionGraph a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
SafeCompositionGraph a b -> SafeCompositionGraph a b -> Bool
== :: SafeCompositionGraph a b -> SafeCompositionGraph a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
SafeCompositionGraph a b -> SafeCompositionGraph a b -> Bool
/= :: SafeCompositionGraph a b -> SafeCompositionGraph a b -> Bool
Eq)
instance (Show a, Show b) => Show (SafeCompositionGraph a b) where
show :: SafeCompositionGraph a b -> String
show SafeCompositionGraph a b
scg = String
"(unsafeSafeCompositionGraph "String -> ShowS
forall a. [a] -> [a] -> [a]
++ Graph a b -> String
forall a. Show a => a -> String
show (SafeCompositionGraph a b -> Graph a b
forall a b. SafeCompositionGraph a b -> Graph a b
supportS SafeCompositionGraph a b
scg) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CompositionLaw a b -> String
forall a. Show a => a -> String
show (SafeCompositionGraph a b -> CompositionLaw a b
forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS SafeCompositionGraph a b
scg) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (SafeCompositionGraph a b -> Int
forall a b. SafeCompositionGraph a b -> Int
maxCycles SafeCompositionGraph a b
scg) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
instance (Eq a, Eq b) => Category (SafeCompositionGraph a b) (SCGMorphism a b) a where
identity :: Morphism (SCGMorphism a b) a =>
SafeCompositionGraph a b -> a -> SCGMorphism a b
identity SafeCompositionGraph a b
c a
x
| a
x a -> Set a -> Bool
forall a. Eq a => a -> Set a -> Bool
`isIn` (Graph a b -> Set a
forall n e. Graph n e -> Set n
nodes (SafeCompositionGraph a b -> Graph a b
forall a b. SafeCompositionGraph a b -> Graph a b
supportS SafeCompositionGraph a b
c)) = SCGMorphism {pathS :: Path a b
pathS=(a
x,[]),compositionLawS :: CompositionLaw a b
compositionLawS=(SafeCompositionGraph a b -> CompositionLaw a b
forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS SafeCompositionGraph a b
c), maxNbCycles :: Int
maxNbCycles = SafeCompositionGraph a b -> Int
forall a b. SafeCompositionGraph a b -> Int
maxCycles SafeCompositionGraph a b
c}
| Bool
otherwise = String -> SCGMorphism a b
forall a. HasCallStack => String -> a
error (String
"Math.FiniteCategories.SafeCompositionGraph.identity: Trying to construct identity of an unknown object.")
ar :: Morphism (SCGMorphism a b) a =>
SafeCompositionGraph a b -> a -> a -> Set (SCGMorphism a b)
ar SafeCompositionGraph a b
c a
s a
t = Graph a b
-> CompositionLaw a b -> Int -> a -> a -> Set (SCGMorphism a b)
forall a b.
(Eq a, Eq b) =>
Graph a b
-> CompositionLaw a b -> Int -> a -> a -> Set (SCGMorphism a b)
mkAr (SafeCompositionGraph a b -> Graph a b
forall a b. SafeCompositionGraph a b -> Graph a b
supportS SafeCompositionGraph a b
c) (SafeCompositionGraph a b -> CompositionLaw a b
forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS SafeCompositionGraph a b
c) (SafeCompositionGraph a b -> Int
forall a b. SafeCompositionGraph a b -> Int
maxCycles SafeCompositionGraph a b
c) a
s a
t
genAr :: Morphism (SCGMorphism a b) a =>
SafeCompositionGraph a b -> a -> a -> Set (SCGMorphism a b)
genAr SafeCompositionGraph a b
cg a
s a
t
| a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
t = SCGMorphism a b -> Set (SCGMorphism a b) -> Set (SCGMorphism a b)
forall a. a -> Set a -> Set a
Set.insert (SafeCompositionGraph a b -> a -> SCGMorphism a b
forall c m o. (Category c m o, Morphism m o) => c -> o -> m
identity SafeCompositionGraph a b
cg a
s) Set (SCGMorphism a b)
gen
| Bool
otherwise = Set (SCGMorphism a b)
gen
where gen :: Set (SCGMorphism a b)
gen = CompositionLaw a b -> Int -> Arrow a b -> SCGMorphism a b
forall a b.
CompositionLaw a b -> Int -> Arrow a b -> SCGMorphism a b
mkSCGMorphism (SafeCompositionGraph a b -> CompositionLaw a b
forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS SafeCompositionGraph a b
cg) (SafeCompositionGraph a b -> Int
forall a b. SafeCompositionGraph a b -> Int
maxCycles SafeCompositionGraph a b
cg) (Arrow a b -> SCGMorphism a b)
-> Set (Arrow a b) -> Set (SCGMorphism a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Arrow a b -> Bool) -> Set (Arrow a b) -> Set (Arrow a b)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\Arrow a b
a -> a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (Arrow a b -> a
forall n e. Arrow n e -> n
sourceArrow Arrow a b
a) Bool -> Bool -> Bool
&& a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (Arrow a b -> a
forall n e. Arrow n e -> n
targetArrow Arrow a b
a)) (Set (Arrow a b) -> Set (Arrow a b))
-> Set (Arrow a b) -> Set (Arrow a b)
forall a b. (a -> b) -> a -> b
$ (Graph a b -> Set (Arrow a b)
forall n e. Graph n e -> Set (Arrow n e)
edges (SafeCompositionGraph a b -> Graph a b
forall a b. SafeCompositionGraph a b -> Graph a b
supportS SafeCompositionGraph a b
cg)))
decompose :: Morphism (SCGMorphism a b) a =>
SafeCompositionGraph a b -> SCGMorphism a b -> [SCGMorphism a b]
decompose SafeCompositionGraph a b
c m :: SCGMorphism a b
m@SCGMorphism{pathS :: forall a b. SCGMorphism a b -> Path a b
pathS=(a
_,[Arrow a b]
rp),compositionLawS :: forall a b. SCGMorphism a b -> CompositionLaw a b
compositionLawS=CompositionLaw a b
l,maxNbCycles :: forall a b. SCGMorphism a b -> Int
maxNbCycles=Int
nb}
| SafeCompositionGraph a b -> SCGMorphism a b -> Bool
forall c m o.
(Category c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isIdentity SafeCompositionGraph a b
c SCGMorphism a b
m = [SCGMorphism a b
m]
| Bool
otherwise = CompositionLaw a b -> Int -> Arrow a b -> SCGMorphism a b
forall a b.
CompositionLaw a b -> Int -> Arrow a b -> SCGMorphism a b
mkSCGMorphism CompositionLaw a b
l Int
nb (Arrow a b -> SCGMorphism a b) -> [Arrow a b] -> [SCGMorphism a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Arrow a b]
rp
instance (Eq a, Eq b) => FiniteCategory (SafeCompositionGraph a b) (SCGMorphism a b) a where
ob :: SafeCompositionGraph a b -> Set a
ob = (Graph a b -> Set a
forall n e. Graph n e -> Set n
nodes(Graph a b -> Set a)
-> (SafeCompositionGraph a b -> Graph a b)
-> SafeCompositionGraph a b
-> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SafeCompositionGraph a b -> Graph a b
forall a b. SafeCompositionGraph a b -> Graph a b
supportS)
instance (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => PrettyPrint (SafeCompositionGraph a b) where
pprint :: SafeCompositionGraph a b -> String
pprint SafeCompositionGraph{supportS :: forall a b. SafeCompositionGraph a b -> Graph a b
supportS=Graph a b
g,lawS :: forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS=CompositionLaw a b
l,maxCycles :: forall a b. SafeCompositionGraph a b -> Int
maxCycles=Int
nb} = String
"SafeCompositionGraph("String -> ShowS
forall a. [a] -> [a] -> [a]
++Graph a b -> String
forall a. PrettyPrint a => a -> String
pprint Graph a b
gString -> ShowS
forall a. [a] -> [a] -> [a]
++String
","String -> ShowS
forall a. [a] -> [a] -> [a]
++CompositionLaw a b -> String
forall a. PrettyPrint a => a -> String
pprint CompositionLaw a b
lString -> ShowS
forall a. [a] -> [a] -> [a]
++String
","String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. PrettyPrint a => a -> String
pprint Int
nbString -> ShowS
forall a. [a] -> [a] -> [a]
++String
")"
safeCompositionGraph :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> Int -> Either (FiniteCategoryError (SCGMorphism a b) a) (SafeCompositionGraph a b)
safeCompositionGraph :: forall a b.
(Eq a, Eq b) =>
Graph a b
-> CompositionLaw a b
-> Int
-> Either
(FiniteCategoryError (SCGMorphism a b) a)
(SafeCompositionGraph a b)
safeCompositionGraph Graph a b
g CompositionLaw a b
l Int
nb
| Maybe (FiniteCategoryError (SCGMorphism a b) a) -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (FiniteCategoryError (SCGMorphism a b) a)
check = SafeCompositionGraph a b
-> Either
(FiniteCategoryError (SCGMorphism a b) a)
(SafeCompositionGraph a b)
forall a b. b -> Either a b
Right SafeCompositionGraph a b
c_g
| Bool
otherwise = FiniteCategoryError (SCGMorphism a b) a
-> Either
(FiniteCategoryError (SCGMorphism a b) a)
(SafeCompositionGraph a b)
forall a b. a -> Either a b
Left FiniteCategoryError (SCGMorphism a b) a
err
where
c_g :: SafeCompositionGraph a b
c_g = SafeCompositionGraph{supportS :: Graph a b
supportS = Graph a b
g, lawS :: CompositionLaw a b
lawS = CompositionLaw a b
l, maxCycles :: Int
maxCycles = Int
nb}
check :: Maybe (FiniteCategoryError (SCGMorphism a b) a)
check = SafeCompositionGraph a b
-> Maybe (FiniteCategoryError (SCGMorphism a b) a)
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> Maybe (FiniteCategoryError m o)
checkFiniteCategory SafeCompositionGraph a b
c_g
Just FiniteCategoryError (SCGMorphism a b) a
err = Maybe (FiniteCategoryError (SCGMorphism a b) a)
check
unsafeSafeCompositionGraph :: Graph a b -> CompositionLaw a b -> Int -> SafeCompositionGraph a b
unsafeSafeCompositionGraph :: forall a b.
Graph a b -> CompositionLaw a b -> Int -> SafeCompositionGraph a b
unsafeSafeCompositionGraph Graph a b
g CompositionLaw a b
l Int
nb = SafeCompositionGraph{supportS :: Graph a b
supportS = Graph a b
g, lawS :: CompositionLaw a b
lawS = CompositionLaw a b
l, maxCycles :: Int
maxCycles = Int
nb}
data Token = Name Text | BeginArrow | EndArrow | Equals | Identity | BeginSrc | EndSrc | BeginTgt | EndTgt | MapsTo deriving (Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
/= :: Token -> Token -> Bool
Eq, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Token -> ShowS
showsPrec :: Int -> Token -> ShowS
$cshow :: Token -> String
show :: Token -> String
$cshowList :: [Token] -> ShowS
showList :: [Token] -> ShowS
Show)
strip :: Token -> Token
strip :: Token -> Token
strip (Name Text
txt) = Text -> Token
Name (String -> Text
pack(String -> Text) -> ShowS -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowS
forall a. [a] -> [a]
reverseShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowS
stripLeftShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowS
forall a. [a] -> [a]
reverseShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowS
stripLeft (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
str)
where
str :: String
str = Text -> String
unpack Text
txt
stripLeft :: ShowS
stripLeft (Char
' ':String
s) = String
s
stripLeft String
s = String
s
strip Token
x = Token
x
parserLex :: String -> [Token]
parserLex :: String -> [Token]
parserLex String
str = Token -> Token
strip (Token -> Token) -> [Token] -> [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [Token]
parserLexHelper String
str
where
parserLexHelper :: String -> [Token]
parserLexHelper [] = []
parserLexHelper (Char
'#':String
str) = []
parserLexHelper (Char
' ':Char
'-':String
str) = Token
BeginArrow Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
parserLexHelper (Char
'-':Char
'>':Char
' ':String
str) = Token
EndArrow Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
parserLexHelper (Char
' ':Char
'=':Char
' ':String
str) = Token
Equals Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
parserLexHelper (Char
'<':Char
'I':Char
'D':Char
'/':Char
'>':String
str) = Token
Identity Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
parserLexHelper (Char
'<':Char
'I':Char
'D':Char
'>':String
str) = Token
Identity Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
parserLexHelper (Char
'<':Char
'S':Char
'R':Char
'C':Char
'>':String
str) = Token
BeginSrc Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
parserLexHelper (Char
'<':Char
'T':Char
'G':Char
'T':Char
'>':String
str) = Token
BeginTgt Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
parserLexHelper (Char
'<':Char
'/':Char
'S':Char
'R':Char
'C':Char
'>':String
str) = Token
EndSrc Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
parserLexHelper (Char
'<':Char
'/':Char
'T':Char
'G':Char
'T':Char
'>':String
str) = Token
EndTgt Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
parserLexHelper (Char
' ':Char
'=':Char
'>':Char
' ':String
str) = Token
MapsTo Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (String -> [Token]
parserLexHelper String
str)
parserLexHelper (Char
c:String
str) = ([Token] -> [Token]
result [Token]
restLexed)
where
restLexed :: [Token]
restLexed = (String -> [Token]
parserLexHelper String
str)
result :: [Token] -> [Token]
result (Name Text
txt:[Token]
xs) = (Text -> Token
Name (Char -> Text -> Text
cons Char
c Text
txt)Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
xs)
result [Token]
a = ((Text -> Token
Name (Char -> Text
singleton Char
c))Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
a)
type SCG = SafeCompositionGraph Text Text
readSCGString :: String -> Either (FiniteCategoryError (SCGMorphism Text Text) Text) SCG
readSCGString :: String
-> Either
(FiniteCategoryError (SCGMorphism Text Text) Text)
(SafeCompositionGraph Text Text)
readSCGString String
str
| Maybe (FiniteCategoryError (SCGMorphism Text Text) Text) -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
check = SafeCompositionGraph Text Text
-> Either
(FiniteCategoryError (SCGMorphism Text Text) Text)
(SafeCompositionGraph Text Text)
forall a b. b -> Either a b
Right SafeCompositionGraph Text Text
scg
| Bool
otherwise = FiniteCategoryError (SCGMorphism Text Text) Text
-> Either
(FiniteCategoryError (SCGMorphism Text Text) Text)
(SafeCompositionGraph Text Text)
forall a b. a -> Either a b
Left FiniteCategoryError (SCGMorphism Text Text) Text
err
where
maxCyc :: Int
maxCyc = (String -> Int
forall a. Read a => String -> a
read(String -> Int) -> ShowS -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[String] -> String
forall a. HasCallStack => [a] -> a
head([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [String]
lines (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
str) :: Int
cg :: CG
cg = String -> CG
unsafeReadCGString ((String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n")([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[String] -> [String]
forall a. HasCallStack => [a] -> [a]
tail([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [String]
lines ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
str)
scg :: SafeCompositionGraph Text Text
scg = SafeCompositionGraph{supportS :: Graph Text Text
supportS = CG -> Graph Text Text
forall a b. CompositionGraph a b -> Graph a b
support CG
cg, lawS :: CompositionLaw Text Text
lawS = CG -> CompositionLaw Text Text
forall a b. CompositionGraph a b -> CompositionLaw a b
law CG
cg, maxCycles :: Int
maxCycles = Int
maxCyc}
check :: Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
check = SafeCompositionGraph Text Text
-> Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> Maybe (FiniteCategoryError m o)
checkFiniteCategory SafeCompositionGraph Text Text
scg
Just FiniteCategoryError (SCGMorphism Text Text) Text
err = Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
check
unsafeReadSCGString :: String -> SCG
unsafeReadSCGString :: String -> SafeCompositionGraph Text Text
unsafeReadSCGString String
str = SafeCompositionGraph Text Text
scg
where
maxCyc :: Int
maxCyc = (String -> Int
forall a. Read a => String -> a
read(String -> Int) -> ShowS -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[String] -> String
forall a. HasCallStack => [a] -> a
head([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [String]
lines (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
str) :: Int
cg :: CG
cg = String -> CG
unsafeReadCGString ((String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n")([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[String] -> [String]
forall a. HasCallStack => [a] -> [a]
tail([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [String]
lines ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
str)
scg :: SafeCompositionGraph Text Text
scg = SafeCompositionGraph{supportS :: Graph Text Text
supportS = CG -> Graph Text Text
forall a b. CompositionGraph a b -> Graph a b
support CG
cg, lawS :: CompositionLaw Text Text
lawS = CG -> CompositionLaw Text Text
forall a b. CompositionGraph a b -> CompositionLaw a b
law CG
cg, maxCycles :: Int
maxCycles = Int
maxCyc}
unsafeReadSCGFile :: String -> IO SCG
unsafeReadSCGFile :: String -> IO (SafeCompositionGraph Text Text)
unsafeReadSCGFile String
path = do
String
file <- String -> IO String
readFile String
path
SafeCompositionGraph Text Text
-> IO (SafeCompositionGraph Text Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SafeCompositionGraph Text Text
-> IO (SafeCompositionGraph Text Text))
-> SafeCompositionGraph Text Text
-> IO (SafeCompositionGraph Text Text)
forall a b. (a -> b) -> a -> b
$ String -> SafeCompositionGraph Text Text
unsafeReadSCGString String
file
readSCGFile :: String -> IO (Either (FiniteCategoryError (SCGMorphism Text Text) Text) SCG)
readSCGFile :: String
-> IO
(Either
(FiniteCategoryError (SCGMorphism Text Text) Text)
(SafeCompositionGraph Text Text))
readSCGFile String
str = do
SafeCompositionGraph Text Text
scg <- String -> IO (SafeCompositionGraph Text Text)
unsafeReadSCGFile String
str
let check :: Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
check = SafeCompositionGraph Text Text
-> Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> Maybe (FiniteCategoryError m o)
checkFiniteCategory SafeCompositionGraph Text Text
scg
Either
(FiniteCategoryError (SCGMorphism Text Text) Text)
(SafeCompositionGraph Text Text)
-> IO
(Either
(FiniteCategoryError (SCGMorphism Text Text) Text)
(SafeCompositionGraph Text Text))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (if Maybe (FiniteCategoryError (SCGMorphism Text Text) Text) -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
check then SafeCompositionGraph Text Text
-> Either
(FiniteCategoryError (SCGMorphism Text Text) Text)
(SafeCompositionGraph Text Text)
forall a b. b -> Either a b
Right SafeCompositionGraph Text Text
scg else FiniteCategoryError (SCGMorphism Text Text) Text
-> Either
(FiniteCategoryError (SCGMorphism Text Text) Text)
(SafeCompositionGraph Text Text)
forall a b. a -> Either a b
Left (FiniteCategoryError (SCGMorphism Text Text) Text
-> Either
(FiniteCategoryError (SCGMorphism Text Text) Text)
(SafeCompositionGraph Text Text))
-> FiniteCategoryError (SCGMorphism Text Text) Text
-> Either
(FiniteCategoryError (SCGMorphism Text Text) Text)
(SafeCompositionGraph Text Text)
forall a b. (a -> b) -> a -> b
$ Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
-> FiniteCategoryError (SCGMorphism Text Text) Text
forall {a}. Maybe a -> a
fromJust (Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
-> FiniteCategoryError (SCGMorphism Text Text) Text)
-> Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
-> FiniteCategoryError (SCGMorphism Text Text) Text
forall a b. (a -> b) -> a -> b
$ Maybe (FiniteCategoryError (SCGMorphism Text Text) Text)
check)
where
fromJust :: Maybe a -> a
fromJust (Just a
x) = a
x
reversedRawPathToString :: (PrettyPrint a, PrettyPrint b) => RawPath a b -> String
reversedRawPathToString :: forall a b. (PrettyPrint a, PrettyPrint b) => RawPath a b -> String
reversedRawPathToString [] = String
"<ID>"
reversedRawPathToString [Arrow{sourceArrow :: forall n e. Arrow n e -> n
sourceArrow = a
s, targetArrow :: forall n e. Arrow n e -> n
targetArrow = a
t,labelArrow :: forall n e. Arrow n e -> e
labelArrow = b
l}] = a -> String
forall a. PrettyPrint a => a -> String
pprint a
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -" String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. PrettyPrint a => a -> String
pprint b
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. PrettyPrint a => a -> String
pprint a
t
reversedRawPathToString (Arrow{sourceArrow :: forall n e. Arrow n e -> n
sourceArrow = a
s, targetArrow :: forall n e. Arrow n e -> n
targetArrow = a
t,labelArrow :: forall n e. Arrow n e -> e
labelArrow = b
l}:[Arrow a b]
xs) = a -> String
forall a. PrettyPrint a => a -> String
pprint a
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -" String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. PrettyPrint a => a -> String
pprint b
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Arrow a b] -> String
forall a b. (PrettyPrint a, PrettyPrint b) => RawPath a b -> String
reversedRawPathToString [Arrow a b]
xs
writeSCGString :: (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => SafeCompositionGraph a b -> String
writeSCGString :: forall a b.
(PrettyPrint a, PrettyPrint b, Eq a, Eq b) =>
SafeCompositionGraph a b -> String
writeSCGString SafeCompositionGraph a b
cg = String
finalString
where
obString :: String
obString = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. PrettyPrint a => a -> String
pprint (a -> String) -> [a] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set a -> [a]
forall a. Eq a => Set a -> [a]
setToList(Set a -> [a])
-> (SafeCompositionGraph a b -> Set a)
-> SafeCompositionGraph a b
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SafeCompositionGraph a b -> Set a
forall c m o. FiniteCategory c m o => c -> Set o
ob (SafeCompositionGraph a b -> [a])
-> SafeCompositionGraph a b -> [a]
forall a b. (a -> b) -> a -> b
$ SafeCompositionGraph a b
cg)
arNotIdentityAndNotComposite :: [SCGMorphism a b]
arNotIdentityAndNotComposite = Set (SCGMorphism a b) -> [SCGMorphism a b]
forall a. Eq a => Set a -> [a]
setToList (Set (SCGMorphism a b) -> [SCGMorphism a b])
-> Set (SCGMorphism a b) -> [SCGMorphism a b]
forall a b. (a -> b) -> a -> b
$ (SCGMorphism a b -> Bool)
-> Set (SCGMorphism a b) -> Set (SCGMorphism a b)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (SafeCompositionGraph a b -> SCGMorphism a b -> Bool
forall c m o.
(Category c m o, Morphism m o, Eq m) =>
c -> m -> Bool
isGenerator SafeCompositionGraph a b
cg) (Set (SCGMorphism a b) -> Set (SCGMorphism a b))
-> Set (SCGMorphism a b) -> Set (SCGMorphism a b)
forall a b. (a -> b) -> a -> b
$ (SCGMorphism a b -> Bool)
-> Set (SCGMorphism a b) -> Set (SCGMorphism a b)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (SafeCompositionGraph a b -> SCGMorphism a b -> Bool
forall c m o.
(Category c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isNotIdentity SafeCompositionGraph a b
cg) (SafeCompositionGraph a b -> Set (SCGMorphism a b)
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set m
genArrows SafeCompositionGraph a b
cg)
reversedRawPaths :: [[Arrow a b]]
reversedRawPaths = ([Arrow a b] -> [Arrow a b]
forall a. [a] -> [a]
reverse([Arrow a b] -> [Arrow a b])
-> (SCGMorphism a b -> [Arrow a b])
-> SCGMorphism a b
-> [Arrow a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a, [Arrow a b]) -> [Arrow a b]
forall a b. (a, b) -> b
snd((a, [Arrow a b]) -> [Arrow a b])
-> (SCGMorphism a b -> (a, [Arrow a b]))
-> SCGMorphism a b
-> [Arrow a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SCGMorphism a b -> (a, [Arrow a b])
forall a b. SCGMorphism a b -> Path a b
pathS) (SCGMorphism a b -> [Arrow a b])
-> [SCGMorphism a b] -> [[Arrow a b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SCGMorphism a b]
arNotIdentityAndNotComposite
arString :: String
arString = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [Arrow a b] -> String
forall a b. (PrettyPrint a, PrettyPrint b) => RawPath a b -> String
reversedRawPathToString ([Arrow a b] -> String) -> [[Arrow a b]] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Arrow a b]]
reversedRawPaths
lawString :: String
lawString = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (\([Arrow a b]
rp1,[Arrow a b]
rp2) -> ([Arrow a b] -> String
forall a b. (PrettyPrint a, PrettyPrint b) => RawPath a b -> String
reversedRawPathToString ([Arrow a b] -> [Arrow a b]
forall a. [a] -> [a]
reverse [Arrow a b]
rp1)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([Arrow a b] -> String
forall a b. (PrettyPrint a, PrettyPrint b) => RawPath a b -> String
reversedRawPathToString ([Arrow a b] -> [Arrow a b]
forall a. [a] -> [a]
reverse [Arrow a b]
rp2))) (([Arrow a b], [Arrow a b]) -> String)
-> [([Arrow a b], [Arrow a b])] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Map [Arrow a b] [Arrow a b] -> [([Arrow a b], [Arrow a b])]
forall k a. Eq k => Map k a -> [(k, a)]
Map.toList)(Map [Arrow a b] [Arrow a b] -> [([Arrow a b], [Arrow a b])])
-> (SafeCompositionGraph a b -> Map [Arrow a b] [Arrow a b])
-> SafeCompositionGraph a b
-> [([Arrow a b], [Arrow a b])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SafeCompositionGraph a b -> Map [Arrow a b] [Arrow a b]
forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS (SafeCompositionGraph a b -> [([Arrow a b], [Arrow a b])])
-> SafeCompositionGraph a b -> [([Arrow a b], [Arrow a b])]
forall a b. (a -> b) -> a -> b
$ SafeCompositionGraph a b
cg)
finalString :: String
finalString = (Int -> String
forall a. Show a => a -> String
show (SafeCompositionGraph a b -> Int
forall a b. SafeCompositionGraph a b -> Int
maxCycles SafeCompositionGraph a b
cg))String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\n#Objects :\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
obStringString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\n\n# Arrows :\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
arStringString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\n\n# Composition law :\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
lawString
writeSCGFile :: (PrettyPrint a, PrettyPrint b, Eq a, Eq b) => SafeCompositionGraph a b -> String -> IO ()
writeSCGFile :: forall a b.
(PrettyPrint a, PrettyPrint b, Eq a, Eq b) =>
SafeCompositionGraph a b -> String -> IO ()
writeSCGFile SafeCompositionGraph a b
cg String
filepath = do
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory String
filepath
String -> String -> IO ()
writeFile String
filepath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ SafeCompositionGraph a b -> String
forall a b.
(PrettyPrint a, PrettyPrint b, Eq a, Eq b) =>
SafeCompositionGraph a b -> String
writeSCGString SafeCompositionGraph a b
cg
type SCGD = Diagram (SafeCompositionGraph Text Text) (SCGMorphism Text Text) Text (SafeCompositionGraph Text Text) (SCGMorphism Text Text) Text
addOMapEntry :: [Token] -> SCGD -> SCGD
addOMapEntry :: [Token] -> SCGD -> SCGD
addOMapEntry [Name Text
x, Token
MapsTo, Name Text
y] SCGD
diag
| Text
x Text -> Set Text -> Bool
forall a. Eq a => a -> Set a -> Bool
`isIn` (Map Text Text -> Set Text
forall k a. Map k a -> Set k
domain (SCGD -> Map Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map o1 o2
omap SCGD
diag)) = if Text
y Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (SCGD
diag SCGD -> Text -> Text
forall o1 c1 m1 c2 m2 o2.
Eq o1 =>
Diagram c1 m1 o1 c2 m2 o2 -> o1 -> o2
->$ Text
x) then SCGD
diag else String -> SCGD
forall a. HasCallStack => String -> a
error (String
"Incoherent maps of object : F("String -> ShowS
forall a. [a] -> [a] -> [a]
++Text -> String
forall a. Show a => a -> String
show Text
xString -> ShowS
forall a. [a] -> [a] -> [a]
++String
") = "String -> ShowS
forall a. [a] -> [a] -> [a]
++Text -> String
forall a. Show a => a -> String
show Text
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and "String -> ShowS
forall a. [a] -> [a] -> [a]
++Text -> String
forall a. Show a => a -> String
show (SCGD
diag SCGD -> Text -> Text
forall o1 c1 m1 c2 m2 o2.
Eq o1 =>
Diagram c1 m1 o1 c2 m2 o2 -> o1 -> o2
->$ Text
x))
| Bool
otherwise = Diagram{src :: SafeCompositionGraph Text Text
src=SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src SCGD
diag, tgt :: SafeCompositionGraph Text Text
tgt=SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt SCGD
diag, omap :: Map Text Text
omap=Text -> Text -> Map Text Text -> Map Text Text
forall k a. k -> a -> Map k a -> Map k a
Map.insert Text
x Text
y (SCGD -> Map Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map o1 o2
omap SCGD
diag), mmap :: Map (SCGMorphism Text Text) (SCGMorphism Text Text)
mmap=SCGD -> Map (SCGMorphism Text Text) (SCGMorphism Text Text)
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap SCGD
diag}
addOMapEntry [Token]
otherTokens SCGD
_ = String -> SCGD
forall a. HasCallStack => String -> a
error (String -> SCGD) -> String -> SCGD
forall a b. (a -> b) -> a -> b
$ String
"addOMapEntry on invalid tokens : "String -> ShowS
forall a. [a] -> [a] -> [a]
++[Token] -> String
forall a. Show a => a -> String
show [Token]
otherTokens
addMMapEntry :: [Token] -> SCGD -> SCGD
addMMapEntry :: [Token] -> SCGD -> SCGD
addMMapEntry tks :: [Token]
tks@[Name Text
sx, Token
BeginArrow, Name Text
lx, Token
EndArrow, Name Text
tx, Token
MapsTo, Token
Identity] SCGD
diag = if Text
sx Text -> Set Text -> Bool
forall a. Eq a => a -> Set a -> Bool
`isIn` (Map Text Text -> Set Text
forall k a. Map k a -> Set k
domain (SCGD -> Map Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map o1 o2
omap SCGD
diag)) then Diagram{src :: SafeCompositionGraph Text Text
src=SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src SCGD
diag, tgt :: SafeCompositionGraph Text Text
tgt=SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt SCGD
diag, omap :: Map Text Text
omap=SCGD -> Map Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map o1 o2
omap SCGD
diag, mmap :: Map (SCGMorphism Text Text) (SCGMorphism Text Text)
mmap=SCGMorphism Text Text
-> SCGMorphism Text Text
-> Map (SCGMorphism Text Text) (SCGMorphism Text Text)
-> Map (SCGMorphism Text Text) (SCGMorphism Text Text)
forall k a. k -> a -> Map k a -> Map k a
Map.insert SCGMorphism Text Text
sourceMorph (SafeCompositionGraph Text Text -> Text -> SCGMorphism Text Text
forall c m o. (Category c m o, Morphism m o) => c -> o -> m
identity (SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt SCGD
diag) (SCGD
diag SCGD -> Text -> Text
forall o1 c1 m1 c2 m2 o2.
Eq o1 =>
Diagram c1 m1 o1 c2 m2 o2 -> o1 -> o2
->$ Text
sx)) (SCGD -> Map (SCGMorphism Text Text) (SCGMorphism Text Text)
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap SCGD
diag)} else String -> SCGD
forall a. HasCallStack => String -> a
error (String
"You must specify the image of the source of the morphism before mapping to an identity : "String -> ShowS
forall a. [a] -> [a] -> [a]
++[Token] -> String
forall a. Show a => a -> String
show [Token]
tks)
where
sourceMorphCand :: Set (SCGMorphism Text Text)
sourceMorphCand = (SCGMorphism Text Text -> Bool)
-> Set (SCGMorphism Text Text) -> Set (SCGMorphism Text Text)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\SCGMorphism Text Text
e -> SCGMorphism Text Text -> Maybe Text
forall a b. SCGMorphism a b -> Maybe b
getLabelS SCGMorphism Text Text
e Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
lx) (SafeCompositionGraph Text Text
-> Text -> Text -> Set (SCGMorphism Text Text)
forall c m o.
(Category c m o, Morphism m o) =>
c -> o -> o -> Set m
genAr (SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src SCGD
diag) Text
sx Text
tx)
sourceMorph :: SCGMorphism Text Text
sourceMorph = if Set (SCGMorphism Text Text) -> Bool
forall a. Set a -> Bool
Set.null Set (SCGMorphism Text Text)
sourceMorphCand then String -> SCGMorphism Text Text
forall a. HasCallStack => String -> a
error (String -> SCGMorphism Text Text)
-> String -> SCGMorphism Text Text
forall a b. (a -> b) -> a -> b
$ String
"addMMapEntry : morphism not found in source category for the following map : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Token] -> String
forall a. Show a => a -> String
show [Token]
tks else Set (SCGMorphism Text Text) -> SCGMorphism Text Text
forall a. Set a -> a
anElement Set (SCGMorphism Text Text)
sourceMorphCand
addMMapEntry tks :: [Token]
tks@[Name Text
sx, Token
BeginArrow, Name Text
lx, Token
EndArrow, Name Text
tx, Token
MapsTo, Name Text
sy, Token
BeginArrow, Name Text
ly, Token
EndArrow, Name Text
ty] SCGD
diag = Diagram{src :: SafeCompositionGraph Text Text
src=SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src SCGD
newDiag2, tgt :: SafeCompositionGraph Text Text
tgt=SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt SCGD
newDiag2, omap :: Map Text Text
omap=SCGD -> Map Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map o1 o2
omap SCGD
newDiag2, mmap :: Map (SCGMorphism Text Text) (SCGMorphism Text Text)
mmap=SCGMorphism Text Text
-> SCGMorphism Text Text
-> Map (SCGMorphism Text Text) (SCGMorphism Text Text)
-> Map (SCGMorphism Text Text) (SCGMorphism Text Text)
forall k a. k -> a -> Map k a -> Map k a
Map.insert SCGMorphism Text Text
sourceMorph SCGMorphism Text Text
targetMorph (SCGD -> Map (SCGMorphism Text Text) (SCGMorphism Text Text)
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap SCGD
newDiag2)}
where
sourceMorphCand :: Set (SCGMorphism Text Text)
sourceMorphCand = (SCGMorphism Text Text -> Bool)
-> Set (SCGMorphism Text Text) -> Set (SCGMorphism Text Text)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\SCGMorphism Text Text
e -> SCGMorphism Text Text -> Maybe Text
forall a b. SCGMorphism a b -> Maybe b
getLabelS SCGMorphism Text Text
e Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
lx) (SafeCompositionGraph Text Text
-> Text -> Text -> Set (SCGMorphism Text Text)
forall c m o.
(Category c m o, Morphism m o) =>
c -> o -> o -> Set m
genAr (SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src SCGD
diag) Text
sx Text
tx)
targetMorphCand :: Set (SCGMorphism Text Text)
targetMorphCand = (SCGMorphism Text Text -> Bool)
-> Set (SCGMorphism Text Text) -> Set (SCGMorphism Text Text)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\SCGMorphism Text Text
e -> SCGMorphism Text Text -> Maybe Text
forall a b. SCGMorphism a b -> Maybe b
getLabelS SCGMorphism Text Text
e Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ly) (SafeCompositionGraph Text Text
-> Text -> Text -> Set (SCGMorphism Text Text)
forall c m o.
(Category c m o, Morphism m o) =>
c -> o -> o -> Set m
genAr (SCGD -> SafeCompositionGraph Text Text
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt SCGD
diag) Text
sy Text
ty)
sourceMorph :: SCGMorphism Text Text
sourceMorph = if Set (SCGMorphism Text Text) -> Bool
forall a. Set a -> Bool
Set.null Set (SCGMorphism Text Text)
sourceMorphCand then String -> SCGMorphism Text Text
forall a. HasCallStack => String -> a
error (String -> SCGMorphism Text Text)
-> String -> SCGMorphism Text Text
forall a b. (a -> b) -> a -> b
$ String
"addMMapEntry : morphism not found in source category for the following map : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Token] -> String
forall a. Show a => a -> String
show [Token]
tks else Set (SCGMorphism Text Text) -> SCGMorphism Text Text
forall a. Set a -> a
anElement Set (SCGMorphism Text Text)
sourceMorphCand
targetMorph :: SCGMorphism Text Text
targetMorph = if Set (SCGMorphism Text Text) -> Bool
forall a. Set a -> Bool
Set.null Set (SCGMorphism Text Text)
targetMorphCand then String -> SCGMorphism Text Text
forall a. HasCallStack => String -> a
error (String -> SCGMorphism Text Text)
-> String -> SCGMorphism Text Text
forall a b. (a -> b) -> a -> b
$ String
"addMMapEntry : morphism not found in target category for the following map : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Token] -> String
forall a. Show a => a -> String
show [Token]
tks else Set (SCGMorphism Text Text) -> SCGMorphism Text Text
forall a. Set a -> a
anElement Set (SCGMorphism Text Text)
targetMorphCand
newDiag1 :: SCGD
newDiag1 = [Token] -> SCGD -> SCGD
addOMapEntry [Text -> Token
Name Text
sx, Token
MapsTo, Text -> Token
Name Text
sy] SCGD
diag
newDiag2 :: SCGD
newDiag2 = [Token] -> SCGD -> SCGD
addOMapEntry [Text -> Token
Name Text
tx, Token
MapsTo, Text -> Token
Name Text
ty] SCGD
newDiag1
addMMapEntry [Token]
otherTokens SCGD
_ = String -> SCGD
forall a. HasCallStack => String -> a
error (String -> SCGD) -> String -> SCGD
forall a b. (a -> b) -> a -> b
$ String
"addMMapEntry on invalid tokens : "String -> ShowS
forall a. [a] -> [a] -> [a]
++[Token] -> String
forall a. Show a => a -> String
show [Token]
otherTokens
readLineD :: String -> SCGD -> SCGD
readLineD :: String -> SCGD -> SCGD
readLineD String
line diag :: SCGD
diag@Diagram{src :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src=SafeCompositionGraph Text Text
s, tgt :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt=SafeCompositionGraph Text Text
t, omap :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map o1 o2
omap=Map Text Text
om, mmap :: forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> Map m1 m2
mmap=Map (SCGMorphism Text Text) (SCGMorphism Text Text)
mm}
| [Token] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
lexedLine = SCGD
diag
| Token -> [Token] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Token
MapsTo [Token]
lexedLine = if Token -> [Token] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Token
BeginArrow [Token]
lexedLine
then [Token] -> SCGD -> SCGD
addMMapEntry [Token]
lexedLine SCGD
diag
else [Token] -> SCGD -> SCGD
addOMapEntry [Token]
lexedLine SCGD
diag
| Bool
otherwise = SCGD
diag
where
lexedLine :: [Token]
lexedLine = (String -> [Token]
parserLex String
line)
extractSrcSection :: [String] -> [String]
[String]
lines
| Bool -> Bool
not ([Token] -> [[Token]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Token
BeginSrc] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines)) = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"No <SRC> section or malformed <SRC> section in file : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
lines
| Bool -> Bool
not ([Token] -> [[Token]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Token
EndSrc] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines)) = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"No <SRC> section or malformed <SRC> section in file : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
lines
| Int
indexEndSrc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
indexBeginSrc = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"Malformed <SRC> section in file : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
lines
| Bool
otherwise = [String]
c
where
Just Int
indexBeginSrc = ([Token] -> [[Token]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [Token
BeginSrc] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines))
Just Int
indexEndSrc = ([Token] -> [[Token]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [Token
EndSrc] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines))
([String]
a,[String]
b) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
indexBeginSrcInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [String]
lines
([String]
c,[String]
d) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
indexEndSrcInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
indexBeginSrcInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [String]
b
extractTgtSection :: [String] -> [String]
[String]
lines
| Bool -> Bool
not ([Token] -> [[Token]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Token
BeginTgt] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines)) = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"No <TGT> section or malformed <TGT> section in file : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
lines
| Bool -> Bool
not ([Token] -> [[Token]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Token
EndTgt] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines)) = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"No <TGT> section or malformed <TGT> section in file : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
lines
| Int
indexEndTgt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
indexBeginTgt = String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"Malformed <TGT> section in file : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
lines
| Bool
otherwise = [String]
c
where
Just Int
indexBeginTgt = ([Token] -> [[Token]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [Token
BeginTgt] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines))
Just Int
indexEndTgt = ([Token] -> [[Token]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [Token
EndTgt] (String -> [Token]
parserLex (String -> [Token]) -> [String] -> [[Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
lines))
([String]
a,[String]
b) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
indexBeginTgtInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [String]
lines
([String]
c,[String]
d) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
indexEndTgtInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
indexBeginTgtInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [String]
b
unsafeReadSCGDString :: String -> SCGD
unsafeReadSCGDString :: String -> SCGD
unsafeReadSCGDString String
str = SCGD -> SCGD
forall c1 m1 o1 c2 m2 o2.
(FiniteCategory c1 m1 o1, Morphism m1 o1, Eq m1, Eq o1,
Category c2 m2 o2, Morphism m2 o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Diagram c1 m1 o1 c2 m2 o2
completeDiagram SCGD
finalDiag
where
ls :: [String]
ls = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Token] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null([Token] -> Bool) -> (String -> [Token]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [Token]
parserLex) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
str
s :: SafeCompositionGraph Text Text
s = String -> SafeCompositionGraph Text Text
unsafeReadSCGString (String -> SafeCompositionGraph Text Text)
-> String -> SafeCompositionGraph Text Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> [String]
extractSrcSection [String]
ls)
t :: SafeCompositionGraph Text Text
t = String -> SafeCompositionGraph Text Text
unsafeReadSCGString (String -> SafeCompositionGraph Text Text)
-> String -> SafeCompositionGraph Text Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> [String]
extractTgtSection [String]
ls)
diag :: Diagram
(SafeCompositionGraph Text Text)
m1
o1
(SafeCompositionGraph Text Text)
m2
o2
diag = Diagram{src :: SafeCompositionGraph Text Text
src=SafeCompositionGraph Text Text
s, tgt :: SafeCompositionGraph Text Text
tgt=SafeCompositionGraph Text Text
t,omap :: Map o1 o2
omap=AssociationList o1 o2 -> Map o1 o2
forall k v. AssociationList k v -> Map k v
weakMap [], mmap :: Map m1 m2
mmap=AssociationList m1 m2 -> Map m1 m2
forall k v. AssociationList k v -> Map k v
weakMap []}
finalDiag :: SCGD
finalDiag = (String -> SCGD -> SCGD) -> SCGD -> [String] -> SCGD
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> SCGD -> SCGD
readLineD SCGD
forall {m1} {o1} {m2} {o2}.
Diagram
(SafeCompositionGraph Text Text)
m1
o1
(SafeCompositionGraph Text Text)
m2
o2
diag [String]
ls
readSCGDString :: String -> Either (DiagramError SCG (SCGMorphism Text Text) Text SCG (SCGMorphism Text Text) Text) SCGD
readSCGDString :: String
-> Either
(DiagramError
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text)
SCGD
readSCGDString String
str
| Maybe
(DiagramError
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text)
-> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe
(DiagramError
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text)
check = SCGD
-> Either
(DiagramError
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text)
SCGD
forall a b. b -> Either a b
Right SCGD
diag
| Bool
otherwise = DiagramError
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text
-> Either
(DiagramError
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text)
SCGD
forall a b. a -> Either a b
Left DiagramError
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text
err
where
diag :: SCGD
diag = String -> SCGD
unsafeReadSCGDString String
str
check :: Maybe
(DiagramError
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text)
check = SCGD
-> Maybe
(DiagramError
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text)
forall c1 m1 o1 c2 m2 o2.
(FiniteCategory c1 m1 o1, Morphism m1 o1, Eq m1, Eq o1,
FiniteCategory c2 m2 o2, Morphism m2 o2, Eq m2, Eq o2) =>
Diagram c1 m1 o1 c2 m2 o2 -> Maybe (DiagramError c1 m1 o1 c2 m2 o2)
checkFiniteDiagram SCGD
diag
Just DiagramError
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text
err = Maybe
(DiagramError
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text)
check
unsafeReadSCGDFile :: String -> IO SCGD
unsafeReadSCGDFile :: String -> IO SCGD
unsafeReadSCGDFile String
path = do
String
raw <- String -> IO String
readFile String
path
SCGD -> IO SCGD
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> SCGD
unsafeReadSCGDString String
raw)
readSCGDFile :: String -> IO (Either (DiagramError SCG (SCGMorphism Text Text) Text SCG (SCGMorphism Text Text) Text) SCGD)
readSCGDFile :: String
-> IO
(Either
(DiagramError
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text)
SCGD)
readSCGDFile String
path = do
String
raw <- String -> IO String
readFile String
path
Either
(DiagramError
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text)
SCGD
-> IO
(Either
(DiagramError
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text)
SCGD)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
-> Either
(DiagramError
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text
(SafeCompositionGraph Text Text)
(SCGMorphism Text Text)
Text)
SCGD
readSCGDString String
raw)
writeSCGDString :: (PrettyPrint a1, PrettyPrint b1, Eq a1, Eq b1,
PrettyPrint a2, PrettyPrint b2, Eq a2, Eq b2) =>
Diagram (SafeCompositionGraph a1 b1) (SCGMorphism a1 b1) a1 (SafeCompositionGraph a2 b2) (SCGMorphism a2 b2) a2 -> String
writeSCGDString :: forall a1 b1 a2 b2.
(PrettyPrint a1, PrettyPrint b1, Eq a1, Eq b1, PrettyPrint a2,
PrettyPrint b2, Eq a2, Eq b2) =>
Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> String
writeSCGDString Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
diag = String
srcString String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tgtString String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
omapString String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mmapString
where
srcString :: String
srcString = String
"<SRC>\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++SafeCompositionGraph a1 b1 -> String
forall a b.
(PrettyPrint a, PrettyPrint b, Eq a, Eq b) =>
SafeCompositionGraph a b -> String
writeSCGString (Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> SafeCompositionGraph a1 b1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
diag)String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\n</SRC>\n"
tgtString :: String
tgtString = String
"<TGT>\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++SafeCompositionGraph a2 b2 -> String
forall a b.
(PrettyPrint a, PrettyPrint b, Eq a, Eq b) =>
SafeCompositionGraph a b -> String
writeSCGString (Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> SafeCompositionGraph a2 b2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
diag)String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"</TGT>\n"
omapString :: String
omapString = String
"#Object mapping\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (\a1
o -> (a1 -> String
forall a. PrettyPrint a => a -> String
pprint a1
o) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (a2 -> String
forall a. PrettyPrint a => a -> String
pprint (Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
diag Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> a1 -> a2
forall o1 c1 m1 c2 m2 o2.
Eq o1 =>
Diagram c1 m1 o1 c2 m2 o2 -> o1 -> o2
->$ a1
o)) )(a1 -> String) -> [a1] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set a1 -> [a1]
forall a. Eq a => Set a -> [a]
setToList(Set a1 -> [a1])
-> (Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> Set a1)
-> Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> [a1]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SafeCompositionGraph a1 b1 -> Set a1
forall c m o. FiniteCategory c m o => c -> Set o
ob(SafeCompositionGraph a1 b1 -> Set a1)
-> (Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> SafeCompositionGraph a1 b1)
-> Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> Set a1
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> SafeCompositionGraph a1 b1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src (Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> [a1])
-> Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> [a1]
forall a b. (a -> b) -> a -> b
$ Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
diag)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
mmapString :: String
mmapString = String
"#Morphism mapping\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (\SCGMorphism a1 b1
m -> a1 -> String
forall a. PrettyPrint a => a -> String
pprint (SCGMorphism a1 b1 -> a1
forall m o. Morphism m o => m -> o
source SCGMorphism a1 b1
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SCGMorphism a1 b1 -> String
forall a. PrettyPrint a => a -> String
pprint SCGMorphism a1 b1
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a1 -> String
forall a. PrettyPrint a => a -> String
pprint (SCGMorphism a1 b1 -> a1
forall m o. Morphism m o => m -> o
target SCGMorphism a1 b1
m)String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ if SafeCompositionGraph a2 b2 -> SCGMorphism a2 b2 -> Bool
forall c m o.
(Category c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isIdentity (Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> SafeCompositionGraph a2 b2
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c2
tgt Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
diag) (Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
diag Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> SCGMorphism a1 b1 -> SCGMorphism a2 b2
forall m1 c1 o1 c2 m2 o2.
Eq m1 =>
Diagram c1 m1 o1 c2 m2 o2 -> m1 -> m2
->£ SCGMorphism a1 b1
m) then String
"<ID/>" else a2 -> String
forall a. PrettyPrint a => a -> String
pprint (SCGMorphism a2 b2 -> a2
forall m o. Morphism m o => m -> o
source (Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
diag Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> SCGMorphism a1 b1 -> SCGMorphism a2 b2
forall m1 c1 o1 c2 m2 o2.
Eq m1 =>
Diagram c1 m1 o1 c2 m2 o2 -> m1 -> m2
->£ SCGMorphism a1 b1
m)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SCGMorphism a2 b2 -> String
forall a. PrettyPrint a => a -> String
pprint (Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
diag Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> SCGMorphism a1 b1 -> SCGMorphism a2 b2
forall m1 c1 o1 c2 m2 o2.
Eq m1 =>
Diagram c1 m1 o1 c2 m2 o2 -> m1 -> m2
->£ SCGMorphism a1 b1
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a2 -> String
forall a. PrettyPrint a => a -> String
pprint (SCGMorphism a2 b2 -> a2
forall m o. Morphism m o => m -> o
target (Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
diag Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> SCGMorphism a1 b1 -> SCGMorphism a2 b2
forall m1 c1 o1 c2 m2 o2.
Eq m1 =>
Diagram c1 m1 o1 c2 m2 o2 -> m1 -> m2
->£ SCGMorphism a1 b1
m)))(SCGMorphism a1 b1 -> String) -> [SCGMorphism a1 b1] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set (SCGMorphism a1 b1) -> [SCGMorphism a1 b1]
forall a. Eq a => Set a -> [a]
setToList(Set (SCGMorphism a1 b1) -> [SCGMorphism a1 b1])
-> (Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> Set (SCGMorphism a1 b1))
-> Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> [SCGMorphism a1 b1]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((SCGMorphism a1 b1 -> Bool)
-> Set (SCGMorphism a1 b1) -> Set (SCGMorphism a1 b1)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (SafeCompositionGraph a1 b1 -> SCGMorphism a1 b1 -> Bool
forall c m o.
(Category c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isNotIdentity (Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> SafeCompositionGraph a1 b1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
diag)))(Set (SCGMorphism a1 b1) -> Set (SCGMorphism a1 b1))
-> (Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> Set (SCGMorphism a1 b1))
-> Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> Set (SCGMorphism a1 b1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SafeCompositionGraph a1 b1 -> Set (SCGMorphism a1 b1)
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> Set m
genArrows(SafeCompositionGraph a1 b1 -> Set (SCGMorphism a1 b1))
-> (Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> SafeCompositionGraph a1 b1)
-> Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> Set (SCGMorphism a1 b1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> SafeCompositionGraph a1 b1
forall c1 m1 o1 c2 m2 o2. Diagram c1 m1 o1 c2 m2 o2 -> c1
src (Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> [SCGMorphism a1 b1])
-> Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> [SCGMorphism a1 b1]
forall a b. (a -> b) -> a -> b
$ Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
diag)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
writeSCGDFile :: (PrettyPrint a1, PrettyPrint b1, Eq a1, Eq b1,
PrettyPrint a2, PrettyPrint b2, Eq a2, Eq b2) =>
Diagram (SafeCompositionGraph a1 b1) (SCGMorphism a1 b1) a1 (SafeCompositionGraph a2 b2) (SCGMorphism a2 b2) a2 -> String -> IO ()
writeSCGDFile :: forall a1 b1 a2 b2.
(PrettyPrint a1, PrettyPrint b1, Eq a1, Eq b1, PrettyPrint a2,
PrettyPrint b2, Eq a2, Eq b2) =>
Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> String -> IO ()
writeSCGDFile Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
diag String
filepath = do
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory String
filepath
String -> String -> IO ()
writeFile String
filepath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> String
forall a1 b1 a2 b2.
(PrettyPrint a1, PrettyPrint b1, Eq a1, Eq b1, PrettyPrint a2,
PrettyPrint b2, Eq a2, Eq b2) =>
Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
-> String
writeSCGDString Diagram
(SafeCompositionGraph a1 b1)
(SCGMorphism a1 b1)
a1
(SafeCompositionGraph a2 b2)
(SCGMorphism a2 b2)
a2
diag
safeCompositionGraphFromCompositionGraph :: Int -> CompositionGraph a b -> SafeCompositionGraph a b
safeCompositionGraphFromCompositionGraph :: forall a b. Int -> CompositionGraph a b -> SafeCompositionGraph a b
safeCompositionGraphFromCompositionGraph Int
i CompositionGraph a b
cg = SafeCompositionGraph{supportS :: Graph a b
supportS = CompositionGraph a b -> Graph a b
forall a b. CompositionGraph a b -> Graph a b
support CompositionGraph a b
cg, lawS :: CompositionLaw a b
lawS = CompositionGraph a b -> CompositionLaw a b
forall a b. CompositionGraph a b -> CompositionLaw a b
law CompositionGraph a b
cg, maxCycles :: Int
maxCycles = Int
i}
compositionGraphFromSafeCompositionGraph :: SafeCompositionGraph a b -> CompositionGraph a b
compositionGraphFromSafeCompositionGraph :: forall a b. SafeCompositionGraph a b -> CompositionGraph a b
compositionGraphFromSafeCompositionGraph SafeCompositionGraph a b
scg = Graph a b -> CompositionLaw a b -> CompositionGraph a b
forall a b. Graph a b -> CompositionLaw a b -> CompositionGraph a b
unsafeCompositionGraph (SafeCompositionGraph a b -> Graph a b
forall a b. SafeCompositionGraph a b -> Graph a b
supportS SafeCompositionGraph a b
scg) (SafeCompositionGraph a b -> CompositionLaw a b
forall a b. SafeCompositionGraph a b -> CompositionLaw a b
lawS SafeCompositionGraph a b
scg)
constructRandomSafeCompositionGraph :: (RandomGen g) => Int
-> Int
-> Int
-> g
-> Int
-> (SafeCompositionGraph Int Int, g)
constructRandomSafeCompositionGraph :: forall g.
RandomGen g =>
Int -> Int -> Int -> g -> Int -> (SafeCompositionGraph Int Int, g)
constructRandomSafeCompositionGraph Int
a Int
b Int
c g
g Int
i = (Int -> CompositionGraph Int Int -> SafeCompositionGraph Int Int
forall a b. Int -> CompositionGraph a b -> SafeCompositionGraph a b
safeCompositionGraphFromCompositionGraph Int
i CompositionGraph Int Int
cg, g
g2)
where
(CompositionGraph Int Int
cg, g
g2) = Int -> Int -> Int -> g -> (CompositionGraph Int Int, g)
forall g.
RandomGen g =>
Int -> Int -> Int -> g -> (CompositionGraph Int Int, g)
constructRandomCompositionGraph Int
a Int
b Int
c g
g
defaultConstructRandomSafeCompositionGraph :: (RandomGen g) => g -> (SafeCompositionGraph Int Int, g)
defaultConstructRandomSafeCompositionGraph :: forall g. RandomGen g => g -> (SafeCompositionGraph Int Int, g)
defaultConstructRandomSafeCompositionGraph g
g = (Int -> CompositionGraph Int Int -> SafeCompositionGraph Int Int
forall a b. Int -> CompositionGraph a b -> SafeCompositionGraph a b
safeCompositionGraphFromCompositionGraph Int
100 CompositionGraph Int Int
cg, g
g2)
where
(CompositionGraph Int Int
cg,g
g2) = g -> (CompositionGraph Int Int, g)
forall g. RandomGen g => g -> (CompositionGraph Int Int, g)
defaultConstructRandomCompositionGraph g
g
defaultConstructRandomSafeDiagram :: (RandomGen g) => g -> (Diagram (SafeCompositionGraph Int Int) (SCGMorphism Int Int) Int (SafeCompositionGraph Int Int) (SCGMorphism Int Int) Int, g)
defaultConstructRandomSafeDiagram :: forall g.
RandomGen g =>
g
-> (Diagram
(SafeCompositionGraph Int Int)
(SCGMorphism Int Int)
Int
(SafeCompositionGraph Int Int)
(SCGMorphism Int Int)
Int,
g)
defaultConstructRandomSafeDiagram g
g1 = SafeCompositionGraph Int Int
-> SafeCompositionGraph Int Int
-> g
-> (Diagram
(SafeCompositionGraph Int Int)
(SCGMorphism Int Int)
Int
(SafeCompositionGraph Int Int)
(SCGMorphism Int Int)
Int,
g)
forall c1 m1 o1 c2 m2 o2 g.
(FiniteCategory c1 m1 o1, Morphism m1 o1, Eq c1, Eq m1, Eq o1,
FiniteCategory c2 m2 o2, Morphism m2 o2, Eq c2, Eq m2, Eq o2,
RandomGen g) =>
c1 -> c2 -> g -> (Diagram c1 m1 o1 c2 m2 o2, g)
pickRandomDiagram SafeCompositionGraph Int Int
cat1 SafeCompositionGraph Int Int
cat2 g
g3
where
(Int
nbArrows1, g
g2) = (Int, Int) -> g -> (Int, g)
forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (Int
1,Int
8) g
g1
(Int
nbAttempts1, g
g3) = (Int, Int) -> g -> (Int, g)
forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (Int
0,Int
nbArrows1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
nbArrows1) g
g2
(SafeCompositionGraph Int Int
cat1, g
g4) = Int -> Int -> Int -> g -> Int -> (SafeCompositionGraph Int Int, g)
forall g.
RandomGen g =>
Int -> Int -> Int -> g -> Int -> (SafeCompositionGraph Int Int, g)
constructRandomSafeCompositionGraph Int
nbArrows1 Int
nbAttempts1 Int
5 g
g3 Int
100
(Int
nbArrows2, g
g5) = (Int, Int) -> g -> (Int, g)
forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (Int
1,Int
11Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
nbArrows1) g
g4
(Int
nbAttempts2, g
g6) = (Int, Int) -> g -> (Int, g)
forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (Int
0,Int
nbArrows2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
nbArrows2) g
g5
(SafeCompositionGraph Int Int
cat2, g
g7) = Int -> Int -> Int -> g -> Int -> (SafeCompositionGraph Int Int, g)
forall g.
RandomGen g =>
Int -> Int -> Int -> g -> Int -> (SafeCompositionGraph Int Int, g)
constructRandomSafeCompositionGraph Int
nbArrows2 Int
nbAttempts2 Int
5 g
g6 Int
100