# Finding an invariant under Group operations

Context: I am trying to answer this question about solving the peg solitaire, and I already posted as an answer some code devised for treating the board as a graph.

The algorithm in Mathematica for solving the problem I implemented there (please don't care to read the code) is a first try brute force approach which I want to refine.

One way for doing this is aborting the calculation of the branches already explored, and those symmetrically equivalent.

AFAIK, the symmetry of the problem is represented in the Dihedral D4 group.

So my problem: I have a vector with the occupancy state of the board

$S =\{o_1, ...,o_{33}\}$ $(o_i \in \{ True, False \})$

and I want to find a function that when applied to an occupancy state vector returns the same Real number for all eight symmetric states (and of course bijective, returning a different value for any other input).

Any suggestions?

Edit

For example, the following program in Mathematica calculates a bijective bilinear invariant under D4 for the easy board:

       x1

x4        x2

x3


>

bl = Times @@@ Union[Sort /@ Tuples[{x1, x2, x3, x4}, 2]];
coef = Array[a, Length@bl];

(* This is the first nuance, I've to write down the one member
for each symmetry class*)
base = {{1, 0, 0, 0}, {1, 1, 0, 0}, {1, 0, 1, 0},
{1, 1, 1, 0}, {1, 1, 1, 1}, {0, 0, 0, 0}};

f[{x1_, x2_, x3_, x4_}] := Evaluate[coef.bl];

(*This is the second problem: I calculate all members of each
class (in this case by rotations)*)
g[x_] := Table[RotateRight[x, i], {i, 4}];

fi = FindInstance[
Unequal @@ (f /@ base) &&
And @@ Equal @@@ (f /@ g /@ base)
, coef, Integers];

-f[{x1, x2, x3, x4}] /. fi[]


And the result is

$f(x_1,x_2,x_3,x_4) = x_1^2 + x_1 x_2 + x_2^2 + x_2 x_3 + x_3^2 + x_1 x_4 + x_3 x_4 + x_4^2$

f value .......... Equivalent boards I am sure there must be a better way ...

• The easiest thing in practice is probably just to tabulate the 8 different permutations of the indices once and for all using a 7×7 array and coordinate manipulation. – Henning Makholm Jun 13 '12 at 22:35
• @HenningMakholm OK! If nobody comes up with a more elegant solution I'll go that path – Dr. belisarius Jun 13 '12 at 22:40
• You might also consider relabeling vertices such that those indistinguishable up to symmetry are indexed by numbers which are either congruent mod 9 or mod 6. – user17794 Jun 13 '12 at 22:56
• @TimDuff Could you explain that a bit more, please? – Dr. belisarius Jun 14 '12 at 0:21

## 1 Answer

A symmetry group acts on a set of data structures (the occupancy vectors). The question asks for a procedure to create group-invariant hashes of those data structures. Here is a very general way, requiring only a presentation of the group and explicit definitions of the actions of its generators.

In mathematical notation, the data structures form a set $S$, a finite group $G$ acts on it (notation: any $g\in G$ sends $s\in S$ to $s^g$), and a hash function is an injection $h:S\to\mathbb{N}$. To construct a $G$-invariant function, one usually averages (or sums) over the group. In this application it is computationally a little simpler to minimize over the group: that is, define

$$h^G: S\to\mathbb{N},$$ $$h^G(s) = \min\{h(s^g) | g\in G\}.$$

This is obviously $G$-invariant. It works well for smallish groups because it requires computing $h$ for up to $|G|$ elements of $S$.

The rest is computational details, pseudocoded in Mathematica.

Let's begin by creating a way to address cells on the board--a way on which the effect of the group action is easy to compute--and storing an array of addresses of all the board cells. Row and column coordinates are an obvious way:

n = 7;  k = 2; (* n by n square without the four k by k corners *)
validAddress[address[i_, j_]] :=
(k < i <= n - k && 1 <= j <= n) || (k < j <= n - k && 1 <= i <= n);
board = Select[Flatten[Outer[address, Range[n], Range[n]]], validAddress];


It is convenient to define the group action via generators. This is a Coxeter group, making it easy to find a pair of generators {alpha, beta} and relations:

apply[address[i_, j_], alpha] := address[n+1 - i, j];(* Horizontal reflection *)
apply[address[i_, j_], beta] := address[j, i];       (* Diagonal reflection *)
apply[a_address, g_List] := Fold[apply, a, g];       (* Group composition *)
group = FoldList[Append, {}, Riffle[ConstantArray[alpha, 4], beta]];


These addresses have to be associated with the indexes of cells within the board array. The group action will be pulled back to those indexes as permutations of $\{1,2,\ldots\}$, which I store in a variable action indexed by the group itself:

indexes = Table[board[[i]] -> i, {i, 1, Length[board]}];
action[g_] :=
action[g] = (apply[board[[#]], g] /. indexes) & /@ Range[Length[board]];


To hash an occupancy vector, it is natural to interpret it as a binary number. To form a hash invariant under the group action, we need a unique representative of the hashes of each orbit. A simple way to choose that representative is to use the one with the numerically smallest hash.

hash[occupancy_List] /; Length[occupancy] == Length[board] :=
Min[FromDigits[occupancy[[action[#]]], 2] & /@ group];


For example:

hash[{0, 0, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 1, 1, 0,
1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 1, 1}]


produces $1315991027$, the smallest of $\{1315991027, 1795954175, 4084234697, 4953218462, 4972379519, 6969629924, 8547732521, 8578425260\}.$ (The fact that the eight elements of group produce eight distinct hashes proves they are distinct group elements, something that might not have been evident until now.)

The efficiency is OK:

Timing[hash /@ RandomInteger[{0, 1}, {10^4, Length[board]}];]


takes a half second (on one 3.2 GHz Xeon core).

• Wonderful and to-the-point. Thank you! – Dr. belisarius Jun 16 '12 at 19:20