{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

{-| Module  : FiniteCategories
Description : Composition graphs are the simpliest way to create simple small categories by hand.
Copyright   : Guillaume Sabbagh 2021
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

A `CompositionGraph` is the free category generated by a multidigraph quotiented by an equivalence relation on the paths of the graphs.
A multidigraph is a directed multigraph which means that edges are oriented and there can be multiple arrows between two objects.

The underlying multidigraph is given by a list of nodes and a list of arrows.

The equivalence relation is given by a function on paths of the inductive graph.

The function `mkCompositionGraph` checks the structure of the category and is the preferred way of instantiatiating the `CompositionGraph` type.
If the check takes too long because the category is big, you can use the `CompositionGraph` if you're sure that the category structure is respected.

Morphisms from different composition graphs should not be composed or compared, if they are, the behavior is undefined.

When taking subcategories of a composition graph, the composition law might lead to morphisms not existing anymore.
It is not a problem because they are equivalent, it is only counterintuitive for human readability.

Example.ExampleCompositionGraph provides an example of composition graph construction.    
-}


module CompositionGraph.CompositionGraph 
(
    -- * Types for a graph

    Arrow(..),
    Graph(..),
    -- * Types for a morphism of composition graph

    RawPath(..),
    Path(..),
    CGMorphism(..),
    -- * Types for a composition graph

    CompositionLaw(..),
    CompositionGraph(..),
    -- * Construction

    mkCompositionGraph,
    mkEmptyCompositionGraph,
    finiteCategoryToCompositionGraph,
    generatedFiniteCategoryToCompositionGraph,
    -- * Error gestion

    CompositionGraphError(..),
    -- * Insertion

    insertObject,
    insertMorphism,
    -- * Modification

    identifyMorphisms,
    unidentifyMorphism,
    replaceObject,
    replaceMorphism,
    -- * Deletion

    deleteObject,
    deleteMorphism,
    -- * Utility functions

    isGen,
    isComp,
    getLabel
    
)    
where
    import           Data.List                      ((\\), nub, intercalate, delete)
    import           FiniteCategory.FiniteCategory
    import           Utils.CartesianProduct         (cartesianProduct, (|^|))
    import           Data.Maybe                     (isNothing, fromJust)
    import           IO.PrettyPrint
    import           Utils.AssociationList
    import           Utils.Tuple
    import           Diagram.Diagram
    import           Config.Config
    import           Cat.PartialFinCat
    import           Control.Monad                  (foldM)
        
    -- | An `Arrow` is a source node, a target node and an identifier (for example a unique label).

    type Arrow a b = (a, a, b)
    
    -- | A `RawPath` is a list of arrows.

    type RawPath a b = [Arrow a b]
    
    -- | A `Path` is a `RawPath` with a source and a target specified.

    --

    -- An empty path is an identity in a free category. 

    -- Therefore, it is useful to keep the source and the target when the path is empty

    -- because there is one identity for each node of the graph. (We need to differentiate identites for each node.)

    type Path a b = (a, RawPath a b, a)
    
    -- | A `CompositionLaw` is a `Data.Map` that maps raw paths to smaller raw paths in order to simplify paths

    -- so that they don't compose infinitely many times when there is a cycle.

    --

    -- prop> length (law ! p) <= length p 

    type CompositionLaw a b = AssociationList (RawPath a b) (RawPath a b)
    
    -- | The type `CGMorphism` is the type of composition graph morphisms.

    --

    -- It is a path with a composition law, it is necessary to keep the composition law of the composition graph

    -- in every morphism of the graph because we need it to compose two morphisms and the morphisms compose 

    -- independently of the composition graph.

    data CGMorphism a b = CGMorphism {forall a b. CGMorphism a b -> Path a b
path :: Path a b, 
                                      forall a b. CGMorphism a b -> CompositionLaw a b
compositionLaw :: CompositionLaw a b} deriving (Int -> CGMorphism a b -> ShowS
[CGMorphism a b] -> ShowS
CGMorphism a b -> String
(Int -> CGMorphism a b -> ShowS)
-> (CGMorphism a b -> String)
-> ([CGMorphism a b] -> ShowS)
-> Show (CGMorphism a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> CGMorphism a b -> ShowS
forall a b. (Show a, Show b) => [CGMorphism a b] -> ShowS
forall a b. (Show a, Show b) => CGMorphism a b -> String
showList :: [CGMorphism a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [CGMorphism a b] -> ShowS
show :: CGMorphism a b -> String
$cshow :: forall a b. (Show a, Show b) => CGMorphism a b -> String
showsPrec :: Int -> CGMorphism a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> CGMorphism a b -> ShowS
Show, CGMorphism a b -> CGMorphism a b -> Bool
(CGMorphism a b -> CGMorphism a b -> Bool)
-> (CGMorphism a b -> CGMorphism a b -> Bool)
-> Eq (CGMorphism a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
CGMorphism a b -> CGMorphism a b -> Bool
/= :: CGMorphism a b -> CGMorphism a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
CGMorphism a b -> CGMorphism a b -> Bool
== :: CGMorphism a b -> CGMorphism a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
CGMorphism a b -> CGMorphism a b -> Bool
Eq)
    
    instance (PrettyPrintable a, PrettyPrintable b, Eq a, Eq b) => PrettyPrintable (CGMorphism a b) where
        pprint :: CGMorphism a b -> String
pprint CGMorphism {path :: forall a b. CGMorphism a b -> Path a b
path=(a
s,[],a
t),compositionLaw :: forall a b. CGMorphism a b -> CompositionLaw a b
compositionLaw=CompositionLaw a b
cl} = if a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
t then String
"Id"String -> ShowS
forall a. [a] -> [a] -> [a]
++(a -> String
forall a. PrettyPrintable a => a -> String
pprint a
s) else ShowS
forall a. HasCallStack => String -> a
error String
"Identity with source different of target."
        pprint CGMorphism {path :: forall a b. CGMorphism a b -> Path a b
path=(a
_,RawPath a b
rp,a
_),compositionLaw :: forall a b. CGMorphism a b -> CompositionLaw a b
compositionLaw=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
$ (\(a
_,a
_,b
l) -> b -> String
forall a. PrettyPrintable a => a -> String
pprint b
l) ((a, a, b) -> String) -> RawPath a b -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawPath a b
rp
                     
    -- | A `Graph` is a list of nodes and a list of arrows.

    type Graph a b = ([a],[Arrow a b])

    -- | Helper function for `simplify`. Returns a simplified raw path.

    simplifyOnce :: (Eq a, Eq b) => CompositionLaw a b -> RawPath a b -> RawPath a b
    simplifyOnce :: forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> RawPath a b -> RawPath a b
simplifyOnce CompositionLaw a b
_ [] = [] 
    simplifyOnce CompositionLaw a b
_ [(a, a, b)
e] = [(a, a, b)
e]
    simplifyOnce CompositionLaw a b
cl RawPath a b
list 
        | RawPath a b
new_list RawPath a b -> RawPath a b -> Bool
forall a. Eq a => a -> a -> Bool
== [] = []
        | 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. [a] -> [a]
tail RawPath a b
list) = (RawPath a b -> (a, a, b)
forall a. [a] -> a
head RawPath a b
list)(a, 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. [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 -> (a, a, b)
forall a. [a] -> a
last RawPath a b
list)]
        | Bool
otherwise = RawPath a b
list
        where
        new_list :: RawPath a b
new_list = RawPath a b -> RawPath a b -> CompositionLaw a b -> RawPath a b
forall a b. Eq a => b -> a -> AssociationList a b -> b
(!-?) RawPath a b
list RawPath a b
list CompositionLaw a b
cl
        simple_tail :: RawPath a b
simple_tail = CompositionLaw a b -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> RawPath a b -> RawPath a b
simplifyOnce CompositionLaw a b
cl (RawPath a b -> RawPath a b
forall a. [a] -> [a]
tail RawPath a b
list)
        simple_init :: RawPath a b
simple_init = CompositionLaw a b -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> RawPath a b -> RawPath a b
simplifyOnce CompositionLaw a b
cl (RawPath a b -> RawPath a b
forall a. [a] -> [a]
init RawPath a b
list)
    
    -- | Returns a completely simplified raw path.

    simplify :: (Eq a, Eq b) => CompositionLaw a b -> RawPath a b -> RawPath a b
    simplify :: forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> RawPath a b -> RawPath a b
simplify CompositionLaw a b
_ [] = []
    simplify CompositionLaw a b
cl 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 -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> RawPath a b -> RawPath a b
simplify CompositionLaw a b
cl RawPath a b
simple_one 
            where simple_one :: RawPath a b
simple_one = CompositionLaw a b -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> RawPath a b -> RawPath a b
simplifyOnce CompositionLaw a b
cl RawPath a b
rp

    instance (Eq a, Eq b) => Morphism (CGMorphism a b) a where
        @ :: CGMorphism a b -> CGMorphism a b -> CGMorphism a b
(@) CGMorphism{path :: forall a b. CGMorphism a b -> Path a b
path=(a
s2,RawPath a b
rp2,a
t2), compositionLaw :: forall a b. CGMorphism a b -> CompositionLaw a b
compositionLaw=CompositionLaw a b
cl2} CGMorphism{path :: forall a b. CGMorphism a b -> Path a b
path=(a
s1,RawPath a b
rp1,a
t1), compositionLaw :: forall a b. CGMorphism a b -> CompositionLaw a b
compositionLaw=CompositionLaw a b
cl1}
            | a
t1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
s2 = String -> CGMorphism a b
forall a. HasCallStack => String -> a
error String
"Composition of morphisms g@f where target of f is different of source of g"
            | CompositionLaw a b
cl1 CompositionLaw a b -> CompositionLaw a b -> Bool
forall a. Eq a => a -> a -> Bool
/= CompositionLaw a b
cl2 = String -> CGMorphism a b
forall a. HasCallStack => String -> a
error String
"Composition of morphisms with different composition laws"
            | Bool
otherwise = CGMorphism :: forall a b. Path a b -> CompositionLaw a b -> CGMorphism a b
CGMorphism{path :: (a, RawPath a b, a)
path=(a
s1,(CompositionLaw a b -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> RawPath a b -> RawPath a b
simplify CompositionLaw a b
cl1 (RawPath a b
rp2RawPath a b -> RawPath a b -> RawPath a b
forall a. [a] -> [a] -> [a]
++RawPath a b
rp1)),a
t2), compositionLaw :: CompositionLaw a b
compositionLaw=CompositionLaw a b
cl1}

                                    
        source :: CGMorphism a b -> a
source CGMorphism{path :: forall a b. CGMorphism a b -> Path a b
path=(a
s,RawPath a b
_,a
_), compositionLaw :: forall a b. CGMorphism a b -> CompositionLaw a b
compositionLaw=CompositionLaw a b
_} = a
s
        target :: CGMorphism a b -> a
target CGMorphism{path :: forall a b. CGMorphism a b -> Path a b
path=(a
_,RawPath a b
_,a
t), compositionLaw :: forall a b. CGMorphism a b -> CompositionLaw a b
compositionLaw=CompositionLaw a b
_} = a
t
                                    
        
    -- | Constructs a `CGMorphism` from a composition law and an arrow.

    mkCGMorphism :: CompositionLaw a b -> Arrow a b -> CGMorphism a b
    mkCGMorphism :: forall a b. CompositionLaw a b -> Arrow a b -> CGMorphism a b
mkCGMorphism CompositionLaw a b
cl e :: Arrow a b
e@(a
s,a
t,b
l) = CGMorphism :: forall a b. Path a b -> CompositionLaw a b -> CGMorphism a b
CGMorphism {path :: Path a b
path=(a
s,[Arrow a b
e],a
t),compositionLaw :: CompositionLaw a b
compositionLaw=CompositionLaw a b
cl}

    -- | Returns the list of arrows of a graph with a given source.

    findOutwardEdges :: (Eq a) => Graph a b -> a -> [Arrow a b]
    findOutwardEdges :: forall a b. Eq a => Graph a b -> a -> [Arrow a b]
findOutwardEdges ([a]
nodes,[Arrow a b]
edges) a
o = (Arrow a b -> Bool) -> [Arrow a b] -> [Arrow a b]
forall a. (a -> Bool) -> [a] -> [a]
filter (\e :: Arrow a b
e@(a
s,a
t,b
_) -> a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
o Bool -> Bool -> Bool
&& a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
t [a]
nodes) [Arrow a b]
edges

    -- | Returns the list of arrows of a graph with a given target.

    findInwardEdges :: (Eq a) => Graph a b -> a -> [Arrow a b]
    findInwardEdges :: forall a b. Eq a => Graph a b -> a -> [Arrow a b]
findInwardEdges ([a]
nodes,[Arrow a b]
edges) a
o = (Arrow a b -> Bool) -> [Arrow a b] -> [Arrow a b]
forall a. (a -> Bool) -> [a] -> [a]
filter (\e :: Arrow a b
e@(a
s,a
t,b
_) -> a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
o Bool -> Bool -> Bool
&& a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
s [a]
nodes) [Arrow a b]
edges
    
    -- | Constructs the identity associated to a node of a composition graph.

    mkIdentity :: (Eq a) => Graph a b -> CompositionLaw a b -> a -> CGMorphism a b
    mkIdentity :: forall a b.
Eq a =>
Graph a b -> CompositionLaw a b -> a -> CGMorphism a b
mkIdentity g :: Graph a b
g@([a]
n,[Arrow a b]
_) CompositionLaw a b
cl a
x 
        | a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
x [a]
n = CGMorphism :: forall a b. Path a b -> CompositionLaw a b -> CGMorphism a b
CGMorphism {path :: Path a b
path=(a
x,[],a
x),compositionLaw :: CompositionLaw a b
compositionLaw=CompositionLaw a b
cl}
        | Bool
otherwise = String -> CGMorphism a b
forall a. HasCallStack => String -> a
error (String
"Trying to construct identity of an unknown object.")

    -- | Find all acyclic raw paths between two nodes in a graph.

    findAcyclicRawPaths :: (Eq a) => Graph a b -> a -> a -> [RawPath a b]
    findAcyclicRawPaths :: forall a b. Eq a => Graph a b -> a -> a -> [RawPath a b]
findAcyclicRawPaths Graph a b
g a
s a
t = Graph a b -> a -> a -> [a] -> [[Arrow a b]]
forall {b} {c}.
Eq b =>
([b], [Arrow b c]) -> b -> b -> [b] -> [[Arrow b c]]
findAcyclicRawPathsVisitedNodes Graph a b
g a
s a
t [] where
        findAcyclicRawPathsVisitedNodes :: ([b], [Arrow b c]) -> b -> b -> [b] -> [[Arrow b c]]
findAcyclicRawPathsVisitedNodes g :: ([b], [Arrow b c])
g@([b]
n,[Arrow b c]
e) b
s b
t [b]
v
            | b -> [b] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem b
t [b]
v = []
            | b
s b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
t = [[]]
            | Bool
otherwise = ([[[Arrow b c]]] -> [[Arrow b c]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((([[Arrow b c]] -> [[Arrow b c]])
 -> [[Arrow b c]] -> [[Arrow b c]])
-> [[[Arrow b c]] -> [[Arrow b c]]]
-> [[[Arrow b c]]]
-> [[[Arrow b c]]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([[Arrow b c]] -> [[Arrow b c]]) -> [[Arrow b c]] -> [[Arrow b c]]
forall a b. (a -> b) -> a -> b
($) ((([Arrow b c] -> [Arrow b c]) -> [[Arrow b c]] -> [[Arrow b c]])
-> [[Arrow b c] -> [Arrow b c]] -> [[[Arrow b c]] -> [[Arrow b c]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Arrow b c] -> [Arrow b c]) -> [[Arrow b c]] -> [[Arrow b c]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Arrow b c -> [Arrow b c] -> [Arrow b c])
-> [Arrow b c] -> [[Arrow b c] -> [Arrow b c]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:) [Arrow b c]
inwardEdges)) ((Arrow b c -> [[Arrow b c]]) -> [Arrow b c] -> [[[Arrow b c]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: Arrow b c
x@(b
s1,b
t1,c
l1) -> (([b], [Arrow b c]) -> b -> b -> [b] -> [[Arrow b c]]
findAcyclicRawPathsVisitedNodes ([b], [Arrow b c])
g b
s b
s1 (b
tb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
v))) [Arrow b c]
inwardEdges))) where
                            inwardEdges :: [Arrow b c]
inwardEdges = (([b], [Arrow b c]) -> b -> [Arrow b c]
forall a b. Eq a => Graph a b -> a -> [Arrow a b]
findInwardEdges ([b], [Arrow b c])
g b
t) 
    
    -- | An elementary cycle is a cycle which is not composed of any other cycle.

    findElementaryCycles :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> a -> [RawPath a b]
    findElementaryCycles :: forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> a -> [RawPath a b]
findElementaryCycles Graph a b
g CompositionLaw a b
cl a
o = [RawPath a b] -> [RawPath a b]
forall a. Eq a => [a] -> [a]
nub (CompositionLaw a b -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> RawPath a b -> RawPath a b
simplify CompositionLaw a b
cl (RawPath a b -> RawPath a b) -> [RawPath a b] -> [RawPath a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> []RawPath a b -> [RawPath a b] -> [RawPath a b]
forall a. a -> [a] -> [a]
:([[RawPath a b]] -> [RawPath a b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (([Arrow a b -> RawPath a b] -> Arrow a b -> [RawPath a b])
-> [[Arrow a b -> RawPath a b]] -> RawPath a b -> [[RawPath a b]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Arrow a b -> RawPath a b] -> Arrow a b -> [RawPath a b]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (([RawPath a b] -> [Arrow a b -> RawPath a b])
-> [[RawPath a b]] -> [[Arrow a b -> RawPath a b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RawPath a b -> Arrow a b -> RawPath a b)
-> [RawPath a b] -> [Arrow a b -> RawPath a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\RawPath a b
x Arrow a b
y -> (Arrow a b
yArrow a b -> RawPath a b -> RawPath a b
forall a. a -> [a] -> [a]
:RawPath a b
x))) ((Arrow a b -> [RawPath a b]) -> RawPath a b -> [[RawPath a b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
s,a
_,b
_) ->  (Graph a b -> a -> a -> [RawPath a b]
forall a b. Eq a => Graph a b -> a -> a -> [RawPath a b]
findAcyclicRawPaths Graph a b
g a
o a
s)) RawPath a b
inEdges)) RawPath a b
inEdges))) where inEdges :: RawPath a b
inEdges = (Graph a b -> a -> RawPath a b
forall a b. Eq a => Graph a b -> a -> [Arrow a b]
findInwardEdges Graph a b
g a
o)
    
    -- | Composes every elementary cycles of a node until they simplify into a fixed set of cycles.

    --

    -- Warning : this function can do an infinite loop if the composition law does not simplify a cycle or all of its child cycles.

    -- We throw an error to stop this function when we reach a depth of 5.

    findCycles :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> a -> [RawPath a b]
    findCycles :: forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> a -> [RawPath a b]
findCycles Graph a b
g CompositionLaw a b
cl a
o = Graph a b
-> CompositionLaw a b
-> a
-> [RawPath a b]
-> Integer
-> [RawPath a b]
forall {t} {t} {b}.
(Num t, Eq t, Eq t, Eq b) =>
Graph t b
-> CompositionLaw t b -> t -> [RawPath t b] -> t -> [RawPath t b]
findCyclesWithPreviousCycles Graph a b
g CompositionLaw a b
cl a
o (Graph a b -> CompositionLaw a b -> a -> [RawPath a b]
forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> a -> [RawPath a b]
findElementaryCycles Graph a b
g CompositionLaw a b
cl a
o) Integer
maximumLoopDepth where 
        findCyclesWithPreviousCycles :: Graph t b
-> CompositionLaw t b -> t -> [RawPath t b] -> t -> [RawPath t b]
findCyclesWithPreviousCycles Graph t b
g CompositionLaw t b
cl t
o [RawPath t b]
p t
n = if t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 then String -> [RawPath t b]
forall a. HasCallStack => String -> a
error String
"Suspected infinite loop because of a malformed composition graph." else if [RawPath t b]
newCycles [RawPath t b] -> [RawPath t b] -> [RawPath t b]
forall a. Eq a => [a] -> [a] -> [a]
\\ [RawPath t b]
p [RawPath t b] -> [RawPath t b] -> Bool
forall a. Eq a => a -> a -> Bool
== [] then [RawPath t b]
newCycles else (Graph t b
-> CompositionLaw t b -> t -> [RawPath t b] -> t -> [RawPath t b]
findCyclesWithPreviousCycles Graph t b
g CompositionLaw t b
cl t
o [RawPath t b]
newCycles (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1)) where
            newCycles :: [RawPath t b]
newCycles = [RawPath t b] -> [RawPath t b]
forall a. Eq a => [a] -> [a]
nub ((CompositionLaw t b -> RawPath t b -> RawPath t b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> RawPath a b -> RawPath a b
simplify CompositionLaw t b
cl) (RawPath t b -> RawPath t b) -> [RawPath t b] -> [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)
-> [RawPath t b] -> [RawPath t b -> RawPath t b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RawPath t b]
p [RawPath t b -> RawPath t b] -> [RawPath t b] -> [RawPath t b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Graph t b -> CompositionLaw t b -> t -> [RawPath t b]
forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> a -> [RawPath a b]
findElementaryCycles Graph t b
g CompositionLaw t b
cl t
o))
    
    -- | Helper function which intertwine the second list in the first list.

    --

    -- Example : intertwine [1,2,3] [4,5] = [1,4,2,5,3]

    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)))
    
    -- | Takes a path and intertwine every cycles possible along its path.

    intertwineWithCycles :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> a -> RawPath a b -> [RawPath a b]
    intertwineWithCycles :: forall a b.
(Eq a, Eq b) =>
Graph a b
-> CompositionLaw a b -> a -> RawPath a b -> [RawPath a b]
intertwineWithCycles Graph a b
g CompositionLaw a b
cl a
_ p :: RawPath a b
p@(x :: Arrow a b
x@(a
_,a
t,b
_):RawPath a b
xs) = ([RawPath a b] -> RawPath a b
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([RawPath a b] -> RawPath a b) -> [[RawPath a b]] -> [RawPath a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[RawPath a b] -> [RawPath a b]]
-> [RawPath a b] -> [[RawPath a b]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (([RawPath a b] -> [RawPath a b] -> [RawPath a b])
-> [[RawPath a b]] -> [[RawPath a b] -> [RawPath a b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [RawPath a b] -> [RawPath a b] -> [RawPath a b]
forall a. [a] -> [a] -> [a]
intertwine [[RawPath a b]]
prodCycles) ((Arrow a b -> RawPath a b) -> RawPath a b -> [RawPath a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Arrow a b -> RawPath a b -> RawPath a b
forall a. a -> [a] -> [a]
:[]) RawPath a b
p)) where
        prodCycles :: [[RawPath a b]]
prodCycles = [[RawPath a b]] -> [[RawPath a b]]
forall a. [[a]] -> [[a]]
cartesianProduct [[RawPath a b]]
cycles
        cycles :: [[RawPath a b]]
cycles = (Graph a b -> CompositionLaw a b -> a -> [RawPath a b]
forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> a -> [RawPath a b]
findCycles Graph a b
g CompositionLaw a b
cl a
t)[RawPath a b] -> [[RawPath a b]] -> [[RawPath a b]]
forall a. a -> [a] -> [a]
:((\(a
s,a
_,b
_) -> (Graph a b -> CompositionLaw a b -> a -> [RawPath a b]
forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> a -> [RawPath a b]
findCycles Graph a b
g CompositionLaw a b
cl a
s)) (Arrow a b -> [RawPath a b]) -> RawPath a b -> [[RawPath a b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawPath a b
p)
    intertwineWithCycles Graph a b
g CompositionLaw a b
cl a
s [] = (Graph a b -> CompositionLaw a b -> a -> [RawPath a b]
forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> a -> [RawPath a b]
findCycles Graph a b
g CompositionLaw a b
cl a
s)
        
    -- | Enumerates all paths between two nodes and construct composition graph morphisms with them.

    mkAr :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> a -> a -> [CGMorphism a b]
    mkAr :: forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> a -> a -> [CGMorphism a b]
mkAr Graph a b
g CompositionLaw a b
cl a
s a
t = (\RawPath a b
p -> CGMorphism :: forall a b. Path a b -> CompositionLaw a b -> CGMorphism a b
CGMorphism{path :: Path a b
path=(a
s,RawPath a b
p,a
t),compositionLaw :: CompositionLaw a b
compositionLaw=CompositionLaw a b
cl}) (RawPath a b -> CGMorphism a b)
-> [RawPath a b] -> [CGMorphism a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RawPath a b] -> [RawPath a b]
forall a. Eq a => [a] -> [a]
nub (CompositionLaw a b -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> RawPath a b -> RawPath a b
simplify CompositionLaw a b
cl (RawPath a b -> RawPath a b) -> [RawPath a b] -> [RawPath a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[RawPath a b]] -> [RawPath a b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat((Graph a b
-> CompositionLaw a b -> a -> RawPath a b -> [RawPath a b]
forall a b.
(Eq a, Eq b) =>
Graph a b
-> CompositionLaw a b -> a -> RawPath a b -> [RawPath a b]
intertwineWithCycles Graph a b
g CompositionLaw a b
cl a
s) (RawPath a b -> [RawPath a b]) -> [RawPath a b] -> [[RawPath a b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RawPath a b]
acyclicPaths)) where
        acyclicPaths :: [RawPath a b]
acyclicPaths = [RawPath a b] -> [RawPath a b]
forall a. Eq a => [a] -> [a]
nub ([RawPath a b] -> [RawPath a b]) -> [RawPath a b] -> [RawPath a b]
forall a b. (a -> b) -> a -> b
$ (CompositionLaw a b -> RawPath a b -> RawPath a b
forall a b.
(Eq a, Eq b) =>
CompositionLaw a b -> RawPath a b -> RawPath a b
simplify CompositionLaw a b
cl) (RawPath a b -> RawPath a b) -> [RawPath a b] -> [RawPath a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Graph a b -> a -> a -> [RawPath a b]
forall a b. Eq a => Graph a b -> a -> a -> [RawPath a b]
findAcyclicRawPaths Graph a b
g a
s a
t)
    
    -- | A composition graph is a graph with a composition law. Use `mkCompositionGraph` to instantiate it unless it takes too long.

    data CompositionGraph a b = CompositionGraph {forall a b. CompositionGraph a b -> Graph a b
graph :: Graph a b, forall a b. CompositionGraph a b -> CompositionLaw a b
law :: CompositionLaw a b} deriving (CompositionGraph a b -> CompositionGraph a b -> Bool
(CompositionGraph a b -> CompositionGraph a b -> Bool)
-> (CompositionGraph a b -> CompositionGraph a b -> Bool)
-> Eq (CompositionGraph a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
CompositionGraph a b -> CompositionGraph a b -> Bool
/= :: CompositionGraph a b -> CompositionGraph a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
CompositionGraph a b -> CompositionGraph a b -> Bool
== :: CompositionGraph a b -> CompositionGraph a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
CompositionGraph a b -> CompositionGraph a b -> Bool
Eq, Int -> CompositionGraph a b -> ShowS
[CompositionGraph a b] -> ShowS
CompositionGraph a b -> String
(Int -> CompositionGraph a b -> ShowS)
-> (CompositionGraph a b -> String)
-> ([CompositionGraph a b] -> ShowS)
-> Show (CompositionGraph a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b.
(Show a, Show b) =>
Int -> CompositionGraph a b -> ShowS
forall a b. (Show a, Show b) => [CompositionGraph a b] -> ShowS
forall a b. (Show a, Show b) => CompositionGraph a b -> String
showList :: [CompositionGraph a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [CompositionGraph a b] -> ShowS
show :: CompositionGraph a b -> String
$cshow :: forall a b. (Show a, Show b) => CompositionGraph a b -> String
showsPrec :: Int -> CompositionGraph a b -> ShowS
$cshowsPrec :: forall a b.
(Show a, Show b) =>
Int -> CompositionGraph a b -> ShowS
Show)
    
    instance (Eq a, Eq b) => FiniteCategory (CompositionGraph a b) (CGMorphism a b) a where
        ob :: CompositionGraph a b -> [a]
ob = ([a], [Arrow a b]) -> [a]
forall a b. (a, b) -> a
fst(([a], [Arrow a b]) -> [a])
-> (CompositionGraph a b -> ([a], [Arrow a b]))
-> CompositionGraph a b
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CompositionGraph a b -> ([a], [Arrow a b])
forall a b. CompositionGraph a b -> Graph a b
graph
        identity :: Morphism (CGMorphism a b) a =>
CompositionGraph a b -> a -> CGMorphism a b
identity CompositionGraph a b
c = ([a], [Arrow a b]) -> CompositionLaw a b -> a -> CGMorphism a b
forall a b.
Eq a =>
Graph a b -> CompositionLaw a b -> a -> CGMorphism a b
mkIdentity (CompositionGraph a b -> ([a], [Arrow a b])
forall a b. CompositionGraph a b -> Graph a b
graph CompositionGraph a b
c) (CompositionGraph a b -> CompositionLaw a b
forall a b. CompositionGraph a b -> CompositionLaw a b
law CompositionGraph a b
c)
        ar :: Morphism (CGMorphism a b) a =>
CompositionGraph a b -> a -> a -> [CGMorphism a b]
ar CompositionGraph a b
c = ([a], [Arrow a b])
-> CompositionLaw a b -> a -> a -> [CGMorphism a b]
forall a b.
(Eq a, Eq b) =>
Graph a b -> CompositionLaw a b -> a -> a -> [CGMorphism a b]
mkAr (CompositionGraph a b -> ([a], [Arrow a b])
forall a b. CompositionGraph a b -> Graph a b
graph CompositionGraph a b
c) (CompositionGraph a b -> CompositionLaw a b
forall a b. CompositionGraph a b -> CompositionLaw a b
law CompositionGraph a b
c)
    
    instance (Eq a, Eq b) => GeneratedFiniteCategory (CompositionGraph a b) (CGMorphism a b) a where
        genAr :: Morphism (CGMorphism a b) a =>
CompositionGraph a b -> a -> a -> [CGMorphism a b]
genAr c :: CompositionGraph a b
c@CompositionGraph{graph :: forall a b. CompositionGraph a b -> Graph a b
graph=Graph a b
g,law :: forall a b. CompositionGraph a b -> CompositionLaw a b
law=CompositionLaw a b
l} a
s a
t
            | a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
t = [CGMorphism a b]
gen [CGMorphism a b] -> [CGMorphism a b] -> [CGMorphism a b]
forall a. [a] -> [a] -> [a]
++ [CompositionGraph a b -> a -> CGMorphism a b
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> o -> m
identity CompositionGraph a b
c a
s]
            | Bool
otherwise = [CGMorphism a b]
gen 
            where gen :: [CGMorphism a b]
gen = CompositionLaw a b -> Arrow a b -> CGMorphism a b
forall a b. CompositionLaw a b -> Arrow a b -> CGMorphism a b
mkCGMorphism CompositionLaw a b
l (Arrow a b -> CGMorphism a b) -> [Arrow a b] -> [CGMorphism a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Arrow a b -> Bool) -> [Arrow a b] -> [Arrow a b]
forall a. (a -> Bool) -> [a] -> [a]
filter (\a :: Arrow a b
a@(a
s1,a
t1,b
_) -> a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
s1 Bool -> Bool -> Bool
&& a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
t1) ([Arrow a b] -> [Arrow a b]) -> [Arrow a b] -> [Arrow a b]
forall a b. (a -> b) -> a -> b
$ Graph a b -> [Arrow a b]
forall a b. (a, b) -> b
snd Graph a b
g)
            
        decompose :: Morphism (CGMorphism a b) a =>
CompositionGraph a b -> CGMorphism a b -> [CGMorphism a b]
decompose CompositionGraph a b
c m :: CGMorphism a b
m@CGMorphism{path :: forall a b. CGMorphism a b -> Path a b
path=(a
_,[Arrow a b]
rp,a
_),compositionLaw :: forall a b. CGMorphism a b -> CompositionLaw a b
compositionLaw=CompositionLaw a b
l}
            | CompositionGraph a b -> CGMorphism a b -> Bool
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isIdentity CompositionGraph a b
c CGMorphism a b
m = [CGMorphism a b
m]
            | Bool
otherwise = CompositionLaw a b -> Arrow a b -> CGMorphism a b
forall a b. CompositionLaw a b -> Arrow a b -> CGMorphism a b
mkCGMorphism CompositionLaw a b
l (Arrow a b -> CGMorphism a b) -> [Arrow a b] -> [CGMorphism a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  [Arrow a b]
rp
            
    instance (PrettyPrintable a, PrettyPrintable b, Eq a, Eq b) => PrettyPrintable (CompositionGraph a b) where
        pprint :: CompositionGraph a b -> String
pprint cg :: CompositionGraph a b
cg@CompositionGraph{graph :: forall a b. CompositionGraph a b -> Graph a b
graph=([a]
nodes,[Arrow a b]
arrs),law :: forall a b. CompositionGraph a b -> CompositionLaw a b
law=CompositionLaw a b
_} = String
"CompositionGraph("String -> ShowS
forall a. [a] -> [a] -> [a]
++String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," (a -> String
forall a. PrettyPrintable a => a -> String
pprint (a -> String) -> [a] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
nodes)String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((\(a
a,a
b,b
c) -> b -> String
forall a. PrettyPrintable a => a -> String
pprint b
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. PrettyPrintable a => a -> String
pprint a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"->" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. PrettyPrintable a => a -> String
pprint a
b) (Arrow a b -> String) -> [Arrow a b] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Arrow a b]
arrs)        
    
    -- | Optimized version of isGenerator for `CompositionGraph`.

    isGen :: (Eq a) => CGMorphism a b -> Bool
    isGen :: forall a b. Eq a => CGMorphism a b -> Bool
isGen m :: CGMorphism a b
m@CGMorphism{path :: forall a b. CGMorphism a b -> Path a b
path=p :: Path a b
p@(a
s,RawPath a b
rp,a
t),compositionLaw :: forall a b. CGMorphism a b -> CompositionLaw a b
compositionLaw=CompositionLaw a b
_} = (RawPath a b -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length RawPath a b
rp ) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
    
    -- | Optimized version of isComposite for `CompositionGraph`.

    isComp :: (Eq a) => CGMorphism a b -> Bool
    isComp :: forall a b. Eq a => CGMorphism a b -> Bool
isComp = Bool -> Bool
not(Bool -> Bool)
-> (CGMorphism a b -> Bool) -> CGMorphism a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CGMorphism a b -> Bool
forall a b. Eq a => CGMorphism a b -> Bool
isGen
    
    -- | Returns the label of a generator arrow which is not an identity.

    getLabel :: (Eq a) => CGMorphism a b -> Maybe b
    getLabel :: forall a b. Eq a => CGMorphism a b -> Maybe b
getLabel CGMorphism{path :: forall a b. CGMorphism a b -> Path a b
path=(a
_,[(a
_,a
_,b
label)],a
_),compositionLaw :: forall a b. CGMorphism a b -> CompositionLaw a b
compositionLaw=CompositionLaw a b
_} = b -> Maybe b
forall a. a -> Maybe a
Just b
label
    getLabel CGMorphism a b
_ = Maybe b
forall a. Maybe a
Nothing
            
    -- | Constructs a `CompositionGraph` from a `Graph` and a `CompositionLaw`.

    --

    --  This is the preferred way of instantiating a `CompositionGraph` with `mkEmptyCompositionGraph`. This function checks the category structure,

    --  that is why it can return a `FiniteCategoryError` if the graph and the composition law provided don't produce a valid category.

    --  If this function takes too much time, use the `CompositionGraph` constructor at your own risk (it is your responsability to check the

    --  the category structure is valid).

    mkCompositionGraph :: (Eq a, Eq b, Show a) => Graph a b -> CompositionLaw a b -> Either (FiniteCategoryError (CGMorphism a b) a) (CompositionGraph a b) 
    mkCompositionGraph :: forall a b.
(Eq a, Eq b, Show a) =>
Graph a b
-> CompositionLaw a b
-> Either
     (FiniteCategoryError (CGMorphism a b) a) (CompositionGraph a b)
mkCompositionGraph Graph a b
g CompositionLaw a b
l
        | Maybe (FiniteCategoryError (CGMorphism a b) a) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (FiniteCategoryError (CGMorphism a b) a)
check = CompositionGraph a b
-> Either
     (FiniteCategoryError (CGMorphism a b) a) (CompositionGraph a b)
forall a b. b -> Either a b
Right CompositionGraph a b
c_g
        | Bool
otherwise = FiniteCategoryError (CGMorphism a b) a
-> Either
     (FiniteCategoryError (CGMorphism a b) a) (CompositionGraph a b)
forall a b. a -> Either a b
Left (Maybe (FiniteCategoryError (CGMorphism a b) a)
-> FiniteCategoryError (CGMorphism a b) a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (FiniteCategoryError (CGMorphism a b) a)
check)
        where
            c_g :: CompositionGraph a b
c_g = CompositionGraph :: forall a b. Graph a b -> CompositionLaw a b -> CompositionGraph a b
CompositionGraph {graph :: Graph a b
graph = Graph a b
g, law :: CompositionLaw a b
law = CompositionLaw a b
l}
            check :: Maybe (FiniteCategoryError (CGMorphism a b) a)
check = CompositionGraph a b
-> Maybe (FiniteCategoryError (CGMorphism a b) a)
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> Maybe (FiniteCategoryError m o)
checkGeneratedFiniteCategoryProperties CompositionGraph a b
c_g
    
    -- | Constructs an empty `CompositionGraph`.

    --

    -- Use `insertObject`, `insertMorphism` and `identifyMorphisms` to build a `CompositionGraph` from it.

    mkEmptyCompositionGraph :: CompositionGraph a b
    mkEmptyCompositionGraph :: forall a b. CompositionGraph a b
mkEmptyCompositionGraph = CompositionGraph :: forall a b. Graph a b -> CompositionLaw a b -> CompositionGraph a b
CompositionGraph {graph :: Graph a b
graph=([],[]), law :: CompositionLaw a b
law=[]}
    
    
    
    -- | Transforms any `FiniteCategory` into a composition graph.

    --

    -- The composition graph will take more space in memory compared to the original category because the composition law is stored as a Data.Map.

    --

    -- Returns the `CompositionGraph` and an isofunctor as a `Diagram`.

    finiteCategoryToCompositionGraph :: (FiniteCategory c m o, Morphism m o, Eq m, Eq o) => c -> (CompositionGraph o m, Diagram c m o (CompositionGraph o m) (CGMorphism o m) o)
    finiteCategoryToCompositionGraph :: forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c
-> (CompositionGraph o m,
    Diagram c m o (CompositionGraph o m) (CGMorphism o m) o)
finiteCategoryToCompositionGraph c
cat = (CompositionGraph o m
cg,Diagram c m o (CompositionGraph o m) (CGMorphism o m) o
isofunct)
        where
            morphToArrow :: c -> (b, b, c)
morphToArrow c
f = ((c -> b
forall m o. Morphism m o => m -> o
source c
f),(c -> b
forall m o. Morphism m o => m -> o
target c
f),c
f)
            catLaw :: [([(o, o, m)], [(o, o, m)])]
catLaw = [
                if c -> m -> Bool
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isNotIdentity c
cat (m
g m -> m -> m
forall m o. Morphism m o => m -> m -> m
@ m
f) then
                    ([m -> (o, o, m)
forall {c} {b}. Morphism c b => c -> (b, b, c)
morphToArrow m
g,m -> (o, o, m)
forall {c} {b}. Morphism c b => c -> (b, b, c)
morphToArrow m
f],[m -> (o, o, m)
forall {c} {b}. Morphism c b => c -> (b, b, c)
morphToArrow (m
g m -> m -> m
forall m o. Morphism m o => m -> m -> m
@ m
f)])
                else
                    ([m -> (o, o, m)
forall {c} {b}. Morphism c b => c -> (b, b, c)
morphToArrow m
g,m -> (o, o, m)
forall {c} {b}. Morphism c b => c -> (b, b, c)
morphToArrow m
f],[]) |
                m
f <- (c -> [m]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows c
cat), m
g <- (c -> o -> [m]
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> o -> [m]
arFrom c
cat (m -> o
forall m o. Morphism m o => m -> o
target m
f)), c -> m -> Bool
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isNotIdentity c
cat m
f, c -> m -> Bool
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isNotIdentity c
cat m
g]
            cg :: CompositionGraph o m
cg = (CompositionGraph :: forall a b. Graph a b -> CompositionLaw a b -> CompositionGraph a b
CompositionGraph{graph :: Graph o m
graph=(c -> [o]
forall c m o. FiniteCategory c m o => c -> [o]
ob c
cat, [m -> (o, o, m)
forall {c} {b}. Morphism c b => c -> (b, b, c)
morphToArrow m
f | m
f <- (c -> [m]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows c
cat), c -> m -> Bool
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isNotIdentity c
cat m
f])
                                 , law :: [([(o, o, m)], [(o, o, m)])]
law= [([(o, o, m)], [(o, o, m)])]
catLaw})
            isofunct :: Diagram c m o (CompositionGraph o m) (CGMorphism o m) o
isofunct = Diagram :: forall c1 m1 o1 c2 m2 o2.
c1
-> c2
-> AssociationList o1 o2
-> AssociationList m1 m2
-> Diagram c1 m1 o1 c2 m2 o2
Diagram{src :: c
src=c
cat,tgt :: CompositionGraph o m
tgt=CompositionGraph o m
cg,omap :: AssociationList o o
omap=(o -> o) -> [o] -> AssociationList o o
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList o -> o
forall a. a -> a
id (c -> [o]
forall c m o. FiniteCategory c m o => c -> [o]
ob c
cat),mmap :: AssociationList m (CGMorphism o m)
mmap=(m -> CGMorphism o m) -> [m] -> AssociationList m (CGMorphism o m)
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList (\m
f -> if c -> m -> Bool
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isNotIdentity c
cat m
f
                                                                        then
                                                                            [([(o, o, m)], [(o, o, m)])] -> (o, o, m) -> CGMorphism o m
forall a b. CompositionLaw a b -> Arrow a b -> CGMorphism a b
mkCGMorphism [([(o, o, m)], [(o, o, m)])]
catLaw (m -> (o, o, m)
forall {c} {b}. Morphism c b => c -> (b, b, c)
morphToArrow m
f)
                                                                        else
                                                                            CompositionGraph o m -> o -> CGMorphism o m
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> o -> m
identity CompositionGraph o m
cg (m -> o
forall m o. Morphism m o => m -> o
source m
f)) (c -> [m]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows c
cat)}
                                                                            
    -- | Transforms any `GeneratedFiniteCategory` into a composition graph.

    --

    -- The composition graph will take more space in memory compared to the original category because the composition law is stored as a Data.Map.

    --

    -- Returns the `CompositionGraph` and an isofunctor as a `Diagram`.

    generatedFiniteCategoryToCompositionGraph :: (GeneratedFiniteCategory c m o, Morphism m o, Eq m, Eq o) => c -> (CompositionGraph o m, Diagram c m o (CompositionGraph o m) (CGMorphism o m) o)
    generatedFiniteCategoryToCompositionGraph :: forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c
-> (CompositionGraph o m,
    Diagram c m o (CompositionGraph o m) (CGMorphism o m) o)
generatedFiniteCategoryToCompositionGraph c
cat = (CompositionGraph o m
cg,Diagram c m o (CompositionGraph o m) (CGMorphism o m) o
isofunct)
        where
            morphToArrow :: c -> (b, b, c)
morphToArrow c
f = ((c -> b
forall m o. Morphism m o => m -> o
source c
f),(c -> b
forall m o. Morphism m o => m -> o
target c
f),c
f)
            catLaw :: [([(o, o, m)], [(o, o, m)])]
catLaw = [
                if c -> m -> Bool
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isNotIdentity c
cat (m
g m -> m -> m
forall m o. Morphism m o => m -> m -> m
@ m
f) then
                    ((m -> (o, o, m)
forall {c} {b}. Morphism c b => c -> (b, b, c)
morphToArrow (m -> (o, o, m)) -> [m] -> [(o, o, m)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> m -> [m]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> m -> [m]
decompose c
cat m
g))[(o, o, m)] -> [(o, o, m)] -> [(o, o, m)]
forall a. [a] -> [a] -> [a]
++(m -> (o, o, m)
forall {c} {b}. Morphism c b => c -> (b, b, c)
morphToArrow (m -> (o, o, m)) -> [m] -> [(o, o, m)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> m -> [m]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> m -> [m]
decompose c
cat m
f)), m -> (o, o, m)
forall {c} {b}. Morphism c b => c -> (b, b, c)
morphToArrow (m -> (o, o, m)) -> [m] -> [(o, o, m)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> m -> [m]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> m -> [m]
decompose c
cat (m
g m -> m -> m
forall m o. Morphism m o => m -> m -> m
@ m
f)))
                else
                    ((m -> (o, o, m)
forall {c} {b}. Morphism c b => c -> (b, b, c)
morphToArrow (m -> (o, o, m)) -> [m] -> [(o, o, m)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> m -> [m]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> m -> [m]
decompose c
cat m
g))[(o, o, m)] -> [(o, o, m)] -> [(o, o, m)]
forall a. [a] -> [a] -> [a]
++(m -> (o, o, m)
forall {c} {b}. Morphism c b => c -> (b, b, c)
morphToArrow (m -> (o, o, m)) -> [m] -> [(o, o, m)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> m -> [m]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> m -> [m]
decompose c
cat m
f)),[]) |
                m
f <- (c -> [m]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows c
cat), m
g <- (c -> o -> [m]
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> o -> [m]
arFrom c
cat (m -> o
forall m o. Morphism m o => m -> o
target m
f)), c -> m -> Bool
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isNotIdentity c
cat m
f, c -> m -> Bool
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isNotIdentity c
cat m
g]
            cg :: CompositionGraph o m
cg = (CompositionGraph :: forall a b. Graph a b -> CompositionLaw a b -> CompositionGraph a b
CompositionGraph{graph :: Graph o m
graph=(c -> [o]
forall c m o. FiniteCategory c m o => c -> [o]
ob c
cat, [m -> (o, o, m)
forall {c} {b}. Morphism c b => c -> (b, b, c)
morphToArrow m
f | m
f <- (c -> [m]
forall c m o.
(GeneratedFiniteCategory c m o, GeneratedFiniteCategory c m o,
 Morphism m o) =>
c -> [m]
genArrows c
cat), c -> m -> Bool
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isNotIdentity c
cat m
f])
                                 , law :: [([(o, o, m)], [(o, o, m)])]
law= [([(o, o, m)], [(o, o, m)])]
catLaw})
            isofunct :: Diagram c m o (CompositionGraph o m) (CGMorphism o m) o
isofunct = Diagram :: forall c1 m1 o1 c2 m2 o2.
c1
-> c2
-> AssociationList o1 o2
-> AssociationList m1 m2
-> Diagram c1 m1 o1 c2 m2 o2
Diagram{src :: c
src=c
cat,tgt :: CompositionGraph o m
tgt=CompositionGraph o m
cg,omap :: AssociationList o o
omap=(o -> o) -> [o] -> AssociationList o o
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList o -> o
forall a. a -> a
id (c -> [o]
forall c m o. FiniteCategory c m o => c -> [o]
ob c
cat),mmap :: AssociationList m (CGMorphism o m)
mmap= (m -> CGMorphism o m) -> [m] -> AssociationList m (CGMorphism o m)
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList (\m
f -> if c -> m -> Bool
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isNotIdentity c
cat m
f
                                                                        then
                                                                            CGMorphism :: forall a b. Path a b -> CompositionLaw a b -> CGMorphism a b
CGMorphism {path :: Path o m
path=(m -> o
forall m o. Morphism m o => m -> o
source m
f,(m -> (o, o, m)
forall {c} {b}. Morphism c b => c -> (b, b, c)
morphToArrow (m -> (o, o, m)) -> [m] -> [(o, o, m)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> m -> [m]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> m -> [m]
decompose c
cat m
f)),m -> o
forall m o. Morphism m o => m -> o
target m
f),compositionLaw :: [([(o, o, m)], [(o, o, m)])]
compositionLaw=[([(o, o, m)], [(o, o, m)])]
catLaw}
                                                                        else
                                                                            CompositionGraph o m -> o -> CGMorphism o m
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> o -> m
identity CompositionGraph o m
cg (m -> o
forall m o. Morphism m o => m -> o
source m
f)) (c -> [m]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows c
cat)}
    
    -- | The datatype for composition graph construction errors.

    data CompositionGraphError a b = InsertMorphismNonExistantSource {forall a b. CompositionGraphError a b -> b
faultyMorph :: b, forall a b. CompositionGraphError a b -> a
faultySrc :: a}
                                   | InsertMorphismNonExistantTarget {faultyMorph :: b, forall a b. CompositionGraphError a b -> a
faultyTgt :: a}
                                   | IdentifyGenerator {forall a b. CompositionGraphError a b -> CGMorphism a b
gen :: CGMorphism a b}
                                   | UnidentifyNonExistantMorphism {forall a b. CompositionGraphError a b -> CGMorphism a b
morph :: CGMorphism a b}
                                   | ResultingCategoryError (FiniteCategoryError (CGMorphism a b) a)
                                   | ReplaceNonExistantObject {forall a b. CompositionGraphError a b -> a
faultyObj :: a}
                                   | ReplaceCompositeMorphism {forall a b. CompositionGraphError a b -> CGMorphism a b
composite :: CGMorphism a b}
                                   | DeleteIdentity {forall a b. CompositionGraphError a b -> CGMorphism a b
faultyIdentity :: CGMorphism a b}
                                   | DeleteCompositeMorph {composite :: CGMorphism a b}
                                   | DeleteNonExistantObjectMorph {forall a b. CompositionGraphError a b -> CGMorphism a b
neMorph :: CGMorphism a b}
                                   | DeleteNonExistantObject {faultyObj :: a}
    
    -- | Inserts an object in a `CompositionGraph`, returns the new `CompositionGraph` and a `PartialFunctor` which is the insertion functor.

    insertObject :: (Eq a, Eq b) => CompositionGraph a b -> a -> (CompositionGraph a b, (PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
    insertObject :: forall a b.
(Eq a, Eq b) =>
CompositionGraph a b
-> a
-> (CompositionGraph a b,
    PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
insertObject prev :: CompositionGraph a b
prev@CompositionGraph{graph :: forall a b. CompositionGraph a b -> Graph a b
graph=([a]
nodes,[Arrow a b]
arrs), law :: forall a b. CompositionGraph a b -> CompositionLaw a b
law=CompositionLaw a b
l} a
obj = (CompositionGraph a b
new, PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
funct)
        where
            new :: CompositionGraph a b
new = CompositionGraph :: forall a b. Graph a b -> CompositionLaw a b -> CompositionGraph a b
CompositionGraph{graph :: ([a], [Arrow a b])
graph=(a
obja -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
nodes,[Arrow a b]
arrs), law :: CompositionLaw a b
law=CompositionLaw a b
l}
            funct :: PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
funct = PartialFunctor :: forall c m o.
c
-> c
-> AssociationList o o
-> AssociationList m m
-> PartialFunctor c m o
PartialFunctor{srcPF :: CompositionGraph a b
srcPF=CompositionGraph a b
prev,tgtPF :: CompositionGraph a b
tgtPF=CompositionGraph a b
new,omapPF :: AssociationList a a
omapPF=(a -> a) -> [a] -> AssociationList a a
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList a -> a
forall a. a -> a
id [a]
nodes,mmapPF :: AssociationList (CGMorphism a b) (CGMorphism a b)
mmapPF=(CGMorphism a b -> CGMorphism a b)
-> [CGMorphism a b]
-> AssociationList (CGMorphism a b) (CGMorphism a b)
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList CGMorphism a b -> CGMorphism a b
forall a. a -> a
id (CompositionGraph a b -> [CGMorphism a b]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows CompositionGraph a b
prev)}
            
    -- | Inserts a morphism in a `CompositionGraph`, returns the new `CompositionGraph` and a `PartialFunctor` which is the insertion functor if it can, returns Nothing otherwise.

    --

    -- This function fails if the two nodes provided as source and target for the new morphism are not both in the composition graph.

    --

    -- The result may not be a valid `CompositionGraph` (the new morphism might close a loop creating infinitely many morphisms).

    -- You can use the function `identifyMorphisms` to transform it back into a valid `CompositionGraph`.

    insertMorphism :: (Eq a, Eq b) => CompositionGraph a b -> a -> a -> b -> Either
                                                                                (CompositionGraphError a b)
                                                                                (CompositionGraph a b, (PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
    insertMorphism :: forall a b.
(Eq a, Eq b) =>
CompositionGraph a b
-> a
-> a
-> b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
insertMorphism prev :: CompositionGraph a b
prev@CompositionGraph{graph :: forall a b. CompositionGraph a b -> Graph a b
graph=([a]
nodes,[Arrow a b]
arrs), law :: forall a b. CompositionGraph a b -> CompositionLaw a b
law=CompositionLaw a b
l} a
src a
tgt b
morph
        | a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
src [a]
nodes Bool -> Bool -> Bool
&& a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
tgt [a]
nodes = (CompositionGraph a b,
 PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b. b -> Either a b
Right (CompositionGraph a b
new, PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
funct)
        | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
src [a]
nodes = CompositionGraphError a b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b. a -> Either a b
Left InsertMorphismNonExistantSource :: forall a b. b -> a -> CompositionGraphError a b
InsertMorphismNonExistantSource{faultyMorph :: b
faultyMorph=b
morph, faultySrc :: a
faultySrc=a
src}
        | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
tgt [a]
nodes = CompositionGraphError a b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b. a -> Either a b
Left InsertMorphismNonExistantTarget :: forall a b. b -> a -> CompositionGraphError a b
InsertMorphismNonExistantTarget{faultyMorph :: b
faultyMorph=b
morph, faultyTgt :: a
faultyTgt=a
tgt}
        where
            new :: CompositionGraph a b
new = CompositionGraph :: forall a b. Graph a b -> CompositionLaw a b -> CompositionGraph a b
CompositionGraph{graph :: ([a], [Arrow a b])
graph=([a]
nodes,(a
src, a
tgt, b
morph)Arrow a b -> [Arrow a b] -> [Arrow a b]
forall a. a -> [a] -> [a]
:[Arrow a b]
arrs), law :: CompositionLaw a b
law=CompositionLaw a b
l}
            funct :: PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
funct = PartialFunctor :: forall c m o.
c
-> c
-> AssociationList o o
-> AssociationList m m
-> PartialFunctor c m o
PartialFunctor{srcPF :: CompositionGraph a b
srcPF=CompositionGraph a b
prev,tgtPF :: CompositionGraph a b
tgtPF=CompositionGraph a b
new,omapPF :: AssociationList a a
omapPF=(a -> a) -> [a] -> AssociationList a a
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList a -> a
forall a. a -> a
id [a]
nodes,mmapPF :: AssociationList (CGMorphism a b) (CGMorphism a b)
mmapPF=(CGMorphism a b -> CGMorphism a b)
-> [CGMorphism a b]
-> AssociationList (CGMorphism a b) (CGMorphism a b)
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList CGMorphism a b -> CGMorphism a b
forall a. a -> a
id (CompositionGraph a b -> [CGMorphism a b]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows CompositionGraph a b
prev)}
            
    -- | Identify two morphisms if it is possible, if not returns an error in a Left member.

    --

    -- You can only identify a composite morphism to another morphism.

    --

    -- If the resulting composition graph is not associative, it returns Left CompositionNotAssociative.

    identifyMorphisms :: (Eq a, Eq b) => CompositionGraph a b -> CGMorphism a b -> CGMorphism a b -> Either
                                                                                                        (CompositionGraphError a b)
                                                                                                        (CompositionGraph a b, (PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
    identifyMorphisms :: forall a b.
(Eq a, Eq b) =>
CompositionGraph a b
-> CGMorphism a b
-> CGMorphism a b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
identifyMorphisms prev :: CompositionGraph a b
prev@CompositionGraph{graph :: forall a b. CompositionGraph a b -> Graph a b
graph=([a]
nodes,[Arrow a b]
arrs), law :: forall a b. CompositionGraph a b -> CompositionLaw a b
law=CompositionLaw a b
l} CGMorphism a b
srcM CGMorphism a b
tgtM
        | CGMorphism a b -> Bool
forall a b. Eq a => CGMorphism a b -> Bool
isGen CGMorphism a b
srcM = CompositionGraphError a b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b. a -> Either a b
Left IdentifyGenerator :: forall a b. CGMorphism a b -> CompositionGraphError a b
IdentifyGenerator{gen :: CGMorphism a b
gen=CGMorphism a b
srcM}
        | Maybe (FiniteCategoryError (CGMorphism a b) a) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (FiniteCategoryError (CGMorphism a b) a)
check = (CompositionGraph a b,
 PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b. b -> Either a b
Right (CompositionGraph a b
new,PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
funct)
        | Bool
otherwise = CompositionGraphError a b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b. a -> Either a b
Left (CompositionGraphError a b
 -> Either
      (CompositionGraphError a b)
      (CompositionGraph a b,
       PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
-> CompositionGraphError a b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b. (a -> b) -> a -> b
$ FiniteCategoryError (CGMorphism a b) a -> CompositionGraphError a b
forall a b.
FiniteCategoryError (CGMorphism a b) a -> CompositionGraphError a b
ResultingCategoryError (Maybe (FiniteCategoryError (CGMorphism a b) a)
-> FiniteCategoryError (CGMorphism a b) a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (FiniteCategoryError (CGMorphism a b) a)
check)
        where
            newLaw :: CompositionLaw a b
newLaw = (((a, [Arrow a b], a) -> [Arrow a b]
forall a b c. (a, b, c) -> b
snd3((a, [Arrow a b], a) -> [Arrow a b])
-> (CGMorphism a b -> (a, [Arrow a b], a))
-> CGMorphism a b
-> [Arrow a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CGMorphism a b -> (a, [Arrow a b], a)
forall a b. CGMorphism a b -> Path a b
path) CGMorphism a b
srcM,((a, [Arrow a b], a) -> [Arrow a b]
forall a b c. (a, b, c) -> b
snd3((a, [Arrow a b], a) -> [Arrow a b])
-> (CGMorphism a b -> (a, [Arrow a b], a))
-> CGMorphism a b
-> [Arrow a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CGMorphism a b -> (a, [Arrow a b], a)
forall a b. CGMorphism a b -> Path a b
path) CGMorphism a b
tgtM)([Arrow a b], [Arrow a b])
-> CompositionLaw a b -> CompositionLaw a b
forall a. a -> [a] -> [a]
:CompositionLaw a b
l
            new :: CompositionGraph a b
new = CompositionGraph :: forall a b. Graph a b -> CompositionLaw a b -> CompositionGraph a b
CompositionGraph{graph :: ([a], [Arrow a b])
graph=([a]
nodes,[Arrow a b]
arrs), law :: CompositionLaw a b
law=CompositionLaw a b
newLaw}
            check :: Maybe (FiniteCategoryError (CGMorphism a b) a)
check = CompositionGraph a b
-> Maybe (FiniteCategoryError (CGMorphism a b) a)
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> Maybe (FiniteCategoryError m o)
checkGeneratedFiniteCategoryProperties CompositionGraph a b
new
            replaceLaw :: CGMorphism a b -> CGMorphism a b
replaceLaw CGMorphism a b
m = CGMorphism :: forall a b. Path a b -> CompositionLaw a b -> CGMorphism a b
CGMorphism{path :: (a, [Arrow a b], a)
path=(CGMorphism a b -> (a, [Arrow a b], a)
forall a b. CGMorphism a b -> Path a b
path CGMorphism a b
m)
                                     ,compositionLaw :: CompositionLaw a b
compositionLaw=CompositionLaw a b
newLaw}
            funct :: PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
funct = PartialFunctor :: forall c m o.
c
-> c
-> AssociationList o o
-> AssociationList m m
-> PartialFunctor c m o
PartialFunctor{srcPF :: CompositionGraph a b
srcPF=CompositionGraph a b
prev,tgtPF :: CompositionGraph a b
tgtPF=CompositionGraph a b
new,omapPF :: AssociationList a a
omapPF=(a -> a) -> [a] -> AssociationList a a
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList a -> a
forall a. a -> a
id [a]
nodes,mmapPF :: AssociationList (CGMorphism a b) (CGMorphism a b)
mmapPF=(CGMorphism a b -> CGMorphism a b)
-> [CGMorphism a b]
-> AssociationList (CGMorphism a b) (CGMorphism a b)
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList CGMorphism a b -> CGMorphism a b
replaceLaw (CGMorphism a b -> [CGMorphism a b] -> [CGMorphism a b]
forall a. Eq a => a -> [a] -> [a]
delete CGMorphism a b
srcM (CompositionGraph a b -> [CGMorphism a b]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows CompositionGraph a b
prev))}
    
    -- | Unidentify a morphism if it is possible, if not returns an error in a Left member.

    --

    -- Unidentifying a morphism means removing all entries in the composition law with results the morphism.    

    unidentifyMorphism :: (Eq a, Eq b) => CompositionGraph a b -> CGMorphism a b -> Either
                                                                                        (CompositionGraphError a b)
                                                                                        (CompositionGraph a b, (PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
    unidentifyMorphism :: forall a b.
(Eq a, Eq b) =>
CompositionGraph a b
-> CGMorphism a b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
unidentifyMorphism prev :: CompositionGraph a b
prev@CompositionGraph{graph :: forall a b. CompositionGraph a b -> Graph a b
graph=([a]
nodes,[Arrow a b]
arrs), law :: forall a b. CompositionGraph a b -> CompositionLaw a b
law=CompositionLaw a b
l} CGMorphism a b
m
        | CGMorphism a b -> [CGMorphism a b] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem CGMorphism a b
m (CompositionGraph a b -> a -> a -> [CGMorphism a b]
forall c m o.
(FiniteCategory c m o, Morphism m o) =>
c -> o -> o -> [m]
ar CompositionGraph a b
prev (CGMorphism a b -> a
forall m o. Morphism m o => m -> o
source CGMorphism a b
m) (CGMorphism a b -> a
forall m o. Morphism m o => m -> o
target CGMorphism a b
m)) = (CompositionGraph a b,
 PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b. b -> Either a b
Right (CompositionGraph a b
new,PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
funct)
        | Bool
otherwise = CompositionGraphError a b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b. a -> Either a b
Left UnidentifyNonExistantMorphism :: forall a b. CGMorphism a b -> CompositionGraphError a b
UnidentifyNonExistantMorphism{morph :: CGMorphism a b
morph=CGMorphism a b
m}
        where
            newLaw :: CompositionLaw a b
newLaw = (([Arrow a b], [Arrow a b]) -> Bool)
-> CompositionLaw a b -> CompositionLaw a b
forall a. (a -> Bool) -> [a] -> [a]
filter ((((a, [Arrow a b], a) -> [Arrow a b]
forall a b c. (a, b, c) -> b
snd3((a, [Arrow a b], a) -> [Arrow a b])
-> (CGMorphism a b -> (a, [Arrow a b], a))
-> CGMorphism a b
-> [Arrow a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CGMorphism a b -> (a, [Arrow a b], a)
forall a b. CGMorphism a b -> Path a b
path (CGMorphism a b -> [Arrow a b]) -> CGMorphism a b -> [Arrow a b]
forall a b. (a -> b) -> a -> b
$ CGMorphism a b
m)[Arrow a b] -> [Arrow a b] -> Bool
forall a. Eq a => a -> a -> Bool
/=)([Arrow a b] -> Bool)
-> (([Arrow a b], [Arrow a b]) -> [Arrow a b])
-> ([Arrow a b], [Arrow a b])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Arrow a b], [Arrow a b]) -> [Arrow a b]
forall a b. (a, b) -> b
snd) CompositionLaw a b
l
            replaceLawInMorph :: CGMorphism a b -> CGMorphism a b
replaceLawInMorph CGMorphism{path :: forall a b. CGMorphism a b -> Path a b
path=(a, [Arrow a b], a)
p,compositionLaw :: forall a b. CGMorphism a b -> CompositionLaw a b
compositionLaw=CompositionLaw a b
_} = CGMorphism :: forall a b. Path a b -> CompositionLaw a b -> CGMorphism a b
CGMorphism{path :: (a, [Arrow a b], a)
path=(a, [Arrow a b], a)
p,compositionLaw :: CompositionLaw a b
compositionLaw=CompositionLaw a b
newLaw}
            new :: CompositionGraph a b
new = CompositionGraph :: forall a b. Graph a b -> CompositionLaw a b -> CompositionGraph a b
CompositionGraph{graph :: ([a], [Arrow a b])
graph=([a]
nodes,[Arrow a b]
arrs), law :: CompositionLaw a b
law=CompositionLaw a b
newLaw}
            funct :: PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
funct = PartialFunctor :: forall c m o.
c
-> c
-> AssociationList o o
-> AssociationList m m
-> PartialFunctor c m o
PartialFunctor{srcPF :: CompositionGraph a b
srcPF=CompositionGraph a b
prev,tgtPF :: CompositionGraph a b
tgtPF=CompositionGraph a b
new,omapPF :: AssociationList a a
omapPF=(a -> a) -> [a] -> AssociationList a a
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList a -> a
forall a. a -> a
id [a]
nodes,mmapPF :: AssociationList (CGMorphism a b) (CGMorphism a b)
mmapPF=(CGMorphism a b -> CGMorphism a b)
-> [CGMorphism a b]
-> AssociationList (CGMorphism a b) (CGMorphism a b)
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList CGMorphism a b -> CGMorphism a b
replaceLawInMorph (CompositionGraph a b -> [CGMorphism a b]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows CompositionGraph a b
prev)}
            
    -- | Replaces an object with a new one, if the object to replace is not in the composition graph, returns Nothing.

    --

    -- It is different from deleting the object and inserting the new one because deleting an object deletes all leaving and coming arrows.

    replaceObject :: (Eq a, Eq b) => CompositionGraph a b -> a -> a -> Either
                                                                        (CompositionGraphError a b)
                                                                        (CompositionGraph a b, (PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
    replaceObject :: forall a b.
(Eq a, Eq b) =>
CompositionGraph a b
-> a
-> a
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
replaceObject prev :: CompositionGraph a b
prev@CompositionGraph{graph :: forall a b. CompositionGraph a b -> Graph a b
graph=([a]
nodes,[Arrow a b]
arrs), law :: forall a b. CompositionGraph a b -> CompositionLaw a b
law=CompositionLaw a b
l} a
prevObj a
newObj
        | a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
prevObj (CompositionGraph a b -> [a]
forall c m o. FiniteCategory c m o => c -> [o]
ob CompositionGraph a b
prev) = (CompositionGraph a b,
 PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b. b -> Either a b
Right (CompositionGraph a b
new,PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
funct)
        | Bool
otherwise = CompositionGraphError a b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b. a -> Either a b
Left ReplaceNonExistantObject :: forall a b. a -> CompositionGraphError a b
ReplaceNonExistantObject {faultyObj :: a
faultyObj=a
prevObj}
        where
            replace :: a -> a
replace a
x = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
prevObj then a
newObj else a
x
            replaceArr :: (a, a, c) -> (a, a, c)
replaceArr (a
s,a
t,c
a) = (a -> a
replace a
s, a -> a
replace a
t, c
a)
            replaceLawEntry :: (f (a, a, c), f (a, a, c)) -> (f (a, a, c), f (a, a, c))
replaceLawEntry (f (a, a, c)
k,f (a, a, c)
v) = ((a, a, c) -> (a, a, c)
forall {c}. (a, a, c) -> (a, a, c)
replaceArr ((a, a, c) -> (a, a, c)) -> f (a, a, c) -> f (a, a, c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a, a, c)
k, (a, a, c) -> (a, a, c)
forall {c}. (a, a, c) -> (a, a, c)
replaceArr ((a, a, c) -> (a, a, c)) -> f (a, a, c) -> f (a, a, c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a, a, c)
v)
            replaceCGMorph :: CGMorphism a c -> CGMorphism a c
replaceCGMorph CGMorphism{path :: forall a b. CGMorphism a b -> Path a b
path=(a
s,RawPath a c
rp,a
t),compositionLaw :: forall a b. CGMorphism a b -> CompositionLaw a b
compositionLaw=CompositionLaw a c
l} = CGMorphism :: forall a b. Path a b -> CompositionLaw a b -> CGMorphism a b
CGMorphism{path :: (a, RawPath a c, a)
path=(a -> a
replace a
s,(a, a, c) -> (a, a, c)
forall {c}. (a, a, c) -> (a, a, c)
replaceArr ((a, a, c) -> (a, a, c)) -> RawPath a c -> RawPath a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawPath a c
rp,a -> a
replace a
t),compositionLaw :: CompositionLaw a c
compositionLaw=(RawPath a c, RawPath a c) -> (RawPath a c, RawPath a c)
forall {f :: * -> *} {f :: * -> *} {c} {c}.
(Functor f, Functor f) =>
(f (a, a, c), f (a, a, c)) -> (f (a, a, c), f (a, a, c))
replaceLawEntry ((RawPath a c, RawPath a c) -> (RawPath a c, RawPath a c))
-> CompositionLaw a c -> CompositionLaw a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompositionLaw a c
l}
            new :: CompositionGraph a b
new = CompositionGraph :: forall a b. Graph a b -> CompositionLaw a b -> CompositionGraph a b
CompositionGraph{graph :: ([a], [Arrow a b])
graph=(a -> a
replace (a -> a) -> [a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
nodes,Arrow a b -> Arrow a b
forall {c}. (a, a, c) -> (a, a, c)
replaceArr (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]
arrs), law :: CompositionLaw a b
law=([Arrow a b], [Arrow a b]) -> ([Arrow a b], [Arrow a b])
forall {f :: * -> *} {f :: * -> *} {c} {c}.
(Functor f, Functor f) =>
(f (a, a, c), f (a, a, c)) -> (f (a, a, c), f (a, a, c))
replaceLawEntry (([Arrow a b], [Arrow a b]) -> ([Arrow a b], [Arrow a b]))
-> CompositionLaw a b -> CompositionLaw a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompositionLaw a b
l}
            funct :: PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
funct = PartialFunctor :: forall c m o.
c
-> c
-> AssociationList o o
-> AssociationList m m
-> PartialFunctor c m o
PartialFunctor{srcPF :: CompositionGraph a b
srcPF=CompositionGraph a b
prev,tgtPF :: CompositionGraph a b
tgtPF=CompositionGraph a b
new,omapPF :: AssociationList a a
omapPF=(a -> a) -> [a] -> AssociationList a a
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList a -> a
replace [a]
nodes,mmapPF :: AssociationList (CGMorphism a b) (CGMorphism a b)
mmapPF=(CGMorphism a b -> CGMorphism a b)
-> [CGMorphism a b]
-> AssociationList (CGMorphism a b) (CGMorphism a b)
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList CGMorphism a b -> CGMorphism a b
forall {c}. CGMorphism a c -> CGMorphism a c
replaceCGMorph (CompositionGraph a b -> [CGMorphism a b]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows CompositionGraph a b
prev)}
            
    -- | Replaces a generating morphism with a new one, if the morphism to replace is not a generator of the composition graph, returns Nothing.

    --

    -- It is different from deleting the morphism and inserting the new one because deleting an object deletes related composition law entries.

    replaceMorphism :: (Eq a, Eq b) => CompositionGraph a b -> CGMorphism a b -> b -> Either
                                                                                        (CompositionGraphError a b)
                                                                                        (CompositionGraph a b, (PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
    replaceMorphism :: forall a b.
(Eq a, Eq b) =>
CompositionGraph a b
-> CGMorphism a b
-> b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
replaceMorphism prev :: CompositionGraph a b
prev@CompositionGraph{graph :: forall a b. CompositionGraph a b -> Graph a b
graph=([a]
nodes,[Arrow a b]
arrs), law :: forall a b. CompositionGraph a b -> CompositionLaw a b
law=CompositionLaw a b
l} CGMorphism a b
prevMorph b
newMorph
        | CGMorphism a b -> [CGMorphism a b] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem CGMorphism a b
prevMorph (CompositionGraph a b -> a -> a -> [CGMorphism a b]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> o -> o -> [m]
genAr CompositionGraph a b
prev (CGMorphism a b -> a
forall m o. Morphism m o => m -> o
source CGMorphism a b
prevMorph) (CGMorphism a b -> a
forall m o. Morphism m o => m -> o
target CGMorphism a b
prevMorph)) = (CompositionGraph a b,
 PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b. b -> Either a b
Right (CompositionGraph a b
new,PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
funct)
        | Bool
otherwise = CompositionGraphError a b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b. a -> Either a b
Left ReplaceCompositeMorphism :: forall a b. CGMorphism a b -> CompositionGraphError a b
ReplaceCompositeMorphism{composite :: CGMorphism a b
composite=CGMorphism a b
prevMorph}
        where
            replaceArr :: Arrow a b -> Arrow a b
replaceArr m :: Arrow a b
m@(a
s,a
t,b
a) = if [Arrow a b
m] [Arrow a b] -> [Arrow a b] -> Bool
forall a. Eq a => a -> a -> Bool
== ((a, [Arrow a b], a) -> [Arrow a b]
forall a b c. (a, b, c) -> b
snd3((a, [Arrow a b], a) -> [Arrow a b])
-> (CGMorphism a b -> (a, [Arrow a b], a))
-> CGMorphism a b
-> [Arrow a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CGMorphism a b -> (a, [Arrow a b], a)
forall a b. CGMorphism a b -> Path a b
path (CGMorphism a b -> [Arrow a b]) -> CGMorphism a b -> [Arrow a b]
forall a b. (a -> b) -> a -> b
$ CGMorphism a b
prevMorph) then (a
s, a
t, b
newMorph) else Arrow a b
m
            replaceLawEntry :: (f (Arrow a b), f (Arrow a b)) -> (f (Arrow a b), f (Arrow a b))
replaceLawEntry (f (Arrow a b)
k,f (Arrow a b)
v) = (Arrow a b -> Arrow a b
replaceArr (Arrow a b -> Arrow a b) -> f (Arrow a b) -> f (Arrow a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Arrow a b)
k, Arrow a b -> Arrow a b
replaceArr (Arrow a b -> Arrow a b) -> f (Arrow a b) -> f (Arrow a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Arrow a b)
v)
            replaceCGMorph :: CGMorphism a b -> CGMorphism a b
replaceCGMorph CGMorphism{path :: forall a b. CGMorphism a b -> Path a b
path=(a
s,[Arrow a b]
rp,a
t),compositionLaw :: forall a b. CGMorphism a b -> CompositionLaw a b
compositionLaw=CompositionLaw a b
l} = CGMorphism :: forall a b. Path a b -> CompositionLaw a b -> CGMorphism a b
CGMorphism{path :: (a, [Arrow a b], a)
path=(a
s,Arrow a b -> Arrow a b
replaceArr (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]
rp,a
t),compositionLaw :: CompositionLaw a b
compositionLaw=([Arrow a b], [Arrow a b]) -> ([Arrow a b], [Arrow a b])
forall {f :: * -> *} {f :: * -> *}.
(Functor f, Functor f) =>
(f (Arrow a b), f (Arrow a b)) -> (f (Arrow a b), f (Arrow a b))
replaceLawEntry (([Arrow a b], [Arrow a b]) -> ([Arrow a b], [Arrow a b]))
-> CompositionLaw a b -> CompositionLaw a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompositionLaw a b
l}
            new :: CompositionGraph a b
new = CompositionGraph :: forall a b. Graph a b -> CompositionLaw a b -> CompositionGraph a b
CompositionGraph{graph :: ([a], [Arrow a b])
graph=([a]
nodes,Arrow a b -> Arrow a b
replaceArr (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]
arrs), law :: CompositionLaw a b
law=([Arrow a b], [Arrow a b]) -> ([Arrow a b], [Arrow a b])
forall {f :: * -> *} {f :: * -> *}.
(Functor f, Functor f) =>
(f (Arrow a b), f (Arrow a b)) -> (f (Arrow a b), f (Arrow a b))
replaceLawEntry (([Arrow a b], [Arrow a b]) -> ([Arrow a b], [Arrow a b]))
-> CompositionLaw a b -> CompositionLaw a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompositionLaw a b
l}
            funct :: PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
funct = PartialFunctor :: forall c m o.
c
-> c
-> AssociationList o o
-> AssociationList m m
-> PartialFunctor c m o
PartialFunctor{srcPF :: CompositionGraph a b
srcPF=CompositionGraph a b
prev,tgtPF :: CompositionGraph a b
tgtPF=CompositionGraph a b
new,omapPF :: AssociationList a a
omapPF=(a -> a) -> [a] -> AssociationList a a
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList a -> a
forall a. a -> a
id [a]
nodes,mmapPF :: AssociationList (CGMorphism a b) (CGMorphism a b)
mmapPF=(CGMorphism a b -> CGMorphism a b)
-> [CGMorphism a b]
-> AssociationList (CGMorphism a b) (CGMorphism a b)
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList CGMorphism a b -> CGMorphism a b
replaceCGMorph (CompositionGraph a b -> [CGMorphism a b]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows CompositionGraph a b
prev)}
            
    -- | Deletes a generating morphism if it can, the generator should not be an identity.

    deleteMorphism :: (Eq a, Eq b) => CompositionGraph a b -> CGMorphism a b ->  Either
                                                                                    (CompositionGraphError a b)
                                                                                    (CompositionGraph a b, (PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
    deleteMorphism :: forall a b.
(Eq a, Eq b) =>
CompositionGraph a b
-> CGMorphism a b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
deleteMorphism prev :: CompositionGraph a b
prev@CompositionGraph{graph :: forall a b. CompositionGraph a b -> Graph a b
graph=([a]
nodes,[Arrow a b]
arrs), law :: forall a b. CompositionGraph a b -> CompositionLaw a b
law=CompositionLaw a b
l} CGMorphism a b
morph
        | CompositionGraph a b -> CGMorphism a b -> Bool
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isIdentity CompositionGraph a b
prev CGMorphism a b
morph = CompositionGraphError a b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b. a -> Either a b
Left DeleteIdentity :: forall a b. CGMorphism a b -> CompositionGraphError a b
DeleteIdentity {faultyIdentity :: CGMorphism a b
faultyIdentity=CGMorphism a b
morph}
        | CGMorphism a b -> [CGMorphism a b] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem CGMorphism a b
morph (CompositionGraph a b -> a -> a -> [CGMorphism a b]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> o -> o -> [m]
genAr CompositionGraph a b
prev (CGMorphism a b -> a
forall m o. Morphism m o => m -> o
source CGMorphism a b
morph) (CGMorphism a b -> a
forall m o. Morphism m o => m -> o
target CGMorphism a b
morph)) = (CompositionGraph a b,
 PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b. b -> Either a b
Right (CompositionGraph a b
new,PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
funct)
        | CGMorphism a b -> [CGMorphism a b] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem CGMorphism a b
morph (CompositionGraph a b -> a -> a -> [CGMorphism a b]
forall c m o.
(FiniteCategory c m o, Morphism m o) =>
c -> o -> o -> [m]
ar CompositionGraph a b
prev (CGMorphism a b -> a
forall m o. Morphism m o => m -> o
source CGMorphism a b
morph) (CGMorphism a b -> a
forall m o. Morphism m o => m -> o
target CGMorphism a b
morph)) = CompositionGraphError a b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b. a -> Either a b
Left DeleteCompositeMorph :: forall a b. CGMorphism a b -> CompositionGraphError a b
DeleteCompositeMorph{composite :: CGMorphism a b
composite=CGMorphism a b
morph}
        | Bool
otherwise = CompositionGraphError a b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b. a -> Either a b
Left DeleteNonExistantObjectMorph :: forall a b. CGMorphism a b -> CompositionGraphError a b
DeleteNonExistantObjectMorph{neMorph :: CGMorphism a b
neMorph=CGMorphism a b
morph}
        where
            arr :: Arrow a b
arr = [Arrow a b] -> Arrow a b
forall a. [a] -> a
head([Arrow a b] -> Arrow a b)
-> (CGMorphism a b -> [Arrow a b]) -> CGMorphism a b -> Arrow a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a, [Arrow a b], a) -> [Arrow a b]
forall a b c. (a, b, c) -> b
snd3((a, [Arrow a b], a) -> [Arrow a b])
-> (CGMorphism a b -> (a, [Arrow a b], a))
-> CGMorphism a b
-> [Arrow a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CGMorphism a b -> (a, [Arrow a b], a)
forall a b. CGMorphism a b -> Path a b
path (CGMorphism a b -> Arrow a b) -> CGMorphism a b -> Arrow a b
forall a b. (a -> b) -> a -> b
$ CGMorphism a b
morph
            newLaw :: CompositionLaw a b
newLaw = (([Arrow a b], [Arrow a b]) -> Bool)
-> CompositionLaw a b -> CompositionLaw a b
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Arrow a b]
k,[Arrow a b]
v) -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Arrow a b -> Arrow a b -> Bool
forall a. Eq a => a -> a -> Bool
/=Arrow a b
arr) (Arrow a b -> Bool) -> [Arrow a b] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Arrow a b]
k) Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Arrow a b -> Arrow a b -> Bool
forall a. Eq a => a -> a -> Bool
/=Arrow a b
arr) (Arrow a b -> Bool) -> [Arrow a b] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Arrow a b]
v)) CompositionLaw a b
l
            newArrows :: [CGMorphism a b]
newArrows = (CGMorphism a b -> Bool) -> [CGMorphism a b] -> [CGMorphism a b]
forall a. (a -> Bool) -> [a] -> [a]
filter (\CGMorphism{path :: forall a b. CGMorphism a b -> Path a b
path=(a
s,[Arrow a b]
rp,a
t),compositionLaw :: forall a b. CGMorphism a b -> CompositionLaw a b
compositionLaw=CompositionLaw a b
_} -> Bool -> Bool
not (Arrow a b -> [Arrow a b] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Arrow a b
arr [Arrow a b]
rp)) (CompositionGraph a b -> [CGMorphism a b]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows CompositionGraph a b
prev)
            replaceLaw :: CGMorphism a b -> CGMorphism a b
replaceLaw CGMorphism a b
m = CGMorphism :: forall a b. Path a b -> CompositionLaw a b -> CGMorphism a b
CGMorphism{path :: (a, [Arrow a b], a)
path=(CGMorphism a b -> (a, [Arrow a b], a)
forall a b. CGMorphism a b -> Path a b
path CGMorphism a b
m)
                                     ,compositionLaw :: CompositionLaw a b
compositionLaw=CompositionLaw a b
newLaw}
            new :: CompositionGraph a b
new = CompositionGraph :: forall a b. Graph a b -> CompositionLaw a b -> CompositionGraph a b
CompositionGraph{graph :: ([a], [Arrow a b])
graph=([a]
nodes,Arrow a b -> [Arrow a b] -> [Arrow a b]
forall a. Eq a => a -> [a] -> [a]
delete Arrow a b
arr [Arrow a b]
arrs), law :: CompositionLaw a b
law=CompositionLaw a b
newLaw}
            funct :: PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
funct = PartialFunctor :: forall c m o.
c
-> c
-> AssociationList o o
-> AssociationList m m
-> PartialFunctor c m o
PartialFunctor{srcPF :: CompositionGraph a b
srcPF=CompositionGraph a b
prev,tgtPF :: CompositionGraph a b
tgtPF=CompositionGraph a b
new,omapPF :: AssociationList a a
omapPF=(a -> a) -> [a] -> AssociationList a a
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList a -> a
forall a. a -> a
id [a]
nodes,mmapPF :: AssociationList (CGMorphism a b) (CGMorphism a b)
mmapPF=(CGMorphism a b -> CGMorphism a b)
-> [CGMorphism a b]
-> AssociationList (CGMorphism a b) (CGMorphism a b)
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList CGMorphism a b -> CGMorphism a b
replaceLaw [CGMorphism a b]
newArrows}
            
    -- | Deletes an object and all morphism coming from it or leaving it.

    deleteObject :: (Eq a, Eq b) => CompositionGraph a b -> a ->  Either
                                                                    (CompositionGraphError a b)
                                                                    (CompositionGraph a b, (PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
    deleteObject :: forall a b.
(Eq a, Eq b) =>
CompositionGraph a b
-> a
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
deleteObject prev :: CompositionGraph a b
prev@CompositionGraph{graph :: forall a b. CompositionGraph a b -> Graph a b
graph=([a]
nodes,[Arrow a b]
arrs), law :: forall a b. CompositionGraph a b -> CompositionLaw a b
law=CompositionLaw a b
l} a
obj
        | a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
obj (CompositionGraph a b -> [a]
forall c m o. FiniteCategory c m o => c -> [o]
ob CompositionGraph a b
prev) = (\(CompositionGraph a b
cg,PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
f) -> (\(CompositionGraph a b
fcg,PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
ffunct) -> (CompositionGraph a b
fcg,PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
ffunct PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
-> PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
-> PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
forall m o. Morphism m o => m -> m -> m
@ PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
f)) (CompositionGraph a b
-> (CompositionGraph a b,
    PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall {b}.
Eq b =>
CompositionGraph a b
-> (CompositionGraph a b,
    PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
delObj CompositionGraph a b
cg)) ((CompositionGraph a b,
  PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
 -> (CompositionGraph a b,
     PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either
  (CompositionGraphError a b)
  (CompositionGraph a b,
   PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
cgWithoutMorphs
        | Bool
otherwise = CompositionGraphError a b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b. a -> Either a b
Left DeleteNonExistantObject :: forall a b. a -> CompositionGraphError a b
DeleteNonExistantObject {faultyObj :: a
faultyObj=a
obj}
        where
            idFunct :: PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
idFunct = PartialFunctor :: forall c m o.
c
-> c
-> AssociationList o o
-> AssociationList m m
-> PartialFunctor c m o
PartialFunctor{srcPF :: CompositionGraph a b
srcPF=CompositionGraph a b
prev,tgtPF :: CompositionGraph a b
tgtPF=CompositionGraph a b
prev,omapPF :: AssociationList a a
omapPF=(a -> a) -> [a] -> AssociationList a a
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList a -> a
forall a. a -> a
id [a]
nodes,mmapPF :: AssociationList (CGMorphism a b) (CGMorphism a b)
mmapPF=(CGMorphism a b -> CGMorphism a b)
-> [CGMorphism a b]
-> AssociationList (CGMorphism a b) (CGMorphism a b)
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList CGMorphism a b -> CGMorphism a b
forall a. a -> a
id (CompositionGraph a b -> [CGMorphism a b]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows CompositionGraph a b
prev)}
            cgWithoutMorphs :: Either
  (CompositionGraphError a b)
  (CompositionGraph a b,
   PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
cgWithoutMorphs = ((CompositionGraph a b,
  PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
 -> CGMorphism a b
 -> Either
      (CompositionGraphError a b)
      (CompositionGraph a b,
       PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
-> (CompositionGraph a b,
    PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
-> [CGMorphism a b]
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\(CompositionGraph a b
cg,PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
f) CGMorphism a b
d -> ((\(CompositionGraph a b
ncg,PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
nf) -> (CompositionGraph a b
ncg,PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
nf PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
-> PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
-> PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
forall m o. Morphism m o => m -> m -> m
@ PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
f)) ((CompositionGraph a b,
  PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
 -> (CompositionGraph a b,
     PartialFunctor (CompositionGraph a b) (CGMorphism a b) a))
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CompositionGraph a b
-> CGMorphism a b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
forall a b.
(Eq a, Eq b) =>
CompositionGraph a b
-> CGMorphism a b
-> Either
     (CompositionGraphError a b)
     (CompositionGraph a b,
      PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
deleteMorphism CompositionGraph a b
cg CGMorphism a b
d))) (CompositionGraph a b
prev,PartialFunctor (CompositionGraph a b) (CGMorphism a b) a
idFunct) ((CGMorphism a b -> Bool) -> [CGMorphism a b] -> [CGMorphism a b]
forall a. (a -> Bool) -> [a] -> [a]
filter (CompositionGraph a b -> CGMorphism a b -> Bool
forall c m o.
(FiniteCategory c m o, Morphism m o, Eq m, Eq o) =>
c -> m -> Bool
isNotIdentity CompositionGraph a b
prev) ([CGMorphism a b] -> [CGMorphism a b]
forall a. Eq a => [a] -> [a]
nub ((CompositionGraph a b -> a -> [CGMorphism a b]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> o -> [m]
genArFrom CompositionGraph a b
prev a
obj)[CGMorphism a b] -> [CGMorphism a b] -> [CGMorphism a b]
forall a. [a] -> [a] -> [a]
++(CompositionGraph a b -> a -> [CGMorphism a b]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o) =>
c -> o -> [m]
genArTo CompositionGraph a b
prev a
obj))))
            delObj :: CompositionGraph a b
-> (CompositionGraph a b,
    PartialFunctor (CompositionGraph a b) (CGMorphism a b) a)
delObj prev2 :: CompositionGraph a b
prev2@CompositionGraph{graph :: forall a b. CompositionGraph a b -> Graph a b
graph=([a]
nodes2,[Arrow a b]
arrs2), law :: forall a b. CompositionGraph a b -> CompositionLaw a b
law=CompositionLaw a b
l2} = (CompositionGraph a b
finalCG,
                                                                           PartialFunctor :: forall c m o.
c
-> c
-> AssociationList o o
-> AssociationList m m
-> PartialFunctor c m o
PartialFunctor{srcPF :: CompositionGraph a b
srcPF=CompositionGraph a b
prev2,tgtPF :: CompositionGraph a b
tgtPF=CompositionGraph a b
finalCG,omapPF :: AssociationList a a
omapPF=(a -> a) -> [a] -> AssociationList a a
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList a -> a
forall a. a -> a
id (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
delete a
obj [a]
nodes2),mmapPF :: AssociationList (CGMorphism a b) (CGMorphism a b)
mmapPF=(CGMorphism a b -> CGMorphism a b)
-> [CGMorphism a b]
-> AssociationList (CGMorphism a b) (CGMorphism a b)
forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList CGMorphism a b -> CGMorphism a b
forall a. a -> a
id ((CompositionGraph a b -> [CGMorphism a b]
forall c m o.
(FiniteCategory c m o, FiniteCategory c m o, Morphism m o) =>
c -> [m]
arrows CompositionGraph a b
prev2)[CGMorphism a b] -> [CGMorphism a b] -> [CGMorphism a b]
forall a. Eq a => [a] -> [a] -> [a]
\\[(CompositionGraph a b -> a -> CGMorphism a b
forall c m o. (FiniteCategory c m o, Morphism m o) => c -> o -> m
identity CompositionGraph a b
prev2 a
obj)])})
                where
                    finalCG :: CompositionGraph a b
finalCG = CompositionGraph :: forall a b. Graph a b -> CompositionLaw a b -> CompositionGraph a b
CompositionGraph{graph :: ([a], [Arrow a b])
graph=(a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
delete a
obj [a]
nodes2,[Arrow a b]
arrs2), law :: CompositionLaw a b
law=CompositionLaw a b
l2}