# Relabeling and matching variables (in MultiplicationTable)

Suppose we have a set of data given here as the multiplication table of 8 elements labeled {1,2,3,4,9,10,11,12}: $$\begin{array}{cccccccc} 1 & 2 & 3 & 4 & 9 & 10 & 11 & 12 \\ 2 & 1 & 4 & 3 & 12 & 11 & 10 & 9 \\ 3 & 4 & 1 & 2 & 10 & 9 & 12 & 11 \\ 4 & 3 & 2 & 1 & 11 & 12 & 9 & 10 \\ 9 & 12 & 11 & 10 & 1 & 4 & 3 & 2 \\ 10 & 11 & 12 & 9 & 3 & 2 & 1 & 4 \\ 11 & 10 & 9 & 12 & 4 & 1 & 2 & 3 \\ 12 & 9 & 10 & 11 & 2 & 3 & 4 & 1 \\ \end{array}$$ and it seems that it matches to the MultiplicationTable {"DihedralGroup", 4}

FiniteGroupData[{"DihedralGroup", 4}, "MultiplicationTable"] // Grid


which outputs:

$$\begin{array}{cccccccc} 1 & 2 & 3 & 4 & 5 & 6 & 7 & 8 \\ 2 & 3 & 4 & 1 & 8 & 5 & 6 & 7 \\ 3 & 4 & 1 & 2 & 7 & 8 & 5 & 6 \\ 4 & 1 & 2 & 3 & 6 & 7 & 8 & 5 \\ 5 & 6 & 7 & 8 & 1 & 2 & 3 & 4 \\ 6 & 7 & 8 & 5 & 4 & 1 & 2 & 3 \\ 7 & 8 & 5 & 6 & 3 & 4 & 1 & 2 \\ 8 & 5 & 6 & 7 & 2 & 3 & 4 & 1 \\ \end{array}$$

question: Is there some smart algorithm to relabels the variables and check the MultiplicationTable match or does not match?

We can use these as a Test toy model example. Thanks the expert's reply!

• i.e., you want to check if two groups (represented by their multiplication tables) are isomorphic? – J. M. is in limbo Apr 10 '18 at 5:17
• Yes- thank you Sir, simply speaking - me needs help. – wonderich Apr 10 '18 at 5:22

A = {{1, 2, 3, 4, 9, 10, 11, 12}, {2, 1, 4, 3, 12, 11, 10, 9},
{3, 4, 1, 2, 10, 9, 12, 11}, {4, 3, 2, 1, 11, 12, 9, 10},
{9, 12, 11, 10, 1, 4, 3, 2}, {10, 11, 12, 9, 3, 2, 1, 4},
{11, 10, 9, 12, 4, 1, 2, 3}, {12, 9, 10, 11, 2, 3, 4, 1}};
B = FiniteGroupData[{"DihedralGroup", 4}, "MultiplicationTable"];


Direct search of would be matrices be the same up to renaming (using all the permutations):

n = Length@A;
perms = Permutations[Range@n];
FlB = Flatten[B];
subst[list_] := Table[A[[list[[i]], list[[j]]]], {i, n}, {j, n}]
lnght[A$_] := Length@Union@Transpose@{Flatten[A$], FlB}
Min[lnght[subst[#]] & /@ perms]


gives $8$, so the two groups are isomorphic indeed.

This produces the first isomorphism encountered:

For[k = 1, k <= Length@perms, k++,
If[lnght[subst[perms[[k]]]] == n,
Print[Union@Transpose@{Flatten[subst@perms[[k]]], FlB}]; Break[]]]


And this gives all isomorphisms:

For[k = 1, k <= Length@perms, k++,
If[lnght[subst[perms[[k]]]] == n,
Print[Union@Transpose@{Flatten[subst@perms[[k]]], FlB}]; Break[]]]

• @ Andrew, +1, thanks, what will be the output and minimal code in this toy model example? Thank you! - – wonderich Apr 10 '18 at 16:05
• @wonderich the previous solution didn't take into account the possibility of another elements order. Unfortunately the new answer is just checking all the variants. – Andrew Apr 10 '18 at 17:30
• @ Andrew, however, do you have a way to suggest the map between two tables, like {1 to 1}, {2 to ...}, {3 to ...}? From a more systematic output? – wonderich Apr 12 '18 at 19:47
• @ Andrew, this will be one example that big data makes the error message: mathematica.stackexchange.com/questions/170990 – wonderich Apr 12 '18 at 20:19
• @wonderich for your first question I've edited the answer. As for the second idk an efficient algorithm. – Andrew Apr 12 '18 at 20:36