2
$\begingroup$

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!

$\endgroup$
  • $\begingroup$ i.e., you want to check if two groups (represented by their multiplication tables) are isomorphic? $\endgroup$ – J. M. will be back soon Apr 10 '18 at 5:17
  • $\begingroup$ Yes- thank you Sir, simply speaking - me needs help. $\endgroup$ – wonderich Apr 10 '18 at 5:22
1
$\begingroup$

In your example

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[]]]
$\endgroup$
  • $\begingroup$ @ Andrew, +1, thanks, what will be the output and minimal code in this toy model example? Thank you! - $\endgroup$ – wonderich Apr 10 '18 at 16:05
  • $\begingroup$ @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. $\endgroup$ – Andrew Apr 10 '18 at 17:30
  • $\begingroup$ @ 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? $\endgroup$ – wonderich Apr 12 '18 at 19:47
  • $\begingroup$ @ Andrew, this will be one example that big data makes the error message: mathematica.stackexchange.com/questions/170990 $\endgroup$ – wonderich Apr 12 '18 at 20:19
  • $\begingroup$ @wonderich for your first question I've edited the answer. As for the second idk an efficient algorithm. $\endgroup$ – Andrew Apr 12 '18 at 20:36

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.