FiniteCategories-0.1.0.0: src/CompositionGraph/SafeCompositionGraph.hs
{-# 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 `SafeCompositionGraph` is the quasi-free category generated by a multidigraph quotiented by an equivalence relation on the paths of the graphs. There is a limit on the number of cycles you can have in a morphism. It prevents any infinite loop from occuring.
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 `mkSafeCompositionGraph` checks the structure of the category and is the preferred way of instantiatiating the `SafeCompositionGraph` type.
If the check takes too long because the category is big, you can use the `SafeCompositionGraph` constructor 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.ExampleSafeCompositionGraph provides an example of composition graph construction.
-}
module CompositionGraph.SafeCompositionGraph
(
-- * Types for a morphism of composition graph
SCGMorphism(..),
-- * Types for a composition graph
SafeCompositionGraph(..),
-- * Construction
mkSafeCompositionGraph,
mkEmptySafeCompositionGraph,
finiteCategoryToSafeCompositionGraph,
generatedFiniteCategoryToSafeCompositionGraph,
-- * Insertion
insertObjectS,
insertMorphismS,
-- * Modification
identifyMorphismsS,
unidentifyMorphismS,
replaceObjectS,
replaceMorphismS,
-- * Deletion
deleteObjectS,
deleteMorphismS,
-- * Utility functions
isGenS,
isCompS,
getLabelS
)
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)
import CompositionGraph.CompositionGraph
-- | The type `SCGMorphism` is the type of safe 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.
-- We also store the maximum number of cycles.
data SCGMorphism a b = SCGMorphism {pathS :: Path a b
,compositionLawS :: CompositionLaw a b
,maxNbCycles :: Int} deriving (Show, Eq)
instance (PrettyPrintable a, PrettyPrintable b, Eq a, Eq b) => PrettyPrintable (SCGMorphism a b) where
pprint SCGMorphism {pathS=(s,[],t),compositionLawS=_,maxNbCycles=_} = if s == t then "Id"++(pprint s) else error "Identity with source different of target."
pprint SCGMorphism {pathS=(_,rp,_),compositionLawS=_,maxNbCycles=_} = intercalate " o " $ (\(_,_,l) -> pprint l) <$> rp
rawpathToListOfVertices :: RawPath a b -> [a]
rawpathToListOfVertices [] = []
rawpathToListOfVertices rp = ((snd3 (head rp)):(fst3 <$> rp))
-- | Helper function for `simplify`. Returns a simplified raw path.
simplifyOnce :: (Eq a, Eq b) => CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplifyOnce _ _ [] = []
simplifyOnce _ _ [e] = [e]
simplifyOnce cl nb list
| new_list == [] = []
| isCycle && tooManyCycles = []
| new_list /= list = new_list
| simple_tail /= (tail list) = (head list):simple_tail
| simple_init /= (init list) = simple_init++[(last list)]
| otherwise = list
where
listOfVertices = rawpathToListOfVertices list
isCycle = (head listOfVertices) == (last listOfVertices)
tooManyCycles = (length $ filter ((head listOfVertices) ==) listOfVertices) == (nb+2)
new_list = (!-?) list list cl
simple_tail = simplifyOnce cl nb (tail list)
simple_init = simplifyOnce cl nb (init list)
-- | Returns a completely simplified raw path.
simplify :: (Eq a, Eq b) => CompositionLaw a b -> Int -> RawPath a b -> RawPath a b
simplify _ _ [] = []
simplify cl nb rp
| simple_one == rp = rp
| otherwise = simplify cl nb simple_one
where simple_one = simplifyOnce cl nb rp
instance (Eq a, Eq b) => Morphism (SCGMorphism a b) a where
(@) SCGMorphism{pathS=(s2,rp2,t2), compositionLawS=cl2, maxNbCycles=nb1} SCGMorphism{pathS=(s1,rp1,t1), compositionLawS=cl1, maxNbCycles=nb2}
| t1 /= s2 = error "Composition of morphisms g@f where target of f is different of source of g"
| cl1 /= cl2 = error "Composition of morphisms with different composition laws"
| nb1 /= nb2 = error "Composition of morphisms with different maximum number of cycles."
| otherwise = SCGMorphism{pathS=(s1,(simplify cl1 nb1 (rp2++rp1)),t2), compositionLawS=cl1, maxNbCycles=nb1}
source SCGMorphism{pathS=(s,_,_), compositionLawS=_, maxNbCycles=_} = s
target SCGMorphism{pathS=(_,_,t), compositionLawS=_, maxNbCycles=_} = t
-- | Constructs a `SCGMorphism` from a composition law and an arrow.
mkSCGMorphism :: CompositionLaw a b -> Int -> Arrow a b -> SCGMorphism a b
mkSCGMorphism cl nb e@(s,t,l) = SCGMorphism {pathS=(s,[e],t),compositionLawS=cl, maxNbCycles=nb}
-- | Returns the list of arrows of a graph with a given source.
findOutwardEdges :: (Eq a) => Graph a b -> a -> [Arrow a b]
findOutwardEdges (nodes,edges) o = filter (\e@(s,t,_) -> s == o && elem t nodes) edges
-- | Returns the list of arrows of a graph with a given target.
findInwardEdges :: (Eq a) => Graph a b -> a -> [Arrow a b]
findInwardEdges (nodes,edges) o = filter (\e@(s,t,_) -> t == o && elem s nodes) edges
-- | Constructs the identity associated to a node of a composition graph.
mkIdentity :: (Eq a) => Graph a b -> CompositionLaw a b -> Int -> a -> SCGMorphism a b
mkIdentity g@(n,_) cl nb x
| elem x n = SCGMorphism {pathS=(x,[],x),compositionLawS=cl, maxNbCycles=nb}
| otherwise = error ("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 g s t = findAcyclicRawPathsVisitedNodes g s t [] where
findAcyclicRawPathsVisitedNodes g@(n,e) s t v
| elem t v = []
| s == t = [[]]
| otherwise = (concat (zipWith ($) (fmap fmap (fmap (:) inwardEdges)) (fmap (\x@(s1,t1,l1) -> (findAcyclicRawPathsVisitedNodes g s s1 (t:v))) inwardEdges))) where
inwardEdges = (findInwardEdges g 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 -> Int -> a -> [RawPath a b]
findElementaryCycles g cl nb o = nub (simplify cl nb <$> []:(concat (zipWith sequence (fmap (fmap (\x y -> (y:x))) (fmap (\(s,_,_) -> (findAcyclicRawPaths g o s)) inEdges)) inEdges))) where inEdges = (findInwardEdges g 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 -> Int -> a -> [RawPath a b]
findCycles g cl nb o = findCyclesWithPreviousCycles g cl o (findElementaryCycles g cl nb o) where
findCyclesWithPreviousCycles g cl o p = if newCycles \\ p == [] then newCycles else (findCyclesWithPreviousCycles g cl o newCycles) where
newCycles = nub ((simplify cl nb) <$> ((++) <$> p <*> findElementaryCycles g cl nb 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 [] l = l
intertwine l [] = l
intertwine l1@(x1:xs1) l2@(x2:xs2) = (x1:(x2:(intertwine xs1 xs2)))
-- | Takes a path and intertwine every cycles possible along its path.
intertwineWithCycles :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> Int -> a -> RawPath a b -> [RawPath a b]
intertwineWithCycles g cl nb _ p@(x@(_,t,_):xs) = (concat <$> sequence (fmap intertwine prodCycles) (fmap (:[]) p)) where
prodCycles = cartesianProduct cycles
cycles = (findCycles g cl nb t):((\(s,_,_) -> (findCycles g cl nb s)) <$> p)
intertwineWithCycles g cl nb s [] = (findCycles g cl nb 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 -> Int -> a -> a -> [SCGMorphism a b]
mkAr g cl nb s t = (\p -> SCGMorphism{pathS=(s,p,t),compositionLawS=cl,maxNbCycles=nb}) <$> nub (simplify cl nb <$> concat((intertwineWithCycles g cl nb s) <$> acyclicPaths)) where
acyclicPaths = nub $ (simplify cl nb) <$> (findAcyclicRawPaths g s t)
-- | A composition graph is a graph with a composition law. Use `mkSafeCompositionGraph` to instantiate it unless it takes too long.
data SafeCompositionGraph a b = SafeCompositionGraph {graphS :: Graph a b, lawS :: CompositionLaw a b, maxCycles :: Int} deriving (Eq, Show)
instance (Eq a, Eq b) => FiniteCategory (SafeCompositionGraph a b) (SCGMorphism a b) a where
ob = fst.graphS
identity c = mkIdentity (graphS c) (lawS c) (maxCycles c)
ar c = mkAr (graphS c) (lawS c) (maxCycles c)
instance (Eq a, Eq b) => GeneratedFiniteCategory (SafeCompositionGraph a b) (SCGMorphism a b) a where
genAr c@SafeCompositionGraph{graphS=g,lawS=l,maxCycles=nb} s t
| s == t = gen ++ [identity c s]
| otherwise = gen
where gen = mkSCGMorphism l nb <$> (filter (\a@(s1,t1,_) -> s == s1 && t == t1) $ snd g)
decompose c m@SCGMorphism{pathS=(_,rp,_),compositionLawS=l,maxNbCycles=nb}
| isIdentity c m = [m]
| otherwise = mkSCGMorphism l nb <$> rp
instance (PrettyPrintable a, PrettyPrintable b, Eq a, Eq b) => PrettyPrintable (SafeCompositionGraph a b) where
pprint cg@SafeCompositionGraph{graphS=(nodes,arrs),lawS=_,maxCycles=_} = "SafeCompositionGraph("++intercalate "," (pprint <$> nodes)++"\n"++intercalate "," ((\(a,b,c) -> pprint c ++ ":" ++ pprint a ++ "->" ++ pprint b) <$> arrs)
-- | Optimized version of isGenerator for `SafeCompositionGraph`.
isGenS :: (Eq a) => SCGMorphism a b -> Bool
isGenS m@SCGMorphism{pathS=p@(s,rp,t),compositionLawS=_,maxNbCycles=_} = (length rp ) < 2
-- | Optimized version of isComposite for `SafeCompositionGraph`.
isCompS :: (Eq a) => SCGMorphism a b -> Bool
isCompS = not.isGenS
-- | Returns the label of a generator arrow which is not an identity.
getLabelS :: (Eq a) => SCGMorphism a b -> Maybe b
getLabelS SCGMorphism{pathS=(_,[(_,_,label)],_),compositionLawS=_,maxNbCycles=_} = Just label
getLabelS _ = Nothing
-- | Constructs a `SafeCompositionGraph` from a `Graph` and a `CompositionLaw`.
--
-- This is the preferred way of instantiating a `SafeCompositionGraph` with `mkEmptySafeCompositionGraph`. 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 `SafeCompositionGraph` constructor at your own risk (it is your responsability to check the
-- the category structure is valid).
mkSafeCompositionGraph :: (Eq a, Eq b, Show a) => Graph a b -> CompositionLaw a b -> Int -> Either (FiniteCategoryError (SCGMorphism a b) a) (SafeCompositionGraph a b)
mkSafeCompositionGraph g l nb
| isNothing check = Right c_g
| otherwise = Left (fromJust check)
where
c_g = SafeCompositionGraph {graphS=g, lawS=l, maxCycles=nb}
check = checkGeneratedFiniteCategoryProperties c_g
-- | Constructs an empty `SafeCompositionGraph` with a maximum number of cycles.
--
-- Use `insertObject`, `insertMorphism` and `identifyMorphisms` to build a `SafeCompositionGraph` from it.
mkEmptySafeCompositionGraph :: Int -> SafeCompositionGraph a b
mkEmptySafeCompositionGraph maxNbOfCycles = SafeCompositionGraph {graphS=([],[]), lawS=[], maxCycles=maxNbOfCycles}
-- | Transforms any `FiniteCategory` into a safe 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 `SafeCompositionGraph` and an isofunctor as a `Diagram`.
finiteCategoryToSafeCompositionGraph :: (FiniteCategory c m o, Morphism m o, Eq m, Eq o) => c -> (SafeCompositionGraph o m, Diagram c m o (SafeCompositionGraph o m) (SCGMorphism o m) o)
finiteCategoryToSafeCompositionGraph cat = (cg,isofunct)
where
maxnbcycles = maximum $ length <$> ((\x -> ar cat x x) <$> ob cat)
morphToArrow f = ((source f),(target f),f)
catLaw = [
if isNotIdentity cat (g @ f) then
([morphToArrow g,morphToArrow f],[morphToArrow (g @ f)])
else
([morphToArrow g,morphToArrow f],[]) |
f <- (arrows cat), g <- (arFrom cat (target f)), isNotIdentity cat f, isNotIdentity cat g]
cg = (SafeCompositionGraph{graphS=(ob cat, [morphToArrow f | f <- (arrows cat), isNotIdentity cat f])
, lawS= catLaw, maxCycles=maxnbcycles})
isofunct = Diagram{src=cat,tgt=cg,omap=functToAssocList id (ob cat),mmap=functToAssocList (\f -> if isNotIdentity cat f
then
mkSCGMorphism catLaw maxnbcycles (morphToArrow f)
else
identity cg (source f)) (arrows cat)}
-- | Transforms any `GeneratedFiniteCategory` into a safe 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 `SafeCompositionGraph` and an isofunctor as a `Diagram`.
generatedFiniteCategoryToSafeCompositionGraph :: (GeneratedFiniteCategory c m o, Morphism m o, Eq m, Eq o) => c -> (SafeCompositionGraph o m, Diagram c m o (SafeCompositionGraph o m) (SCGMorphism o m) o)
generatedFiniteCategoryToSafeCompositionGraph cat = (cg,isofunct)
where
maxnbcycles = maximum $ length <$> ((\x -> ar cat x x) <$> ob cat)
morphToArrow f = ((source f),(target f),f)
catLaw = [
if isNotIdentity cat (g @ f) then
((morphToArrow <$> (decompose cat g))++(morphToArrow <$> (decompose cat f)), morphToArrow <$> (decompose cat (g @ f)))
else
((morphToArrow <$> (decompose cat g))++(morphToArrow <$> (decompose cat f)),[]) |
f <- (arrows cat), g <- (arFrom cat (target f)), isNotIdentity cat f, isNotIdentity cat g]
cg = (SafeCompositionGraph{graphS=(ob cat, [morphToArrow f | f <- (genArrows cat), isNotIdentity cat f])
, lawS= catLaw, maxCycles=maxnbcycles})
isofunct = Diagram{src=cat,tgt=cg,omap=functToAssocList id (ob cat),mmap=functToAssocList (\f -> if isNotIdentity cat f
then
SCGMorphism {pathS=(source f,(morphToArrow <$> (decompose cat f)),target f),compositionLawS=catLaw, maxNbCycles=maxnbcycles}
else
identity cg (source f)) (arrows cat)}
-- | Datatype representing how a safe composition graph might be malformed.
data SafeCompositionGraphError a b = InsertMorphismNonExistantSourceS {faultyMorphS :: b, faultySrcS :: a}
| InsertMorphismNonExistantTargetS {faultyMorphS :: b, faultyTgtS :: a}
| IdentifyGeneratorS {genS :: SCGMorphism a b}
| UnidentifyNonExistantMorphismS {morphS :: SCGMorphism a b}
| ResultingCategoryErrorS (FiniteCategoryError (SCGMorphism a b) a)
| ReplaceNonExistantObjectS {faultyObjS :: a}
| ReplaceCompositeMorphismS {compositeS :: SCGMorphism a b}
| DeleteIdentityS {faultyIdentityS :: SCGMorphism a b}
| DeleteCompositeMorphS {compositeS :: SCGMorphism a b}
| DeleteNonExistantObjectMorphS {neMorphS :: SCGMorphism a b}
| DeleteNonExistantObjectS {faultyObjS :: a}
-- | Inserts an object in a `SafeCompositionGraph`, returns the new `SafeCompositionGraph` and a `PartialFunctor` which is the insertion functor.
insertObjectS :: (Eq a, Eq b) => SafeCompositionGraph a b -> a -> (SafeCompositionGraph a b, (PartialFunctor (SafeCompositionGraph a b) (SCGMorphism a b) a))
insertObjectS prev@SafeCompositionGraph{graphS=(nodes,arrs), lawS=l, maxCycles=nb} obj = (new, funct)
where
new = SafeCompositionGraph{graphS=(obj:nodes,arrs), lawS=l, maxCycles=nb}
funct = PartialFunctor{srcPF=prev,tgtPF=new,omapPF=functToAssocList id nodes,mmapPF=functToAssocList id (arrows prev)}
-- | Inserts a morphism in a `SafeCompositionGraph`, returns the new `SafeCompositionGraph` 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 `SafeCompositionGraph` (the new morphism might close a loop creating infinitely many morphisms).
-- You can use the function `identifyMorphisms` to transform it back into a valid `SafeCompositionGraph`.
insertMorphismS :: (Eq a, Eq b) => SafeCompositionGraph a b -> a -> a -> b -> Either
(SafeCompositionGraphError a b)
(SafeCompositionGraph a b, (PartialFunctor (SafeCompositionGraph a b) (SCGMorphism a b) a))
insertMorphismS prev@SafeCompositionGraph{graphS=(nodes,arrs), lawS=l, maxCycles=nb} src tgt morph
| elem src nodes && elem tgt nodes = Right (new, funct)
| not $ elem src nodes = Left InsertMorphismNonExistantSourceS{faultyMorphS=morph, faultySrcS=src}
| not $ elem tgt nodes = Left InsertMorphismNonExistantTargetS{faultyMorphS=morph, faultyTgtS=tgt}
where
new = SafeCompositionGraph{graphS=(nodes,(src, tgt, morph):arrs), lawS=l, maxCycles=nb}
funct = PartialFunctor{srcPF=prev,tgtPF=new,omapPF=functToAssocList id nodes,mmapPF=functToAssocList id (arrows 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.
identifyMorphismsS :: (Eq a, Eq b) => SafeCompositionGraph a b -> SCGMorphism a b -> SCGMorphism a b -> Either
(SafeCompositionGraphError a b)
(SafeCompositionGraph a b, (PartialFunctor (SafeCompositionGraph a b) (SCGMorphism a b) a))
identifyMorphismsS prev@SafeCompositionGraph{graphS=(nodes,arrs), lawS=l, maxCycles=nb} srcM tgtM
| isGenS srcM = Left IdentifyGeneratorS{genS=srcM}
| isNothing check = Right (new,funct)
| otherwise = Left $ ResultingCategoryErrorS (fromJust check)
where
newLaw = ((snd3.pathS) srcM,(snd3.pathS) tgtM):l
new = SafeCompositionGraph{graphS=(nodes,arrs), lawS=newLaw, maxCycles=nb}
check = checkGeneratedFiniteCategoryProperties new
replaceLaw m = SCGMorphism{pathS=(pathS m)
,compositionLawS=newLaw, maxNbCycles=nb}
funct = PartialFunctor{srcPF=prev,tgtPF=new,omapPF=functToAssocList id nodes,mmapPF=functToAssocList replaceLaw (delete srcM (arrows 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.
unidentifyMorphismS :: (Eq a, Eq b) => SafeCompositionGraph a b -> SCGMorphism a b -> Either
(SafeCompositionGraphError a b)
(SafeCompositionGraph a b, (PartialFunctor (SafeCompositionGraph a b) (SCGMorphism a b) a))
unidentifyMorphismS prev@SafeCompositionGraph{graphS=(nodes,arrs), lawS=l, maxCycles=nb} m
| elem m (ar prev (source m) (target m)) = Right (new,funct)
| otherwise = Left UnidentifyNonExistantMorphismS{morphS=m}
where
newLaw = filter (((snd3.pathS $ m)/=).snd) l
replaceLawInMorph SCGMorphism{pathS=p,compositionLawS=_, maxNbCycles=_} = SCGMorphism{pathS=p,compositionLawS=newLaw, maxNbCycles=nb}
new = SafeCompositionGraph{graphS=(nodes,arrs), lawS=newLaw, maxCycles=nb}
funct = PartialFunctor{srcPF=prev,tgtPF=new,omapPF=functToAssocList id nodes,mmapPF=functToAssocList replaceLawInMorph (arrows 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.
replaceObjectS :: (Eq a, Eq b) => SafeCompositionGraph a b -> a -> a -> Either
(SafeCompositionGraphError a b)
(SafeCompositionGraph a b, (PartialFunctor (SafeCompositionGraph a b) (SCGMorphism a b) a))
replaceObjectS prev@SafeCompositionGraph{graphS=(nodes,arrs), lawS=l, maxCycles=nb} prevObj newObj
| elem prevObj (ob prev) = Right (new,funct)
| otherwise = Left ReplaceNonExistantObjectS {faultyObjS=prevObj}
where
replace x = if x == prevObj then newObj else x
replaceArr (s,t,a) = (replace s, replace t, a)
replaceLawEntry (k,v) = (replaceArr <$> k, replaceArr <$> v)
replaceCGMorph SCGMorphism{pathS=(s,rp,t),compositionLawS=l, maxNbCycles=nb} = SCGMorphism{pathS=(replace s,replaceArr <$> rp,replace t),compositionLawS=replaceLawEntry <$> l, maxNbCycles=nb}
new = SafeCompositionGraph{graphS=(replace <$> nodes,replaceArr <$> arrs), lawS=replaceLawEntry <$> l, maxCycles=nb}
funct = PartialFunctor{srcPF=prev,tgtPF=new,omapPF=functToAssocList replace nodes,mmapPF=functToAssocList replaceCGMorph (arrows 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.
replaceMorphismS :: (Eq a, Eq b) => SafeCompositionGraph a b -> SCGMorphism a b -> b -> Either
(SafeCompositionGraphError a b)
(SafeCompositionGraph a b, (PartialFunctor (SafeCompositionGraph a b) (SCGMorphism a b) a))
replaceMorphismS prev@SafeCompositionGraph{graphS=(nodes,arrs), lawS=l, maxCycles=nb} prevMorph newMorph
| elem prevMorph (genAr prev (source prevMorph) (target prevMorph)) = Right (new,funct)
| otherwise = Left ReplaceCompositeMorphismS{compositeS=prevMorph}
where
replaceArr m@(s,t,a) = if [m] == (snd3.pathS $ prevMorph) then (s, t, newMorph) else m
replaceLawEntry (k,v) = (replaceArr <$> k, replaceArr <$> v)
replaceCGMorph SCGMorphism{pathS=(s,rp,t),compositionLawS=l, maxNbCycles=_} = SCGMorphism{pathS=(s,replaceArr <$> rp,t),compositionLawS=replaceLawEntry <$> l, maxNbCycles=nb}
new = SafeCompositionGraph{graphS=(nodes,replaceArr <$> arrs), lawS=replaceLawEntry <$> l, maxCycles=nb}
funct = PartialFunctor{srcPF=prev,tgtPF=new,omapPF=functToAssocList id nodes,mmapPF=functToAssocList replaceCGMorph (arrows prev)}
-- | Deletes a generating morphism if it can, the generator should not be an identity.
deleteMorphismS :: (Eq a, Eq b) => SafeCompositionGraph a b -> SCGMorphism a b -> Either
(SafeCompositionGraphError a b)
(SafeCompositionGraph a b, (PartialFunctor (SafeCompositionGraph a b) (SCGMorphism a b) a))
deleteMorphismS prev@SafeCompositionGraph{graphS=(nodes,arrs), lawS=l, maxCycles=nb} morph
| isIdentity prev morph = Left DeleteIdentityS {faultyIdentityS=morph}
| elem morph (genAr prev (source morph) (target morph)) = Right (new,funct)
| elem morph (ar prev (source morph) (target morph)) = Left DeleteCompositeMorphS{compositeS=morph}
| otherwise = Left DeleteNonExistantObjectMorphS{neMorphS=morph}
where
arr = head.snd3.pathS $ morph
newLaw = filter (\(k,v) -> and ((/=arr) <$> k) && and ((/=arr) <$> v)) l
newArrows = filter (\SCGMorphism{pathS=(s,rp,t),compositionLawS=_, maxNbCycles=_} -> not (elem arr rp)) (arrows prev)
replaceLaw m = SCGMorphism{pathS=(pathS m)
,compositionLawS=newLaw,maxNbCycles=nb}
new = SafeCompositionGraph{graphS=(nodes,delete arr arrs), lawS=newLaw, maxCycles=nb}
funct = PartialFunctor{srcPF=prev,tgtPF=new,omapPF=functToAssocList id nodes,mmapPF=functToAssocList replaceLaw newArrows}
-- | Deletes an object and all morphism coming from it or leaving it.
deleteObjectS :: (Eq a, Eq b) => SafeCompositionGraph a b -> a -> Either
(SafeCompositionGraphError a b)
(SafeCompositionGraph a b, (PartialFunctor (SafeCompositionGraph a b) (SCGMorphism a b) a))
deleteObjectS prev@SafeCompositionGraph{graphS=(nodes,arrs), lawS=l, maxCycles=nb} obj
| elem obj (ob prev) = (\(cg,f) -> (\(fcg,ffunct) -> (fcg,ffunct @ f)) (delObj cg)) <$> cgWithoutMorphs
| otherwise = Left DeleteNonExistantObjectS {faultyObjS=obj}
where
idFunct = PartialFunctor{srcPF=prev,tgtPF=prev,omapPF=functToAssocList id nodes,mmapPF=functToAssocList id (arrows prev)}
cgWithoutMorphs = foldM (\(cg,f) d -> ((\(ncg,nf) -> (ncg,nf @ f)) <$> (deleteMorphismS cg d))) (prev,idFunct) (filter (isNotIdentity prev) (nub ((genArFrom prev obj)++(genArTo prev obj))))
delObj prev2@SafeCompositionGraph{graphS=(nodes2,arrs2), lawS=l2, maxCycles=nb} = (finalCG,
PartialFunctor{srcPF=prev2,tgtPF=finalCG,omapPF=functToAssocList id (delete obj nodes2),mmapPF=functToAssocList id ((arrows prev2)\\[(identity prev2 obj)])})
where
finalCG = SafeCompositionGraph{graphS=(delete obj nodes2,arrs2), lawS=l2, maxCycles=nb}