{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module CompositionGraph.CompositionGraph
(
Arrow(..),
Graph(..),
RawPath(..),
Path(..),
CGMorphism(..),
CompositionLaw(..),
CompositionGraph(..),
mkCompositionGraph,
mkEmptyCompositionGraph,
finiteCategoryToCompositionGraph,
generatedFiniteCategoryToCompositionGraph,
CompositionGraphError(..),
insertObject,
insertMorphism,
identifyMorphisms,
unidentifyMorphism,
replaceObject,
replaceMorphism,
deleteObject,
deleteMorphism,
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)
type Arrow a b = (a, a, b)
type RawPath a b = [Arrow a b]
type Path a b = (a, RawPath a b, a)
type CompositionLaw a b = AssociationList (RawPath a b) (RawPath a b)
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
type Graph a b = ([a],[Arrow a b])
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)
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
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}
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
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
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.")
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)
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)
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))
intertwine :: [a] -> [a] -> [a]
intertwine :: forall a. [a] -> [a] -> [a]
intertwine [] [a]
l = [a]
l
intertwine [a]
l [] = [a]
l
intertwine l1 :: [a]
l1@(a
x1:[a]
xs1) l2 :: [a]
l2@(a
x2:[a]
xs2) = (a
x1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a
x2a -> [a] -> [a]
forall a. a -> [a] -> [a]
:([a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
intertwine [a]
xs1 [a]
xs2)))
intertwineWithCycles :: (Eq a, Eq b) => Graph a b -> CompositionLaw a b -> 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)
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)
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)
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
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
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
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
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=[]}
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)}
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)}
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}
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)}
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)}
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))}
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)}
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)}
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)}
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}
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}