Graph symmetries

Well, after a couple of false starts, I think I have now succeeded in putting a working release of Haskell for Maths on Hackage - v0.1.3 is here.

So, as promised, we can get back to symmetries of graphs.

First a quick recap:
Graphs are represented as G vs es, where vs is a list of vertices and es is a list of edges, where an edge is a two-element list of vertices. For example, the cyclic graph c 5 (the pentagon - the picture on the left below):

> c 5
G [1,2,3,4,5] [[1,2],[1,5],[2,3],[3,4],[4,5]]

Using cycle notation, we can think of permutations dynamically as acting on the vertices or edges of a graph.

> 2 .^ p [[2,5],[3,4]]
5
> [2,3] -^ p [[2,5],[3,4]]
[4,5]

The "p" function constructs a permutation from a list of cycles. p [[2,5],[3,4]] is the reflection of c 5 in the vertical axis, shown in the middle below, which swaps the 2 and 5 positions, and the 3 and 4 positions. v .^ g represents the action of a permutation g on a vertex v. e -^ g represents the induced action of g on an edge e. (An edge just moves where its two endpoints move.)

We say that the reflection p [[2,5],[3,4]] is a symmetry of the graph, because the graph is the same after as it was before. On the other hand, it should be clear from the picture on the right that the permutation p [[1,2]], which swaps the 1 and 2 positions, is not a symmetry:

> [2,3] -^ p [[1,2]]
[1,3]

It moves the [2,3] edge to [1,3], which was not present as an edge in the original c 5.

Here's the code to test whether a permutation h is a symmetry ("automorphism") of a given graph:

module Math.Combinatorics.GraphAuts where

import qualified Data.Set as S

...

isGraphAut (G vs es) h = all (`S.member` es') [e -^ h | e <- es]
   where es' = S.fromList es 

(We use Data.Set for efficiency on large graphs.)

Next we would like code to find all symmetries/automorphisms of a graph. Here is a first attempt:

graphAuts1 (G vs es) = dfs [] vs vs where
   dfs xys (x:xs) ys =
       concat [dfs ((x,y):xys) xs (L.delete y ys) | y <- ys, isCompatible (x,y) xys]
   dfs xys [] [] = [fromPairs xys]
   isCompatible (x,y) xys =
       and [([x',x] `S.member` es') == (L.sort [y,y'] `S.member` es') | (x',y') <- xys]
   es' = S.fromList es 

We use depth-first search to try build up a list of pairs (x,y), which will represent a permutation which takes each x to the corresponding y. Whenever we add a new pair, we check whether it is compatible with what we have so far - specifically, that whenever {x,x'} is an edge (respectively non-edge) in the graph, then so is {y,y'}, its image after being acted on by the permutation.

We will develop a far more efficient algorithm in due course, but this is sufficient for small graphs. Let's try it out:

> mapM_ print $ graphAuts1 $ c 5
[]
[[2,5],[3,4]]
[[1,2],[3,5]]
[[1,2,3,4,5]]
[[1,3],[4,5]]
[[1,3,5,2,4]]
[[1,4],[2,3]]
[[1,4,2,5,3]]
[[1,5,4,3,2]]
[[1,5],[2,4]]

First, we have the identity permutation, which leaves everything where it is. We also have five permutations like [[2,5],[3,4]], which swap two pairs of positions - these are the five reflections, in the axes joining a vertex to the midpoint of the opposite edge. That leaves four more.
[[1,2,3,4,5]] is the cycle that takes 1 to 2, 2 to 3, 3 to 4, 4 to 5, and 5 to 1. In other words, it's a clockwise 72 degree rotation of the pentagon (except that of course graphs aren't really rigid objects in space - but you get the idea). The other three similar elements are the 144, 216 and 288 degree rotations.

That's it for now. Coming soon: a more efficient algorithm for finding graph automorphisms, and some graphs with interesting automorphism groups.