Recently in this blog, we looked at the strong generating set (SGS) algorithm for permutation groups, and how we can use it to investigate the structure of groups. Last time, we saw how to partially "factor" intransitive groups, using the transitive constituent homomorphism. (Recall that by "factoring" a group G, we mean finding a proper normal subgroup K, and consequently also a quotient group G/K - which is equivalent to finding a proper homomorphism from G.) This time, I want to do the same for imprimitive groups. So, what is an imprimitive group?
Well, given a permutation group acting on a set X, it can happen that X consists of "blocks" Y1, Y2, ... of points which always "move together". That is, a subset Y of X is a block if for all g in G, Y^g (the image of Y under the action of g) is either equal to Y or disjoint from it. A full set of blocks (that is, blocks Y1, Y2, ... which are disjoint, and whose union is the whole of X) is called a block system.
For example, suppose that X is the vertices of the hexagon. The symmetry group of the hexagon is the dihedral group D12, generated by a rotation and a reflection:
> :load Math.Algebra.Group.Subquotients
> mapM_ print $ _D 12
[[1,2,3,4,5,6]]
[[1,6],[2,5],[3,4]]
A block system for the hexagon is shown below. The blocks are the pairs of opposite vertices. You can verify that they satisfy the definition of blocks: any symmetry must take a pair of opposite points either to itself, or to another pair disjoint from it.
A given group can have more than one block system. Here is another block system for the hexagon. The blocks are the two equilateral triangles formed by the vertices.
There are also the trivial block systems, consisting of either just one block containing all the points, or a block for each point. From now on, we will silently exclude these.
So, I was meant to be telling you what an imprimitive group is. Well, it's just a group which has a non-trivial block system. Conversely, a primitive group is one which has no non-trivial block system.
When we have an imprimitive group, we will be able to form a homomorphism - and hence factor the group - by considering the induced action of the group on the blocks. But I'm jumping ahead. First we need to write some Haskell code - to find block systems.
The idea is to write a function that, given a pair of points Y = {y1,y2} in X (or indeed any subset Y of X), can find the smallest block containing Y. The way it works is as follows. We start by supposing that each point is in a block of its own, except for the points in Y. We initialise a map, with the points in X as keys, and the blocks as values, where we represent a block by its least element.
Now, suppose that we currently think that the minimal block is Y = {y1,y2,...}. What we're going to do is work through the elements of Y, and work through the generators of G, trying to find a problem. So suppose that we have got as far as some element y of Y, and some generator g of G. We know that y is in the same block as y1, and what we have to check is that y^g is in the same block as y1^g. So we look up their representatives in the map, and check that they're the same. If they're not, then we need to merge the two classes. Here's the code (it's a little opaque, but it's basically doing what I just described).
minimalBlock gs ys@(y1:yt) = minimalBlock' p yt gs where
xs = foldl union [] $ map supp gs
p = M.fromList $ [(yi,y1) | yi <- ys] ++ [(x,x) | x <- xs \\ ys]
minimalBlock' p (q:qs) (h:hs) =
let r = p M.! q -- representative of class containing q
k = p M.! (q .^ h) -- rep of class (q^h)
l = p M.! (r .^ h) -- rep of class (r^h)
in if k /= l -- then we need to merge the classes
then let p' = M.map (\x -> if x == l then k else x) p
qs' = qs ++ [l]
in minimalBlock' p' (q:qs') hs
else minimalBlock' p (q:qs) hs
minimalBlock' p (q:qs) [] = minimalBlock' p qs gs
minimalBlock' p [] _ =
let reps = toListSet $ M.elems p
in L.sort [ filter (\x -> p M.! x == r) xs | r <- reps ]
Once we have this function, then finding the block systems is simple - just take each pair {x1,xi} from X, and find the minimal block containing it.
blockSystems gs
| isTransitive gs = toListSet $ filter (/= [x:xs]) $ map (minimalBlock gs) [ [x,x'] | x' <- xs ]
| otherwise = error "blockSystems: not transitive"
where x:xs = foldl union [] $ map supp gs
If we have an SGS for G, then we can do slightly better. For suppose that within the stabiliser Gx1, there is an element taking xi to xj. Then clearly xi and xj must be in the same minimal block. So in fact, we need only consider pairs {x1,xi}, with xi the minimal element of each orbit in Gx1. (Of course, the point is that if we have an SGS for G, then we can trivially list a set of generators for Gx1.)
blockSystemsSGS gs = toListSet $ filter (/= [x:xs]) $ map (minimalBlock gs) [ [x,x'] | x' <- rs ]
where x:xs = foldl union [] $ map supp gs
hs = filter (\g -> x < minsupp g) gs -- sgs for stabiliser Gx
os = orbits hs
rs = map head os ++ (xs \\ L.sort (concat os)) -- orbit representatives, including singleton cycles
Let's test it:
> mapM_ print $ blockSystems $ _D 12
[[1,3,5],[2,4,6]]
[[1,4],[2,5],[3,6]]Okay, so given a group, we can find its non-trivial block systems, if any. What next? Well, as I hinted earlier, this enables us to factor the group. For if there is a non-trivial block system, then the action of the group on the points induces a well-defined action on the blocks. This induced action gives us a homomorphism from our original group G, a subgroup of Sym(X), to another group H, a subgroup of Sym(B), where B is the set of blocks.
So as we did last time, we can find the kernel and image of the homomorphism, and thus factor the group. How do we do that?
Well, it's simple. In the following code, the function lr takes a group element acting on the points, and returns a group element acting on the blocks (in the Left side) and the points (in the Right side) in an Either union. If we do this to all the group generators, and then find an SGS, then as the Left blocks sort before the Right points, then the SGS will split neatly into two parts:
- The initial segment of the SGS will consist of elements which move the Left blocks. If we restrict their action to just the blocks, we will have an SGS for the image of the homomorphism, acting on the blocks.
- The final segment of the SGS will consist of elements which fix all the Left blocks. These elements move points but not blocks, so they form an SGS for the kernel of the homomorphism.
blockHomomorphism' gs bs = (ker,im) where
gs' = sgs $ map lr gs
lr g = fromPairs $ [(Left b, Left $ b -^ g) | b <- bs] ++ [(Right x, Right y) | (x,y) <- toPairs g]
ker = map unRight $ dropWhile (isLeft . minsupp) gs' -- stabiliser of the blocks
im = map restrictLeft $ takeWhile (isLeft . minsupp) gs' -- restriction to the action on blocks
blockHomomorphism gs bs
| bs == closure bs [(-^ g) | g <- gs] -- validity check on bs
= blockHomomorphism' gs bs
Let's try it out on our two block systems for the hexagon:
> blockHomomorphism (_D 12) [[1,4],[2,5],[3,6]]
([[[1,4],[2,5],[3,6]]],
[[[[1,4],[2,5],[3,6]]],[[[2,5],[3,6]]]])I've formatted the output for clarity. The first line is (an SGS for) the kernel, consisting of elements of D12 which permute points within the blocks, without permuting the blocks. In this case, the kernel is generated by the 180 degree rotation, which swaps the points within each pair. The second line is (an SGS for) the image, consisting of the induced action of D12 on the blocks. In this case, we have the full permutation group S3 acting on the three pairs of points.
> blockHomomorphism (_D 12) [[1,3,5],[2,4,6]]
([[[1,5,3],[2,6,4]],[[2,6],[3,5]]],
[[[[1,3,5],[2,4,6]]]])In this case the kernel is generated by a 120 degree rotation and a reflection, and consists of all group elements which send odd points to odd and even points to even, thus preserving the blocks. The image has only one non-trivial element, which just swaps the two blocks.
Armed with this new tool, let's have another look at Rubik's cube. Recall that we labelled the faces of the cube as follows:
Last time, we split the Rubik cube group into two homomorphic images - a group acting on just the corner faces, and a group acting on just the edge faces. Let's look for block systems in these groups:
> :load Math.Projects.Rubik
> let [cornerBlocks] = blockSystems imCornerFaces
> let [edgeBlocks] = blockSystems imEdgeFaces
> cornerBlocks
[[1,17,23],[3,19,41],[7,29,31],[9,33,47],[11,21,53],[13,43,51],[27,37,59],[39,49,57]]
> edgeBlocks
[[2,18],[4,26],[6,44],[8,32],[12,52],[14,22],[16,42],[24,56],[28,34],[36,48],[38,58],[46,54]]It's obvious really - in the corner group, we have a block system with blocks consisting of the three corner faces that belong to the same corner piece, and in the edge group, we have a block system with blocks consisting of the two edge faces that belong to the same edge piece. Furthermore, these are the only block systems.
So we can form the kernel and image under the block homomorphism:
> let (kerCornerBlocks,imCornerBlocks) = blockHomomorphism imCornerFaces cornerBlocks
> let (kerEdgeBlocks,imEdgeBlocks) = blockHomomorphism imEdgeFaces edgeBlocksIf we look at the sizes of these groups, the structure will be obvious:
> orderSGS kerCornerBlocks
2187
> orderSGS imCornerBlocks
40320These are 3^7, and 8! respectively. The kernel is the permutations of the corner faces which leave the corner blocks where they are. It turns out that whenever you twist one corner block, you must untwist another. So when you have decided what to do with seven corners, the eighth is determined - hence 3^7. For the image, we have eight blocks, and 8! permutations of them, so this must be the full symmetry group S8 - meaning that we can perform any rearrangement of the corner blocks that is desired.
> orderSGS kerEdgeBlocks
2048
> orderSGS imEdgeBlocks
479001600These are 2^11 and 12! respectively. For the kernel, whenever we flip one edge piece we must also flip another. So when we have decided what to do with eleven edges, the twelfth is determined - hence 2^11. For the image, we have twelve pieces, and 12! permutations of them, so we have the full symmetry group S12 on edge blocks.
That's it.
Incidentally, my references for this material are:
- Holt, Handbook of Computational Group Theory
- Seress, Permutation Group Algorithms
both of which are very good - but expensive.
These books, particularly the latter, go on to describe further algorithms that can be used to factor even transitive primitive groups, enabling us to arrive at a full decomposition of a group into simple groups. Unfortunately, the algorithms get a bit more complicated after this, and I haven't yet implemented the rest in HaskellForMaths.
