9
$\begingroup$

MMA has some support for group theory, allowing representation of any finite group as a subgroup of $S_n$. It does not seem to have a function for testing whether two finite groups are isomorphic. Is there a straightforward (and computationally reasonable) way,

  1. To test whether two groups are isomorphic?

  2. To find an explicit isomorphism between two groups?

  3. To find all isomorphisms from a group to itself, i.e. construct the automorphism group?

Thanks.

EDIT: Here's an example of the problem. 

(Local) In[56]:= d8a = DihedralGroup[4] (Local) Out[56]= DihedralGroup[4] (Local) In[57]:= GroupGenerators[d8a] (Local) Out[57]= {Cycles[{{1, 4}, {2, 3}}], Cycles[{{1, 2, 3, 4}}]} (Local) In[59]:= d8b = PermutationGroup[GroupMultiplicationTable[d8a]] (Local) Out[59]= PermutationGroup[{{1, 2, 3, 4, 5, 6, 7, 8}, {2, 1, 4, 3, 6, 5, 8, 7}, {3, 7, 1, 5, 4, 8, 2, 6}, {4, 8, 2, 6, 3, 7, 1, 5}, {5, 6, 7, 8, 1, 2, 3, 4}, {6, 5, 8, 7, 2, 1, 4, 3}, {7, 3, 5, 1, 8, 4, 6, 2}, {8, 4, 6, 2, 7, 3, 5, 1}}]

d8b is, by construction, isomorphic to d8a. Some quick checks:

Both groups have order 8:

(Local) In[61]:= GroupOrder /@ {d8a, d8b} (Local) Out[61]= {8, 8}

Each group has 2 elements of order 4, 5 of order 2, and 1 of order 1:

(Local) In[69]:= Tally /@ (PermutationOrder /@ # & /@ GroupElements /@ {d8a, d8b}) (Local) Out[69]= {{{1, 1}, {2, 5}, {4, 2}}, {{1, 1}, {2, 5}, {4, 2}}}

However, they look completely different. d8a is represented as a subgroup of $S_4$ with two generators. d8b is a subgroup of $S_8$ with 8 generators. Their group stabilizer chains don't resemble each other. If I was given these two groups without knowing where they came from, how would I find out that they're isomorphic?

Improve this question
$\endgroup$

2 Answers 2

Reset to default
12
$\begingroup$

All right, here is a solution: Find group isomorphisms in Mathematica. It's not pretty, but it's practical for groups of order up to about 100. It takes 30 ms to find out that $\text{d8a}\cong\text{d8b}$, and 43 ms to produce the automorphism group on my Mac mini. It finds an isomorphism from $S_5\to S_5$ (order 120) in 7 s. Producing all of $Aut(S_5)$ takes 27 s, since it has to test all possible mappings rather than stopping at the first success. It manages $S_6$ (order 720, $|\text{Aut}(S_6)|=1440$) in a little under 4 hours. 

findGroupIsomorphisms[ group1_, group2_, max_: ∞ ] := Module[{ng1, ng2, reverse, g1, g2, order, gs1, go1, gm1, gm2, os1, os2, inng1, abelianQ, targets, isomorphisms, w1, mt1, φm1, φ, homomorphismQ, t, ts}, (* * Choose the domain group with fewest generators *) If[GroupOrder[group1] != GroupOrder[group2], Return[{}]; ]; {ng1, ng2} = Length[GroupGenerators[#]] & /@ {group1, group2}; reverse = ng2 < ng1; If[reverse, {g1, g2} = {group2, group1}; {ng1, ng2} = {ng2, ng1}, {g1, g2} = {group1, group2} ]; (* * Do some quick checks for isomorphism *) order = GroupOrder[g1]; {gm1, gm2} = GroupElements /@ {g1, g2}; {os1, os2} = Map[PermutationOrder, {gm1, gm2}, {2}]; If[Sort[Tally[os1]] != Sort[Tally[os2]], Return[{}] ]; (* * Pick possible targets in g2 *) gs1 = GroupGenerators[g1]; go1 = PermutationOrder /@ gs1; targets = Table[ Pick[gm2, Thread[os2 == n]], {n, go1} ]; targets = Tuples[targets]; (* * List the inner automorphisms *) inng1 = Outer[ GroupElementPosition[ g1, #1\[PermutationProduct]#2\[PermutationProduct]\ InversePermutation[#1]] &, gm1, gs1 ]; inng1 = Union[inng1]; abelianQ = Length[inng1] == 1; (* * Here I should do something much more efficient for abelian groups... *) (* Stub *) (* * Test every possible mapping of the generators *) w1 = GroupElementToWord[g1, #] & /@ gm1; mt1 = GroupMultiplicationTable[g1]; isomorphisms = {}; While[targets =!= {}, t = targets[[-1]]; targets = Drop[targets, -1]; φ = With[{t = t}, Function[i, GroupElementFromWord[PermutationGroup[t], w1[[i]]]] ]; ts = Map[φ, inng1, {2}]; targets = Complement[targets, ts]; If[GroupOrder[PermutationGroup[t]] != order, Continue[] ]; φm1 = GroupElementFromWord[PermutationGroup[t], #] & /@ w1; homomorphismQ = Map[φ, mt1, {2}] == Outer[PermutationProduct, φm1, φm1]; If[homomorphismQ, (* * We found some isomorphisms! *) isomorphisms = Join[isomorphisms, ts] ]; If[Length[isomorphisms] >= max, Break[] ] ]; (* * Return the isomorphisms as rule lists *) isomorphisms = Take[isomorphisms, Min[max, Length[isomorphisms]]]; isomorphisms = {gs1, #} & /@ isomorphisms; If[reverse, isomorphisms = Reverse /@ isomorphisms]; Apply[Rule, Transpose /@ isomorphisms, {2}] ] isomorphicGroupsQ[group1_, group2_] := MatchQ[findGroupIsomorphisms[group1, group2, 1], {_}]
Improve this answer
$\endgroup$
1
  • 1
    $\begingroup$ Thank you for the code! I embedded it in your answer to make sure it won't get lost. I'm not sure about pastebin.com's policy on retaining pastes. $\endgroup$ Commented Oct 17, 2015 at 16:18
8
$\begingroup$

For future searchers who come across this question, there is now a function FindGroupIsomorphism in the Wolfram Function Repository.

Improve this answer
$\endgroup$
3
  • $\begingroup$ I get a 'Failed to load resource function' error in wolfram cloud... any tips/ tricks? $\endgroup$ Commented Oct 2 at 6:41
  • $\begingroup$ Now it works...? Thanks!? $\endgroup$ Commented Oct 2 at 8:37
  • $\begingroup$ It seems to me that FindGroupIsomorphism has an issue with d8b = PermutationGroup[GroupMultiplicationTable[d8a]] and instead needs d8b = PermutationGroup[GroupElements[PermutationGroup[GroupMultiplicationTable[d8a]]]] to evaluate... $\endgroup$ Commented Oct 2 at 8:39

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.