Encontrar un invariante bajo el Grupo de operaciones

Question

Contexto: estoy tratando de responder esta pregunta acerca de la resolución de la peg solitaire, y ya he publicado como respuesta el código ideado para el tratamiento de la junta

como un gráfico.

El algoritmo en Mathematica para resolver el problema que lleva a cabo (por favor, no me interesa leer el código) es un primer intento aproximación de fuerza bruta que yo quiero matizar.

Una forma para hacer esto es la de anular el cálculo de las ramas ya explorados, y los simétricamente equivalente.

AFAIK, la simetría del problema se representa en el Diedro D4 grupo.

Así que mi problema: tengo un vector con el estado de ocupación de la junta

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

y quiero encontrar una función que, cuando se aplica a la ocupación del estado de vector devuelve el mismo número Real para todos los ocho simétrica de los estados (y por supuesto bijective, devolver un valor diferente para cualquier otra entrada).

Alguna sugerencia?

Editar

Por ejemplo, el siguiente programa en Mathematica calcula un bijective bilineal invariantes bajo D4 para la fácil:

       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[[1]]

Y el resultado es

$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$

---

valor de f .......... Equivalente tablas

Estoy seguro de que debe haber una mejor manera ...

Answer 1

Un grupo de simetría actúa sobre un conjunto de estructuras de datos (la ocupación de los vectores). La pregunta se pide un procedimiento para crear un grupo de invariantes hashes de las estructuras de datos. Aquí está una manera muy general, que requieren sólo una presentación del grupo y definiciones explícitas de las acciones de sus generadores.

En notación matemática, las estructuras de datos que forman un conjunto $S$, un grupo finito $G$ actúa en él (notación: cualquier $g\in G$ envía $s\in S$$s^g$), y una función de hash es una inyección de $h:S\to\mathbb{N}$. Para la construcción de una $G$-invariante de la función, por lo general los promedios (o cantidades) sobre el grupo. En esta aplicación, resulta un poco más sencillo para minimizar sobre el grupo: es decir, definir

$$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\}.$ (El hecho de que los ocho elementos de la group producir ocho distintos hash demuestra que son distintos de los elementos del grupo, algo que no podría haber sido evidente hasta ahora.)

La eficiencia está en ACEPTAR:

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

toma la mitad de un segundo (en un 3.2 GHz Xeon core).