FiniteCategories-0.1.0.0: src/CompositionGraph/CompositionGraph.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 `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 {path :: Path a b,
compositionLaw :: CompositionLaw a b} deriving (Show, Eq)
instance (PrettyPrintable a, PrettyPrintable b, Eq a, Eq b) => PrettyPrintable (CGMorphism a b) where
pprint CGMorphism {path=(s,[],t),compositionLaw=cl} = if s == t then "Id"++(pprint s) else error "Identity with source different of target."
pprint CGMorphism {path=(_,rp,_),compositionLaw=cl} = intercalate " o " $ (\(_,_,l) -> pprint l) <$> 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 _ [] = []
simplifyOnce _ [e] = [e]
simplifyOnce cl list
| new_list == [] = []
| new_list /= list = new_list
| simple_tail /= (tail list) = (head list):simple_tail
| simple_init /= (init list) = simple_init++[(last list)]
| otherwise = list
where
new_list = (!-?) list list cl
simple_tail = simplifyOnce cl (tail list)
simple_init = simplifyOnce cl (init list)
-- | Returns a completely simplified raw path.
simplify :: (Eq a, Eq b) => CompositionLaw a b -> RawPath a b -> RawPath a b
simplify _ [] = []
simplify cl rp
| simple_one == rp = rp
| otherwise = simplify cl simple_one
where simple_one = simplifyOnce cl rp
instance (Eq a, Eq b) => Morphism (CGMorphism a b) a where
(@) CGMorphism{path=(s2,rp2,t2), compositionLaw=cl2} CGMorphism{path=(s1,rp1,t1), compositionLaw=cl1}
| 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"
| otherwise = CGMorphism{path=(s1,(simplify cl1 (rp2++rp1)),t2), compositionLaw=cl1}
source CGMorphism{path=(s,_,_), compositionLaw=_} = s
target CGMorphism{path=(_,_,t), compositionLaw=_} = t
-- | Constructs a `CGMorphism` from a composition law and an arrow.
mkCGMorphism :: CompositionLaw a b -> Arrow a b -> CGMorphism a b
mkCGMorphism cl e@(s,t,l) = CGMorphism {path=(s,[e],t),compositionLaw=cl}
-- | 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 -> a -> CGMorphism a b
mkIdentity g@(n,_) cl x
| elem x n = CGMorphism {path=(x,[],x),compositionLaw=cl}
| 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 -> a -> [RawPath a b]
findElementaryCycles g cl o = nub (simplify cl <$> []:(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 -> a -> [RawPath a b]
findCycles g cl o = findCyclesWithPreviousCycles g cl o (findElementaryCycles g cl o) maximumLoopDepth where
findCyclesWithPreviousCycles g cl o p n = if n == 0 then error "Suspected infinite loop because of a malformed composition graph." else if newCycles \\ p == [] then newCycles else (findCyclesWithPreviousCycles g cl o newCycles (n-1)) where
newCycles = nub ((simplify cl) <$> ((++) <$> p <*> findElementaryCycles g cl 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 -> a -> RawPath a b -> [RawPath a b]
intertwineWithCycles g cl _ p@(x@(_,t,_):xs) = (concat <$> sequence (fmap intertwine prodCycles) (fmap (:[]) p)) where
prodCycles = cartesianProduct cycles
cycles = (findCycles g cl t):((\(s,_,_) -> (findCycles g cl s)) <$> p)
intertwineWithCycles g cl s [] = (findCycles g cl 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 g cl s t = (\p -> CGMorphism{path=(s,p,t),compositionLaw=cl}) <$> nub (simplify cl <$> concat((intertwineWithCycles g cl s) <$> acyclicPaths)) where
acyclicPaths = nub $ (simplify cl) <$> (findAcyclicRawPaths g s 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 {graph :: Graph a b, law :: CompositionLaw a b} deriving (Eq, Show)
instance (Eq a, Eq b) => FiniteCategory (CompositionGraph a b) (CGMorphism a b) a where
ob = fst.graph
identity c = mkIdentity (graph c) (law c)
ar c = mkAr (graph c) (law c)
instance (Eq a, Eq b) => GeneratedFiniteCategory (CompositionGraph a b) (CGMorphism a b) a where
genAr c@CompositionGraph{graph=g,law=l} s t
| s == t = gen ++ [identity c s]
| otherwise = gen
where gen = mkCGMorphism l <$> (filter (\a@(s1,t1,_) -> s == s1 && t == t1) $ snd g)
decompose c m@CGMorphism{path=(_,rp,_),compositionLaw=l}
| isIdentity c m = [m]
| otherwise = mkCGMorphism l <$> rp
instance (PrettyPrintable a, PrettyPrintable b, Eq a, Eq b) => PrettyPrintable (CompositionGraph a b) where
pprint cg@CompositionGraph{graph=(nodes,arrs),law=_} = "CompositionGraph("++intercalate "," (pprint <$> nodes)++"\n"++intercalate "," ((\(a,b,c) -> pprint c ++ ":" ++ pprint a ++ "->" ++ pprint b) <$> arrs)
-- | Optimized version of isGenerator for `CompositionGraph`.
isGen :: (Eq a) => CGMorphism a b -> Bool
isGen m@CGMorphism{path=p@(s,rp,t),compositionLaw=_} = (length rp ) < 2
-- | Optimized version of isComposite for `CompositionGraph`.
isComp :: (Eq a) => CGMorphism a b -> Bool
isComp = not.isGen
-- | Returns the label of a generator arrow which is not an identity.
getLabel :: (Eq a) => CGMorphism a b -> Maybe b
getLabel CGMorphism{path=(_,[(_,_,label)],_),compositionLaw=_} = Just label
getLabel _ = 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 g l
| isNothing check = Right c_g
| otherwise = Left (fromJust check)
where
c_g = CompositionGraph {graph = g, law = l}
check = checkGeneratedFiniteCategoryProperties c_g
-- | Constructs an empty `CompositionGraph`.
--
-- Use `insertObject`, `insertMorphism` and `identifyMorphisms` to build a `CompositionGraph` from it.
mkEmptyCompositionGraph :: CompositionGraph a b
mkEmptyCompositionGraph = CompositionGraph {graph=([],[]), 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 cat = (cg,isofunct)
where
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 = (CompositionGraph{graph=(ob cat, [morphToArrow f | f <- (arrows cat), isNotIdentity cat f])
, law= catLaw})
isofunct = Diagram{src=cat,tgt=cg,omap=functToAssocList id (ob cat),mmap=functToAssocList (\f -> if isNotIdentity cat f
then
mkCGMorphism catLaw (morphToArrow f)
else
identity cg (source f)) (arrows 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 cat = (cg,isofunct)
where
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 = (CompositionGraph{graph=(ob cat, [morphToArrow f | f <- (genArrows cat), isNotIdentity cat f])
, law= catLaw})
isofunct = Diagram{src=cat,tgt=cg,omap=functToAssocList id (ob cat),mmap= functToAssocList (\f -> if isNotIdentity cat f
then
CGMorphism {path=(source f,(morphToArrow <$> (decompose cat f)),target f),compositionLaw=catLaw}
else
identity cg (source f)) (arrows cat)}
-- | The datatype for composition graph construction errors.
data CompositionGraphError a b = InsertMorphismNonExistantSource {faultyMorph :: b, faultySrc :: a}
| InsertMorphismNonExistantTarget {faultyMorph :: b, faultyTgt :: a}
| IdentifyGenerator {gen :: CGMorphism a b}
| UnidentifyNonExistantMorphism {morph :: CGMorphism a b}
| ResultingCategoryError (FiniteCategoryError (CGMorphism a b) a)
| ReplaceNonExistantObject {faultyObj :: a}
| ReplaceCompositeMorphism {composite :: CGMorphism a b}
| DeleteIdentity {faultyIdentity :: CGMorphism a b}
| DeleteCompositeMorph {composite :: CGMorphism a b}
| DeleteNonExistantObjectMorph {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 prev@CompositionGraph{graph=(nodes,arrs), law=l} obj = (new, funct)
where
new = CompositionGraph{graph=(obj:nodes,arrs), law=l}
funct = PartialFunctor{srcPF=prev,tgtPF=new,omapPF=functToAssocList id nodes,mmapPF=functToAssocList id (arrows 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 prev@CompositionGraph{graph=(nodes,arrs), law=l} src tgt morph
| elem src nodes && elem tgt nodes = Right (new, funct)
| not $ elem src nodes = Left InsertMorphismNonExistantSource{faultyMorph=morph, faultySrc=src}
| not $ elem tgt nodes = Left InsertMorphismNonExistantTarget{faultyMorph=morph, faultyTgt=tgt}
where
new = CompositionGraph{graph=(nodes,(src, tgt, morph):arrs), law=l}
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.
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 prev@CompositionGraph{graph=(nodes,arrs), law=l} srcM tgtM
| isGen srcM = Left IdentifyGenerator{gen=srcM}
| isNothing check = Right (new,funct)
| otherwise = Left $ ResultingCategoryError (fromJust check)
where
newLaw = ((snd3.path) srcM,(snd3.path) tgtM):l
new = CompositionGraph{graph=(nodes,arrs), law=newLaw}
check = checkGeneratedFiniteCategoryProperties new
replaceLaw m = CGMorphism{path=(path m)
,compositionLaw=newLaw}
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.
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 prev@CompositionGraph{graph=(nodes,arrs), law=l} m
| elem m (ar prev (source m) (target m)) = Right (new,funct)
| otherwise = Left UnidentifyNonExistantMorphism{morph=m}
where
newLaw = filter (((snd3.path $ m)/=).snd) l
replaceLawInMorph CGMorphism{path=p,compositionLaw=_} = CGMorphism{path=p,compositionLaw=newLaw}
new = CompositionGraph{graph=(nodes,arrs), law=newLaw}
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.
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 prev@CompositionGraph{graph=(nodes,arrs), law=l} prevObj newObj
| elem prevObj (ob prev) = Right (new,funct)
| otherwise = Left ReplaceNonExistantObject {faultyObj=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 CGMorphism{path=(s,rp,t),compositionLaw=l} = CGMorphism{path=(replace s,replaceArr <$> rp,replace t),compositionLaw=replaceLawEntry <$> l}
new = CompositionGraph{graph=(replace <$> nodes,replaceArr <$> arrs), law=replaceLawEntry <$> l}
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.
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 prev@CompositionGraph{graph=(nodes,arrs), law=l} prevMorph newMorph
| elem prevMorph (genAr prev (source prevMorph) (target prevMorph)) = Right (new,funct)
| otherwise = Left ReplaceCompositeMorphism{composite=prevMorph}
where
replaceArr m@(s,t,a) = if [m] == (snd3.path $ prevMorph) then (s, t, newMorph) else m
replaceLawEntry (k,v) = (replaceArr <$> k, replaceArr <$> v)
replaceCGMorph CGMorphism{path=(s,rp,t),compositionLaw=l} = CGMorphism{path=(s,replaceArr <$> rp,t),compositionLaw=replaceLawEntry <$> l}
new = CompositionGraph{graph=(nodes,replaceArr <$> arrs), law=replaceLawEntry <$> l}
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.
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 prev@CompositionGraph{graph=(nodes,arrs), law=l} morph
| isIdentity prev morph = Left DeleteIdentity {faultyIdentity=morph}
| elem morph (genAr prev (source morph) (target morph)) = Right (new,funct)
| elem morph (ar prev (source morph) (target morph)) = Left DeleteCompositeMorph{composite=morph}
| otherwise = Left DeleteNonExistantObjectMorph{neMorph=morph}
where
arr = head.snd3.path $ morph
newLaw = filter (\(k,v) -> and ((/=arr) <$> k) && and ((/=arr) <$> v)) l
newArrows = filter (\CGMorphism{path=(s,rp,t),compositionLaw=_} -> not (elem arr rp)) (arrows prev)
replaceLaw m = CGMorphism{path=(path m)
,compositionLaw=newLaw}
new = CompositionGraph{graph=(nodes,delete arr arrs), law=newLaw}
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.
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 prev@CompositionGraph{graph=(nodes,arrs), law=l} obj
| elem obj (ob prev) = (\(cg,f) -> (\(fcg,ffunct) -> (fcg,ffunct @ f)) (delObj cg)) <$> cgWithoutMorphs
| otherwise = Left DeleteNonExistantObject {faultyObj=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)) <$> (deleteMorphism cg d))) (prev,idFunct) (filter (isNotIdentity prev) (nub ((genArFrom prev obj)++(genArTo prev obj))))
delObj prev2@CompositionGraph{graph=(nodes2,arrs2), law=l2} = (finalCG,
PartialFunctor{srcPF=prev2,tgtPF=finalCG,omapPF=functToAssocList id (delete obj nodes2),mmapPF=functToAssocList id ((arrows prev2)\\[(identity prev2 obj)])})
where
finalCG = CompositionGraph{graph=(delete obj nodes2,arrs2), law=l2}