(* ::Package:: *)

(*Copyright (C) 2011 Adam Lelkes *)
BeginPackage["Groups`"]

CyclicGroupQ::usage="CyclicGroupQ[G] gives True if the permutation group G is cyclic, False otherwise"
AbelianGroupQ::usage="AbelianGroupQ[G] gives True if G is abelian, false otherwise"
ElementaryAbelianGroupQ::usage="ElementaryAbelianGroupQ[G] gives True if G is an elementary abelian p-group, False otherwise"
TransitivePermutationGroupQ::usage="TransitivePermutationGroupQ[G] gives True if G is a transitive permutation group, False otherwise"
DirectProduct::usage="DirectProduct[G,H] returns the direct product of permutation groups G and H"
QuaternionGroup::usage="QuaternionGroup[] returns a permutation group representation of the quaternion group Q"
GroupIntesection::usage="GroupIntersection[G,H] returns the intersection of the permutation groups G and H"
GroupSubsetCentralizer::usage="GroupSubsetCentralizer[G,X] returns the centralizer of X in G, where X is a subset of G"
MaximalAbelianSubgroupQ::usage="MaximalAbelianSubgroupQ[G,H] gives True if H is a maximal abelian subgroup of G, False otherwise"
DerivedSubgroup::usage="DerivedSubgroup[G] returns the derived subgroup of G"
CommutatorSubgroup::usage="CommutatorSubgroup[G,H] returns the commutator subgroup [G,H]"
PerfectGroupQ::usage="PerfectGroupQ[G] gives True if G is a perfect group, False otherwise"
GroupCenter::usage="GroupCenter[G] returns the center of the permutation group G"
LowerCentralSeries::usage="LowerCentralSeries[G] returns the lower central series of G"
NilpotentGroupQ::usage="NilpotentGroupQ[G] gives True if the permutation group G is nilpotent, False otherwise"
NilpotencyClass::usage="NilpotencyClass[G] returns the nilpotency class of the nilpotent permutation group G"
DerivedSeries::usage="DerivedSeries[G] returns the derived series of the permutation group G"
SolvableGroupQ::usage="SolvableGroupQ[G] returns True if G is a solvable permutation group, False otherwise"
DerivedLength::usage="DerivedLength[G] returns the derived length of the solvable permutation group G"
NormalClosure::usage="NormalClosure[G,X] returns the normal closure of X in the permutation group G, where X is either a subsert of elements of G or a subgroup of G"
NormalSubgroupQ::usage="NormalSubgroupQ[G,N] gives True if N is a normal subgroup of G, False otherwise"
CAGroupQ::usage="CAGroupQ[G] gives True if G is a CA-group, and False otherwise"
CommutingGraph::usage="CommutingGraph[G] returns the commuting graph of G"
NoncommutingGraph::usage="NoncommutingGraph[G] returns the noncommuting graph of G"

Begin["`Private`"]
CyclicGroupQ[G_]:=MemberQ[GroupOrder[PermutationGroup[{#}]]&/@GroupElements[G],GroupOrder[G]](*slow/brute force*)

AbelianGroupQ[G_]:=Not@MemberQ[PermutationProduct[#[[1]],#[[2]]]==PermutationProduct[#[[2]],#[[1]]]&/@Subsets[GroupGenerators[G],{2}],False]

ElementaryAbelianGroupQ[G_/;Not[AbelianGroup[G]]]:=False
ElementaryAbelianGroupQ[G_/;Not[PrimePowerQ[GroupOrder[G]]]]:=False
ElementaryAbelianGroupQ[G_/;And[AbelianGroupQ[G],PrimePowerQ[GroupOrder[G]]]]:=PrimeQ[Max[PermutationOrder/@GroupGenerators[G]]]

TransitivePermutationGroupQ[G_]:=Length[GroupOrbits[G, DeleteDuplicates[Flatten[PermutationSupport/@GroupGenerators[G]]]]]==1

ShiftSupportOfPermutation[p_/;PermutationCyclesQ[p],n_]:=PermutationProduct[InversePermutation[PermutationProduct@@(Cycles[{{#,#+n}}]&/@PermutationSupport[p])], p,PermutationProduct@@(Cycles[{{#,#+n}}]&/@PermutationSupport[p])]

DirectProduct[G_,H_]:=PermutationGroup[Join[GroupGenerators[G],ShiftSupportOfPermutation[#,Max[PermutationMax/@Join[GroupGenerators[G],GroupGenerators[H]]]]&/@GroupGenerators[H]]]

QuaternionGroup[]:=PermutationGroup[{Cycles[{{1,2,6,3},{4,8,5,7}}],Cycles[{{1,4,6,5},{2,7,3,8}}]}]

GroupIntersection[G_,H_]:=PermutationGroup[Intersection[GroupElements[G],GroupElements[H]]](*slow*)

GroupSubsetCentralizer[G_,X_]:=Fold[GroupIntersection,G,GroupCentralizer[G,#]&/@X]

MaximalAbelianSubgroupQ[G_,H_]:=GroupOrder[GroupSubsetCentralizer[G,Drop[GroupElements[H],1]]]==GroupOrder[H]

DerivedSubgroup[G_]:=NormalClosure[G,PermutationGroup[PermutationProduct[InversePermutation[#[[1]]],InversePermutation[#[[2]]],#[[1]],#[[2]]]&/@ Subsets[GroupGenerators[G],{2}]]]

(*CommutatorSubgroup[G_,H_]:=PermutationGroup[PermutationProduct[InversePermutation[#[[1]]],InversePermutation[#[[2]]],#[[1]],#[[2]]]&/@ Tuples[{GroupElements[G],GroupElements[H]}]](*slow/brute force*)*)
CommutatorSubgroup[G_,H_]:=NormalClosure[PermutationGroup[Join[GroupGenerators[G],GroupGenerators[H]]],PermutationGroup[PermutationProduct[InversePermutation[#[[1]]],InversePermutation[#[[2]]],#[[1]],#[[2]]]&/@ Tuples[{GroupGenerators[G],GroupGenerators[H]}]]]

PerfectGroupQ[G_]:=GroupOrder[G]==GroupOrder[DerivedSubgroup[G]]

GroupCenter[G_]:=Select[Drop[GroupElements[G],1],GroupOrder[GroupCentralizer[G,#]]==GroupOrder[G]&]//PermutationGroup

LowerCentralSeries[G_]:=Drop[FixedPointList[CommutatorSubgroup[#,G]&,G,SameTest->(GroupOrder[#1]==GroupOrder[#2]&)],-1]

NilpotentGroupQ[G_]:=GroupOrder[Last[LowerCentralSeries[G]]]==1

NilpotencyClass[G_/;NilpotentGroupQ[G]]:=Length[LowerCentralSeries[G]]

DerivedSeries[G_]:=Drop[FixedPointList[DerivedSubgroup,G,SameTest->(GroupOrder[#1]==GroupOrder[#2]&)],-1]

SolvableGroupQ[G_/;EvenQ[GroupOrder[G]]]:=GroupOrder[Last[DerivedSeries[G]]]==1
SolvableGroupQ[G_/;OddQ[GroupOrder[G]]]:=True (*Feit-Thompson theorem*)

DerivedLength[G_/;SolvableGroupQ[G]]:=Length[DerivedSeries[G]]

ConjugatePermutation[g_,x_]:=PermutationProduct[InversePermutation[x],g,x]

NormalClosure[G_,X_List]:=PermutationGroup[ConjugatePermutation[#[[1]],#[[2]]]&/@Tuples[{X,Prepend[GroupGenerators[G],Cycles[{{}}]]}]]
NormalClosure[G_,X:Except[List]]:=NormalClosure[G,GroupElements[X]]

NormalSubgroupQ[G_,N_]:=GroupOrder[NormalClosure[G,N]]==GroupOrder[N]

CAGroupQ[G_]:=Not[MemberQ[AbelianGroupQ/@(GroupCentralizer[G,#]&/@Complement[GroupElements[G],GroupElements[GroupCenter[G]]]),False]]

CommutingGraph[G_,opts:OptionsPattern[]]:=Graph[Complement[GroupElements[G],GroupElements[GroupCenter[G]]],#[[1]]\[UndirectedEdge]#[[2]]&/@Select[Subsets[Complement[GroupElements[G],GroupElements[GroupCenter[G]]],{2}],PermutationProduct[#[[1]],#[[2]]]==PermutationProduct[#[[2]],#[[1]]]&],opts]

NoncommutingGraph[G_,opts:OptionsPattern[]]:=GraphComplement[CommutingGraph[G],opts]

End[]
EndPackage[]
