Creating diagrams for category theory

Question

Lately I've been doing algebra and I have found myself drawing a bunch of diagrams when I attempt to solve a problem. Most of the diagrams are very simple so I thought, I bet I can do this in Mathematica and include these pictures in a nice document. What I would like to do is create diagrams like the ones found in category theory:

Here is an attempt based on a solution provided by Mr.Wizard

vertex = {
    {White, Disk[#2, 0.04]},
    Text[#, #2]
    } &;
GraphPlot[{
   {"A" -> "B", "f"},
   {"A" -> "C", "h"},
   {"B" -> "C", "g"}
   },
  DirectedEdges -> True,
  VertexLabeling -> True
  ] /. {Text -> vertex, Framed -> (# &)}

I like the idea of how in GraphPlot you can define the vertices and the labels. Unfortunately I'm still not very savvy on controlling many aspects of the Graphics. Does anyone know how to create diagrams like the ones I'm attempting to draw? It would be awesome if the font size could be specified.

Edit:

As belisarius pointed out:

Text length and font size should be considered with care

As requested by Mr.Wizard, here is are some interesting diagrams:

https://scientopia.org/blogs/goodmath/category/good-math/category-theory/

_{(source: pdp7.org)}

The second picture can be found here

A quick search on google images for "category theory diagrams" will give you some other diagrams including the ones I have put in here. It seems based on the figures that most of them involve simple rectangles with diagonal lines. In some cases some lines might be curved but this can all be done with straight lines.

Since the arrangement of the lines is up to personal choice it would be good to have a solution in which we can move the vertices locations, a similar functionality should be done with the edge labels. I picture an edge label as an image that can rotate around a point in a line. That way we can select a position in the line and the position angle. In most cases this angle is multiples of 45 degrees.

Answer 1

WildCats is a category theory package for Mathematica. It is still under development. Current version is 0.51.0

I am the developer.

WildCats can plot commutative (and non-commutative) categorical diagrams.

But it can do much more. It can do (some) calculations in category theory, both symbolically and - when appropriate - visually, using diagrams. This is because, in WildCats, diagrams are not just pretty pictures, but retain most of their mathematical semantic. So it is possible to input a diagram to a functor (which is an operator between categories) and obtain a new diagram. Functors are operators which preserve the topology of diagrams (that means: it transforms vertices and arrows and an arrow between 2 vertices is transformed into an arrow between the transformed 2 vertices).

Let me show some of the current diagram-drawing capabilities in WildCats and give some flavour of category theory along the way.

The following example is taken from the "Displaying diagrams" tutorial.

We are in the category (cat in some popular textbook) Grp, containing groups and their group-homomorphisms. Wildcats knows something about 27 well-known cats, but you can build your own cats too and derive new cats from old cats...that's why they can get wild pretty soon :-).

Grp is the category of groups.

We define 4 groups (g1...g4) and 3 group-homomorphisms (f1...f3) between them. They are the objects and morphisms in Grp. The following code defines the groups and morphisms.

When we define a morphism (an arrow) in Category theory, we must always specify where it starts and where it ends. So here f1 goes from groups g1 to g2.

WildCats at this point knows that we can compose the various morphisms and where the composite morphisms should start and end. Composite morphisms are represented as

Op[f2,f1,Grp]

or, even better, as

since WildCats uses custom notation for almost everything.

We can visualize all this with a CategoryPlot

The DC functions find the Domain and Codomain of an arrow (its starting and ending vertex)

As you see I just tell CategoryPlot which arrows I want to draw and it does the rest by itself (with just some help for the coordinates of the vertices).

The above diagram visually says that the composition in Grp is associative, that is

something that WildCats knows well.

Another example might be

It visually represents the relations

describing the fact that Id (identity morphisms) are bilateral identities in the morphism-composition. Notice that the same vertex (eg. g1) appears to be displayed in 2 different locations. This is not easily possible in standard Mathematica.

This is a visual depiction of the structure of (some of) the mathematical knowledge of WildCats (some standard categories and their relations).

The tantalizing thing in WildCats is that you can take a diagram, give it to a functor and get another diagram!

This is an example taken from the Tutorial "Functors". I won't go into the mathematical details too deeply.

Suppose you have some groups and homomorphims in a diagram cp

Now we tell WildCats that g4 is the Quaternions group (a group with 8 elements)

and apply to the above diagram the forgetful functor U[Grp , Set] which forgets the group structure and gives the underlying set of a group

As you see the groups IntegersPlus and RealsPlus (groups of numbers with the Plus operation) have become the simple sets Z and R of integers and reals (without any specific operation),Ab0, the trivial group, has become the Singleton set, while the g4 (the quaternions group) has become a simple set with 8 elements. Also notice that the composition in Grp is now a composition in Set the category of sets and functions.

In the future releases of WildCats, I would like to use some Dynamic features to bring life (and even more intuition) to all these diagram drawing.

Anyone interested in testing/using WildCats, can contact me at maderri2 at gmail dot com

Answer 2

After exploring phantomas1234 answer and the useful comments from Vitaliy Kaurov I have made a simple module which does what I want.

(* See bug fix bug below. *)
PlotDiagram[vertex_List, edge_List, args___] := Module[
  {
   v, vl, vp,
   e, el, es
   },
  v = Range[Length@vertex];
  vl = Table[vertex[[i, 1]], {i, 1, Length@vertex}];
  vp = Table[vertex[[i, 2]], {i, 1, Length@vertex}];
  e = Table[edge[[i, 1]], {i, 1, Length@edge}];
  el = Table[edge[[i, 2]], {i, 1, Length@edge}];
  es = Table[edge[[i, 3]], {i, 1, Length@edge}];
  Graph[e,
   VertexCoordinates -> vp,
   VertexLabels -> 
    Table[v[[i]] -> Placed[vl[[i]], {0.5, 0.5}], {i, 1, Length[v]}],
   EdgeLabels -> Table[e[[i]] -> el[[i]], {i, 1, Length[e]}],
   EdgeShapeFunction -> Table[e[[i]] -> es[[i]], {i, 1, Length[e]}],
   args,
   VertexLabelStyle -> Directive[Italic, 18],
   EdgeLabelStyle -> Directive[Italic, 15],
   VertexSize -> 0,
   VertexStyle -> Directive[EdgeForm[], White]
   ]
  ]

The default behavior is to make the diagram with vertex labels of font size 18 and the edge labels of font size 15. The first argument of the function has be a list containing the vertex labels and the positions of the vertices. The second argument is a list containing the edges. Each entry in edges is a list of 3 elements. The first one specifies the edge, the second specifies the label and the third specifies the arrow to be used. After that you may use any option you want for Graph. For a simple example I will make the figure that I showed in the post.

arrowShape =  ({Black, Arrowheads[0.1], Arrow[#, {2, 2}]} &);
vertex = {
   {"X", {0, 10}},
   {"Y", {10, 10}},
   {"Z", {10, 0}}
  };
edge = {
   {1 \[DirectedEdge] 2, Placed["f", {.5, {.5, -0.2}}], arrowShape},
   {2 \[DirectedEdge] 3, Placed[ "g", {.5, {-1.2, .5}}], arrowShape},
   {1 \[DirectedEdge] 3, Placed[ "g\[SmallCircle]f", {.5, {1.2, 1.2}}], arrowShape}
  };
graph = PlotDiagram[
  vertex, edge, 
  AspectRatio -> 1,
  ImageSize -> 2*72,
  ImagePadding -> {{15, 15}, {5, 20}}
 ]
Export["graph1.png", graph]

vertex = {
   {"T", {0, 10}},
   {Superscript["T", 2], {10, 10}},
   {"T", {20, 10}},
   {"T", {10, 0}}
  };
edge = {
   {1 \[DirectedEdge] 2, Placed["Tη", {.5, {.5, -.2}}], ({Black, Arrowheads[0.05], Arrow[#, {2, 2}]} &)},
   {3 \[DirectedEdge] 2, Placed[ "ηT", {.5, {.5, -.2}}], ({Black, Arrowheads[0.05], Arrow[#, {2, 2}]} &)},
   {2 \[DirectedEdge] 4, Placed[ "μ", {.5, {-1.2, -.5}}], ({Black, Dashed, Arrowheads[0.05], Arrow[#, {1, 1}]} &)},
   {1 \[DirectedEdge] 4, Placed[ "id", {.5, {2, 1.2}}], ({Black, Arrowheads[0.05], Arrow[#, {2, 2}]} &)},
   {3 \[DirectedEdge] 4, Placed[ "id", {.5, {-1.2, 1.2}}], ({Black, Arrowheads[0.05], Arrow[#, {2, 2}]} &)}
  };
graph = PlotDiagram[
  vertex, edge, 
  AspectRatio -> 1/GoldenRatio,
  ImageSize -> 4*72,
  ImagePadding -> {{15, 15}, {5, 20}}
 ]
Export["graph2.png", graph]

Notice how I was able to change the style of one of the edges. We can even change the tip of the arrow by using something similar as in one of the examples at Wolfram website.

Bug Fix

Special thanks to Frederick Fritz Fisher for pointing out the bug. The PlotDiagram module has a very simple problem. I neglected to use the vertices when using Graph. The correct form should be this:

PlotDiagram[vertex_List, edge_List, args___] := Module[
  {
   v, vl, vp,
   e, el, es
   },
  v = Range[Length@vertex];
  vl = Table[vertex[[i, 1]], {i, 1, Length@vertex}];
  vp = Table[vertex[[i, 2]], {i, 1, Length@vertex}];
  e = Table[edge[[i, 1]], {i, 1, Length@edge}];
  el = Table[edge[[i, 2]], {i, 1, Length@edge}];
  es = Table[edge[[i, 3]], {i, 1, Length@edge}];
  Graph[v, e,
   VertexCoordinates -> vp,
   VertexLabels -> 
    Table[v[[i]] -> Placed[vl[[i]], {0.5, 0.5}], {i, 1, Length[v]}],
   EdgeLabels -> Table[e[[i]] -> el[[i]], {i, 1, Length[e]}],
   EdgeShapeFunction -> Table[e[[i]] -> es[[i]], {i, 1, Length[e]}],
   args,
   VertexLabelStyle -> Directive[Italic, 18],
   EdgeLabelStyle -> Directive[Italic, 15],
   VertexSize -> 0,
   VertexStyle -> Directive[EdgeForm[], White]
   ]
  ]

If you use the old version, you will not obtained the expected results here:

arrow[dash_: {}, start_: 2, stop_: 2] := ({
    Black,
    Dashing[dash],
    Arrowheads[0.05],
    Arrow[#, {start, stop}]
    } &)
vertex = {
    {Subscript["A", 1], {0, 10}},
    {"A", {10, 10}},
    {Subscript["A", 2], {20, 10}},
    {"C", {10, 0}}
};
edge = {
    {2 \[DirectedEdge] 1, Placed[Subscript["\[Pi]", 1], {.5, {.5, -.2}}], arrow[]},
    {2 \[DirectedEdge] 3, Placed[Subscript["\[Pi]", 2], {.5, {.5, -.2}}], arrow[]},
    {4 \[DirectedEdge] 2, Placed["p", {.5, {-1.2, -.5}}], arrow[{0.02}, 1, 1]}, 
    {4 \[DirectedEdge] 1, Placed[Subscript["p", 1], {.5, {2, 1.2}}], arrow[]},
    {4 \[DirectedEdge] 3, Placed[Subscript["p", 2], {.5, {-1.2, 1.2}}], arrow[]}
};
graph = PlotDiagram[
    vertex,
    edge,
    AspectRatio -> 1/GoldenRatio,
    ImageSize -> 4*72,
    ImagePadding -> {{15, 15}, {5, 20}}
]

If you see this abomination then you are still using my first shameful function.

Instead by using the fixed version you can obtain the desired figure:

Notice the inclusion of the arrow function so that we can specify a level of dash, and then values to specify where the arrow starts and stops. This is seen in the specification for the edge from 4 to 2.

Answer 3

I don't like the new Graph functionality, but in your case it might be easier to use for label styling etc.

ef1[el_, ___] := Arrow[el, 0.1]
vertexLabels = 
MapIndexed[#2[[1]] -> 
 Placed[Style[#, Opacity[1], Background -> White], {1/2, 
   1/2}] &, {F[X], F[Y], G[Y], G[X]}];
Graph[{Property[1 \[DirectedEdge] 2, EdgeLabels -> F[f]], 
       Property[2 \[DirectedEdge] 3, EdgeLabels -> ηγ], 
       Property[1 \[DirectedEdge] 4, EdgeLabels -> ηx], 
       Property[4 \[DirectedEdge] 3, EdgeLabels -> G[f]]}, 
    VertexLabels -> vertexLabels,
    ImagePadding -> Scaled[.1], 
    VertexSize -> 0,
    VertexLabelStyle -> Directive[Italic, 20], 
    EdgeLabelStyle -> Directive[Italic, 20],
    EdgeStyle -> Black, 
    EdgeShapeFunction -> ef1,
    VertexStyle -> None, GraphLayout -> "SpringEmbedding" (*Thanx Vitaliy*)]