packages feed

FiniteCategories-0.1.0.0: src/ExportGraphViz/ExportGraphViz.hs

{-| Module  : FiniteCategories
Description : Visualize categories with GraphViz.
Copyright   : Guillaume Sabbagh 2021
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

This module is a way of visualizing categories with GraphViz.

See Example.ExampleCompositionGraph or Example.ExampleSet.
-}

module ExportGraphViz.ExportGraphViz
(
    -- * Visualize categories
    categoryToGraph,
    catToDot,
    catToPdf,
    genToDot,
    genToPdf,
    -- * Visualize diagrams
    diagToDotCluster,
    diagToPdfCluster,
    diagToDot,
    diagToPdf,
    diagToDot2,
    diagToPdf2,
    -- * Visualize natural transformations
    natToDot,
    natToPdf,
    -- * Visualize cones
    coneToDot,
    coneToPdf
)
where
    import              FiniteCategory.FiniteCategory
    import              Diagram.Diagram
    import              FunctorCategory.FunctorCategory
    import              Utils.AssociationList
    import              ConeCategory.ConeCategory
    import              Subcategories.FreeSubcategory

    import              Data.List                                   (elemIndex,intercalate)
    import qualified    Data.Text.Lazy                      as L    (pack)
    import qualified    Data.Text.Lazy.IO                   as IO   (putStrLn)
    import              IO.CreateAndWriteFile                       (createAndWriteFile)
    import              IO.PrettyPrint
    import              Data.Graph.Inductive.Graph                  (mkGraph, Node, Edge, LNode, LEdge)
    import              Data.Graph.Inductive.PatriciaTree           (Gr)
    import              Data.GraphViz                               (graphToDot, nonClusteredParams, fmtNode, fmtEdge, GraphvizParams(..), NodeCluster(..), blankParams,GraphID( Num ), Number(..))
    import              Data.GraphViz.Attributes.Complete           (Label(StrLabel), Attribute(Label))
    import              Data.Word                                   (Word8)
    import              Data.GraphViz.Attributes                    (X11Color(..), color)
    import              Data.GraphViz.Printing                      (renderDot, toDot)
    import              Data.Maybe
    
    import              System.Process                              (callCommand)
    
    
    objToNode :: (Eq o, FiniteCategory c m o) => c -> o -> Node
    objToNode c o
        | index == Nothing = error("Call objToNod on an object not in the category.")
        | otherwise = i
        where 
            Just i = index
            index = elemIndex o (ob c)

    objToLNode :: (Eq o, PrettyPrintable o, FiniteCategory c m o) => c -> o -> LNode String
    objToLNode c o = (objToNode c o, pprint o)
    
    arToEdge :: (Eq o, Morphism m o, FiniteCategory c m o) => c -> m -> Edge
    arToEdge c m = ((objToNode c). source $ m, (objToNode c). target $ m)
    
    arToLEdge :: (Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o, FiniteCategory c m o) => c -> m -> LEdge String
    arToLEdge c m = ((objToNode c). source $ m, (objToNode c). target $ m, pprint m)
    
    -- | Transforms a category to representation as an inductive graph.
    categoryToGraph :: (Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o, FiniteCategory c m o) => c -> Gr String String
    categoryToGraph c = mkGraph (objToLNode c <$> (ob c)) (arToLEdge c <$> (arrows c))
    
    dotToPdf :: IO () -> String -> IO ()
    dotToPdf dot path = dot >> callCommand ("dot "++path++" -o "++path++".pdf -T pdf") 
    
    -- | Export a category with GraphViz. If the category is too large, use `genToDot` instead.
    --
    -- The black arrows are generating arrows, grey one are generated arrows.
    catToDot :: (Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o, GeneratedFiniteCategory c m o) => c -> String -> IO ()
    catToDot c path = createAndWriteFile path $ renderDot $ toDot dot_file where
        dot_file = graphToDot nonClusteredParams { fmtNode= \(n,label)-> [Label (StrLabel (L.pack label))],
                                                   fmtEdge= \(n1,n2,label)-> [Label (StrLabel (L.pack label)),
                                                   if elem label generatorsLabels then color Black else color Gray80]} (categoryToGraph c)
        generators = genArrows c
        generatorsLabels = pprint <$> generators

    -- | Export a category with GraphViz. If the category is too large, use `genToPdf` instead.
    --
    -- The black arrows are generating arrows, grey one are generated arrows.
    catToPdf :: (Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o, GeneratedFiniteCategory c m o) => c -> String -> IO ()
    catToPdf c path = dotToPdf (catToDot c path) path
    
    -- | Transforms a category into an inductive graph.
    categoryToGeneratorGraph :: (Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o, GeneratedFiniteCategory c m o) => c -> Gr String String
    categoryToGeneratorGraph c = mkGraph (objToLNode c <$> (ob c)) (arToLEdge c <$> (genArrows c))
    
    -- | Export the generator of a category with GraphViz. Use this when the category is to large to be fully exported.
    genToDot :: (Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o, GeneratedFiniteCategory c m o) => c -> String -> IO ()
    genToDot c path = createAndWriteFile path $ renderDot $ toDot dot_file where
        dot_file = graphToDot nonClusteredParams { fmtNode= \(n,label)-> [Label (StrLabel (L.pack label))],
                                                   fmtEdge= \(n1,n2,label)-> [Label (StrLabel (L.pack label))]} (categoryToGeneratorGraph c)

    -- | Export the generator of a category with GraphViz. Use this when the category is to large to be fully exported.
    genToPdf :: (Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o, GeneratedFiniteCategory c m o) => c -> String -> IO ()
    genToPdf c path =  dotToPdf (genToDot c path) path
    
    -- __________________________________
    -- __________________________________
    --
    -- Diagram representation with cluster of objects mapped together
    -- __________________________________
    -- __________________________________
    

    
    -- | If the nodeif pair, then it is part of the source category, else it is part of the target category.
    diagObjToNodeCluster :: (Eq o, FiniteCategory c m o) => c -> Bool -> o -> Node
    diagObjToNodeCluster c b o
        | index == Nothing = error("Call diagObjToNod on an object not in the category.")
        | otherwise = if b then 2*i else 2*i+1
        where 
            Just i = index
            index = elemIndex o (ob c)
            
    diagObjToLNodeCluster :: (Eq o, PrettyPrintable o, FiniteCategory c m o) => c -> Bool -> o -> LNode String
    diagObjToLNodeCluster c b o = (diagObjToNodeCluster c b o, pprint o)
    
    diagArToEdgeCluster :: (Eq o, Morphism m o, FiniteCategory c m o) => c -> Bool -> m -> Edge
    diagArToEdgeCluster c b m = ((diagObjToNodeCluster c b). source $ m, (diagObjToNodeCluster c b). target $ m)
    
    diagArToLEdgeCluster :: (Eq o, PrettyPrintable o, PrettyPrintable m, Morphism m o, FiniteCategory c m o) => c -> Bool -> m -> LEdge String
    diagArToLEdgeCluster c b m = ((diagObjToNodeCluster c b). source $ m, (diagObjToNodeCluster c b). target $ m, pprint m)
    
    diagToGraphCluster :: (Eq c1, Eq o1, PrettyPrintable o1, PrettyPrintable m1, Morphism m1 o1, GeneratedFiniteCategory c1 m1 o1,
                           Eq c2, Eq o2, PrettyPrintable o2, PrettyPrintable m2, Morphism m2 o2, GeneratedFiniteCategory c2 m2 o2) =>
                           Diagram c1 m1 o1 c2 m2 o2 -> Gr String String
    diagToGraphCluster f = mkGraph ((diagObjToLNodeCluster (src f) True <$> (ob (src f)))++(diagObjToLNodeCluster (tgt f) False <$> (ob (tgt f)))) ((diagArToLEdgeCluster (src f) True <$> (genArrows (src f)))++(diagArToLEdgeCluster (tgt f) False <$> (genArrows (tgt f))))
    
    -- | Export a functor with GraphViz such that the source category is in green, the target in blue, the objects mapped together are in the same cluster.
    diagToDotCluster :: (Eq c1, Eq o1, PrettyPrintable o1, PrettyPrintable m1, Morphism m1 o1, GeneratedFiniteCategory c1 m1 o1,
                         Eq c2, Eq o2, PrettyPrintable o2, PrettyPrintable m2, Morphism m2 o2, GeneratedFiniteCategory c2 m2 o2) =>
                        Diagram c1 m1 o1 c2 m2 o2 -> String -> IO ()
    diagToDotCluster f@Diagram{src=s,tgt=t,omap=om,mmap=fm} path =  createAndWriteFile path $ renderDot $ toDot dot_file where
        dot_file = graphToDot Params {
                                             isDirected = True
                                            ,globalAttributes = []
                                            ,clusterBy = (\(n,nl) -> if (n `mod` 2) == 0 then (C ((fromJust (elemIndex (om !-! ((ob s) !! (n `div` 2))) (ob t)))) $ N (n,nl)) else (C (fromJust (elemIndex ((ob t) !! (n `div` 2)) (ob t))) $ N (n,nl)))
                                            ,isDotCluster = const True
                                            ,clusterID = Num . Int
                                            ,fmtCluster = const []
                                            ,fmtNode = \(n,label)-> [Label (StrLabel (L.pack label)), if (n `mod` 2) == 0 then color Green else color Blue]
                                            ,fmtEdge= \(n1,n2,label)-> [Label (StrLabel (L.pack label))]
                                          } (diagToGraphCluster f)
    
    -- | Export a functor as a pdf with GraphViz such that the source category is in green, the target in blue, the objects mapped together are in the same cluster.
    diagToPdfCluster :: (Eq c1, Eq o1, PrettyPrintable o1, PrettyPrintable m1, Morphism m1 o1, GeneratedFiniteCategory c1 m1 o1,
                         Eq c2, Eq o2, PrettyPrintable o2, PrettyPrintable m2, Morphism m2 o2, GeneratedFiniteCategory c2 m2 o2) =>
                        Diagram c1 m1 o1 c2 m2 o2 -> String -> IO ()
    diagToPdfCluster f path =  dotToPdf (diagToDotCluster f path) path
    
    -- __________________________________
    -- __________________________________
    --
    -- Diagram representation with arrows between arrows
    -- __________________________________
    -- __________________________________
    
    indexAr :: (Morphism m o, FiniteCategory c m o, Eq o, Eq m) => c -> m -> Int
    indexAr c m 
        | elem m (arrows c) = fromJust $ elemIndex m (arrows c)
        | otherwise = error "indexAr of arrow not in category"
    
    indexOb :: (FiniteCategory c m o, Eq o) => c -> o -> Int
    indexOb c o
        | elem o (ob c) = fromJust $ elemIndex o (ob c)
        | otherwise = error "indexOb of object not in category"
    
    -- | If the node%4 == 0, then it is part of the source category, else if node%4 == 1 it is part of the target category.
    diagObjToNode :: (Eq o, FiniteCategory c m o) => c -> Bool -> o -> Node
    diagObjToNode c b o
        | index == Nothing = error("Call diagObjToNode on an object not in the category.")
        | otherwise = if b then 4*i else 4*i+1
        where 
            Just i = index
            index = elemIndex o (ob c)
    
    diagObjToLNode :: (Eq o, PrettyPrintable o, FiniteCategory c m o) => c -> Bool -> o -> LNode String
    diagObjToLNode c b o = (diagObjToNode c b o, pprint o)
            
    -- Creates the invisible node associated to an arrow of the source category if the boolean is True, of the target category if the boolean is False.
    invisNodeSrc :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1,
                     Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2) =>
                    (Diagram c1 m1 o1 c2 m2 o2) -> m1 -> LNode String
    invisNodeSrc f@Diagram{src=s,tgt=t,mmap=_,omap=_} m = (4*(indexAr s m)+2, pprint m)
    
    invisNodeTgt :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1,
                     Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2) =>
                    (Diagram c1 m1 o1 c2 m2 o2) -> m2 -> LNode String
    invisNodeTgt f@Diagram{src=s,tgt=t,mmap=_,omap=_} m = (4*(indexAr t m)+3, pprint m)
    
    diagArToLEdges :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1,
                       Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2) =>
                      (Diagram c1 m1 o1 c2 m2 o2) -> Either m1 m2 -> [LEdge String]
    diagArToLEdges f@Diagram{src=s,tgt=t,omap=_,mmap=_} (Left m) = [((diagObjToNode s True). source $ m, fst.(invisNodeSrc f) $ m, ""),(fst.(invisNodeSrc f) $ m,(diagObjToNode s True). target $ m, "")]
    diagArToLEdges f@Diagram{src=s,tgt=t,omap=_,mmap=_} (Right m) = [((diagObjToNode t False). source $ m, fst.(invisNodeTgt f) $ m, ""),(fst.(invisNodeTgt f) $ m,(diagObjToNode t False). target $ m, "")]
    
    linkArrows :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1,
                   Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2) =>
                  (Diagram c1 m1 o1 c2 m2 o2) -> [LEdge String]
    linkArrows f@Diagram{src=s,tgt=t,omap=_,mmap=fm} = (\m->(fst(invisNodeSrc f m),fst(invisNodeTgt f (fm !-! m)),"")) <$> (arrows s)
    
    linkObjects :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1,
                    Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2) =>
                   (Diagram c1 m1 o1 c2 m2 o2) -> [LEdge String]
    linkObjects f@Diagram{src=s,tgt=t,omap=om,mmap=_} = (\o->(diagObjToNode s True o,diagObjToNode t False (om !-! o),"")) <$> (ob s)
    
    diagToGraph :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1, PrettyPrintable o1,
                    Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2, PrettyPrintable o2) =>
                   (Diagram c1 m1 o1 c2 m2 o2) -> Gr String String
    diagToGraph f = mkGraph ((diagObjToLNode (src f) True <$> (ob (src f)))++(diagObjToLNode (tgt f) False <$> (ob (tgt f)))++((invisNodeSrc f) <$> (arrows (src f)))++((invisNodeTgt f) <$> (arrows (tgt f))))
                             ((concat ((diagArToLEdges f <$> (Left <$> (arrows (src f))))++(diagArToLEdges f <$> (Right <$> (arrows (tgt f))))))++(linkArrows f)++(linkObjects f))
    
    -- | Export a diagram with GraphViz such that the source category is in green, the target in blue, each morphism is represented by a node.
    diagToDot :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1, PrettyPrintable o1,
                  Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2, PrettyPrintable o2) =>
                 (Diagram c1 m1 o1 c2 m2 o2) -> String -> IO ()
    diagToDot f@Diagram{src=s,tgt=t,omap=om,mmap=fm} path =  createAndWriteFile path $ renderDot $ toDot dot_file where
        dot_file = graphToDot Params {
                                             isDirected = True
                                            ,globalAttributes = []
                                            ,clusterBy = (\(n,nl) -> case () of
                                                                  _ | (n `mod` 2) == 0 -> (C 0 $ N (n,nl))
                                                                    | (n `mod` 2) == 1 -> (C 1 $ N (n,nl)))
                                            ,isDotCluster = const True
                                            ,clusterID = Num . Int
                                            ,fmtCluster = const []
                                            ,fmtNode = \(n,label)-> [Label (StrLabel (L.pack label)), fmtColorN n]
                                            ,fmtEdge= \e@(n1,n2,label)-> [Label (StrLabel (L.pack label)), fmtColorE e]
                                          } (diagToGraph f)
                    where
                        fmtColorN n   | n `mod` 4 == 0 = color Green
                                      | n `mod` 4 == 1 = color Blue
                                      | n `mod` 4 == 2 = color Red
                                      | n `mod` 4 == 3 = color Pink
                        fmtColorE (s,t,_)   | s `mod ` 4 == 0 = if t `mod` 2 == 1 then color Red else color Green
                                            | t `mod ` 4 == 0 = color Green
                                            | s `mod ` 4 == 1 = color Blue
                                            | t `mod ` 4 == 1 = color Blue
                                            | otherwise = color Black
            
    -- | Export a diagram as a pdf with GraphViz such that the source category is in green, the target in blue, each morphism is represented by a node.
    diagToPdf :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1, PrettyPrintable o1,
                  Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2, PrettyPrintable o2) =>
                 (Diagram c1 m1 o1 c2 m2 o2) -> String -> IO ()
    diagToPdf f path =  dotToPdf (diagToDot f path) path
    
    
    -- __________________________________
    -- __________________________________
    --
    -- Diagram representation as a selection of the target category
    -- __________________________________
    -- __________________________________
    
    -- | Export a diagram with GraphViz such that a node or an arrow is in orange if it is the target of the functor.
    diagToDot2 :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1, PrettyPrintable o1,
                   Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2, PrettyPrintable o2) =>
                  (Diagram c1 m1 o1 c2 m2 o2) -> String -> IO ()
    diagToDot2 f@Diagram{src=s,tgt=t,omap=om,mmap=fm} path = createAndWriteFile path $ renderDot $ toDot dot_file where
        dot_file = graphToDot nonClusteredParams { fmtNode= \(n,label)-> [Label (StrLabel (L.pack label)), colorNode n],
                                                   fmtEdge= \(n1,n2,label)-> [Label (StrLabel (L.pack label)), colorEdge label]} (categoryToGraph t)
                                                   where
                                                        colorNode n = case () of
                                                                        _ | countPredN == 0 -> color Black
                                                                          | countPredN == 1 -> color Orange
                                                                          | countPredN == 2 -> color Orange1
                                                                          | countPredN == 3 -> color Orange2
                                                                          | countPredN == 4 -> color Orange3
                                                                          | countPredN == 5 -> color Orange4
                                                                          | otherwise -> color OrangeRed4
                                                                        
                                                            where
                                                                countPredN = length [1 | o <- (ob s), (objToNode t (om !-! o)) == n]
                                                        colorEdge e = case () of
                                                                        _ | countPredE == 0 -> color Black
                                                                          | countPredE == 1 -> color Orange
                                                                          | countPredE == 2 -> color Orange1
                                                                          | countPredE == 3 -> color Orange2
                                                                          | countPredE == 4 -> color Orange3
                                                                          | countPredE == 5 -> color Orange4
                                                                          | otherwise -> color OrangeRed4
                                                            where
                                                                countPredE = length [1 | m <- (arrows s), (pprint (fm !-! m)) == e]
    
    -- | Export a diagram as a pdf with GraphViz such that a node or an arrow is in orange if it is the target of the functor.
    diagToPdf2 :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1, PrettyPrintable o1,
                  Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2, PrettyPrintable o2) =>
                 (Diagram c1 m1 o1 c2 m2 o2) -> String -> IO ()
    diagToPdf2 f path =  dotToPdf (diagToDot2 f path) path
    
    -- __________________________________
    -- __________________________________
    --
    -- Natural transformation representation as a translation in the target category.
    -- __________________________________
    -- __________________________________
    
    -- | Export a natural transformation with GraphViz such that the source diagram is in green, the target diagram is in blue and the translation is in yellow.
    natToDot ::   (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1, PrettyPrintable o1,
                   Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2, PrettyPrintable o2) =>
                  (NaturalTransformation c1 m1 o1 c2 m2 o2) -> String -> IO ()
    natToDot NaturalTransformation{srcNT=s,tgtNT=t,component=c} path = createAndWriteFile path $ renderDot $ toDot dot_file where
        dot_file = graphToDot nonClusteredParams { fmtNode= \(n,label)-> [Label (StrLabel (L.pack label)), colorNode n],
                                                   fmtEdge= \(n1,n2,label)-> [Label (StrLabel (L.pack label)), colorEdge label]} (categoryToGraph (tgt s))
                                                   where
                                                        colorNode n = case () of
                                                                        _ | predNSrc && predNTgt -> color Turquoise
                                                                          | predNSrc -> color Green
                                                                          | predNTgt -> color Blue
                                                                          | otherwise -> color Black      
                                                            where
                                                                predNSrc = foldr (||) False [(objToNode (tgt s) ((omap s) !-! o)) == n | o <- (ob (src s))]
                                                                predNTgt = foldr (||) False [(objToNode (tgt t) ((omap t) !-! o)) == n | o <- (ob (src t))]
                                                        colorEdge e = case () of
                                                                        _ | predESrc && predETgt && predENat -> color Beige
                                                                          | predESrc && predETgt -> color Turquoise
                                                                          | predESrc && predENat -> color Orange
                                                                          | predETgt && predENat -> color LightBlue
                                                                          | predESrc -> color Green
                                                                          | predETgt -> color Blue
                                                                          | predENat -> color Yellow
                                                                          | otherwise -> color Black
                                                            where
                                                                predESrc = foldr (||) False [(pprint ((mmap s) !-! m)) == e | m <- (arrows (src s))]
                                                                predETgt = foldr (||) False [(pprint ((mmap t) !-! m)) == e | m <- (arrows (src t))]
                                                                predENat = foldr (||) False [(pprint (c o)) == e | o <- (ob (src s))]
              
    -- | Export a natural transformation as pdf with GraphViz such that the source diagram is in green, the target diagram is in blue and the translation is in yellow.
    natToPdf :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1, PrettyPrintable o1,
                  Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2, PrettyPrintable o2) =>
                 (NaturalTransformation c1 m1 o1 c2 m2 o2) -> String -> IO ()
    natToPdf nt path =  dotToPdf (natToDot nt path) path
    
    -- __________________________________
    -- __________________________________
    --
    -- Cone representation as a translation in the reduced target category.
    -- __________________________________
    -- __________________________________
    
    -- | Export a cone with GraphViz such that the legs are in yellow.
    extractFromTarget :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1,
                          Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2) =>
                          (NaturalTransformation c1 m1 o1 c2 m2 o2) -> (FreeSubcategory c2 m2 o2)
    extractFromTarget NaturalTransformation{srcNT=s,tgtNT=t,component=c} = FreeSubcategory (tgt s) ([(mmap s) !-! m | m <- (arrows (src s))]++[(mmap t) !-! m | m <- (arrows (src s))]++[c o | o <- (ob (src s))])
    
    -- | Export a cone with GraphViz such that the source diagram is in green, the target diagram is in blue and the translation is in yellow.
    coneToDot ::   (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1, PrettyPrintable o1,
                   Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2, PrettyPrintable o2) =>
                  (NaturalTransformation c1 m1 o1 c2 m2 o2) -> String -> IO ()
    coneToDot nt@NaturalTransformation{srcNT=s,tgtNT=t,component=c} path = createAndWriteFile path $ renderDot $ toDot dot_file where
        dot_file = graphToDot nonClusteredParams { fmtNode= \(n,label)-> [Label (StrLabel (L.pack label)), colorNode n],
                                                   fmtEdge= \(n1,n2,label)-> [Label (StrLabel (L.pack label)), colorEdge label]} (categoryToGraph (extractFromTarget nt))
                                                   where
                                                        colorNode n = case () of
                                                                        _ | predNSrc && predNTgt -> color Turquoise
                                                                          | predNSrc -> color Green
                                                                          | predNTgt -> color Blue
                                                                          | otherwise -> color Black      
                                                            where
                                                                predNSrc = foldr (||) False [(objToNode (tgt s) ((omap s) !-! o)) == n | o <- (ob (src s))]
                                                                predNTgt = foldr (||) False [(objToNode (tgt t) ((omap t) !-! o)) == n | o <- (ob (src t))]
                                                        colorEdge e = case () of
                                                                        _ | predESrc && predETgt && predENat -> color Beige
                                                                          | predESrc && predETgt -> color Turquoise
                                                                          | predESrc && predENat -> color Orange
                                                                          | predETgt && predENat -> color LightBlue
                                                                          | predESrc -> color Green
                                                                          | predETgt -> color Blue
                                                                          | predENat -> color Yellow
                                                                          | otherwise -> color Black
                                                            where
                                                                predESrc = foldr (||) False [(pprint ((mmap s) !-! m)) == e | m <- (arrows (src s))]
                                                                predETgt = foldr (||) False [(pprint ((mmap t) !-! m)) == e | m <- (arrows (src t))]
                                                                predENat = foldr (||) False [(pprint (c o)) == e | o <- (ob (src s))]
              
    -- | Export a cone as pdf with GraphViz such that the source diagram is in green, the target diagram is in blue and the translation is in yellow.
    coneToPdf :: (Morphism m1 o1, FiniteCategory c1 m1 o1, Eq o1, Eq m1, PrettyPrintable m1, PrettyPrintable o1,
                  Morphism m2 o2, FiniteCategory c2 m2 o2, Eq o2, Eq m2, PrettyPrintable m2, PrettyPrintable o2) =>
                 (NaturalTransformation c1 m1 o1 c2 m2 o2) -> String -> IO ()
    coneToPdf nt path =  dotToPdf (coneToDot nt path) path