• API
• FAQ
• Tools
• Archive
SHARE
TWEET # Find group isomorphisms in Mathematica lavery3  Jan 1st, 2015 (edited) 376 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. findGroupIsomorphisms[
2.   group1_,
3.   group2_,
4.   max_: \[Infinity]
5.   ] :=
6.  Module[{ng1, ng2, reverse, g1, g2, order, gs1, go1, gm1, gm2,
7.    os1, os2, inng1, abelianQ, targets, isomorphisms, w1,
8.    mt1, \[CurlyPhi]m1, \[CurlyPhi], homomorphismQ, t, ts},
9.   (*
10.    * Choose the domain group with fewest generators
11.    *)
12.   If[GroupOrder[group1] != GroupOrder[group2],
13.    Return[{}];
14.    ];
15.   {ng1, ng2} = Length[GroupGenerators[#]] & /@ {group1, group2};
16.   reverse = ng2 < ng1;
17.   If[reverse,
18.    {g1, g2} = {group2, group1};
19.    {ng1, ng2} = {ng2, ng1},
20.    {g1, g2} = {group1, group2}
21.    ];
22.   (*
23.    * Do some quick checks for isomorphism
24.    *)
25.   order = GroupOrder[g1];
26.   {gm1, gm2} = GroupElements /@ {g1, g2};
27.   {os1, os2} = Map[PermutationOrder, {gm1, gm2}, {2}];
28.   If[Sort[Tally[os1]] != Sort[Tally[os2]],
29.    Return[{}]
30.    ];
31.   (*
32.    * Pick possible targets in g2
33.    *)
34.   gs1 = GroupGenerators[g1];
35.   go1 = PermutationOrder /@ gs1;
36.   targets = Table[
38.     {n, go1}
39.     ];
40.   targets = Tuples[targets];
41.   (*
42.    * List the inner automorphisms
43.    *)
44.   inng1 = Outer[
45.     GroupElementPosition[
46.       g1, #1\[PermutationProduct]#2\[PermutationProduct]\
47. InversePermutation[#1]] &,
48.     gm1, gs1
49.     ];
50.   inng1 = Union[inng1];
51.   abelianQ = Length[inng1] == 1;
52.   (*
53.    *
54.   Here I should do something much more efficient for abelian groups...
55. \
56.    *)
57.   (* Stub *)
58.   (*
59.    *
60.   Test every possible mapping of the generators
61.    *)
62.   w1 = GroupElementToWord[g1, #] & /@ gm1;
63.   mt1 = GroupMultiplicationTable[g1];
64.   isomorphisms = {};
65.   While[targets =!= {},
66.    t = targets[[-1]]; targets = Drop[targets, -1];
67.    \[CurlyPhi] = With[{t = t},
68.      Function[i, GroupElementFromWord[PermutationGroup[t], w1[[i]]]]
69.      ];
70.    ts = Map[\[CurlyPhi], inng1, {2}];
71.    targets = Complement[targets, ts];
72.    If[GroupOrder[PermutationGroup[t]] != order,
73.     Continue[]
74.     ];
75.    \[CurlyPhi]m1 =
76.     GroupElementFromWord[PermutationGroup[t], #] & /@ w1;
77.    homomorphismQ =
78.     Map[\[CurlyPhi], mt1, {2}] ==
79.      Outer[PermutationProduct, \[CurlyPhi]m1, \[CurlyPhi]m1];
80.    If[homomorphismQ,
81.     (*
82.      * We found some isomorphisms!
83.      *)
84.     isomorphisms = Join[isomorphisms, ts]
85.     ];
86.    If[Length[isomorphisms] >= max,
87.     Break[]
88.     ]
89.    ];
90.   (*
91.    * Return the isomorphisms as rule lists
92.    *)
93.   isomorphisms =
94.    Take[isomorphisms, Min[max, Length[isomorphisms]]];
95.   isomorphisms = {gs1, #} & /@ isomorphisms;
96.   If[reverse, isomorphisms = Reverse /@ isomorphisms];
97.   Apply[Rule, Transpose /@ isomorphisms, {2}]
98.   ]
99.
100.
101. isomorphicGroupsQ[group1_, group2_] :=
102.  MatchQ[findGroupIsomorphisms[group1, group2, 1], {_}]
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.
Top