Function Repository Resource:

SubsetGroup

Source Notebook

Compute a group induced by a permutation group on k-subsets

Contributed by: Wolfram Staff (original content by Sriram V. Pemmaraju and Steven S. Skiena)

ResourceFunction["SubsetGroup"][g,s]

returns the group induced by a group g of n-permutations acting on the set s of k-subsets of {1,n}.

ResourceFunction["SubsetGroup"][g,s,type]

treats s as a set of k-subsets or k-tuples, depending on type.

Details and Options

The group g can be specified as an abstract group or a permutation List {perm1,perm2,}.
ResourceFunction["SubsetGroup"] returns a PermutationGroup object.
type can be either "Ordered" or "Unordered".
The default value of type is "Unordered".
ResourceFunction["SubsetGroup"][g,s,"Ordered"] treats s as a set of k-tuples.

Examples

Basic Examples (2) 

The permutation group induced on the set of all 2-subsets of {1,2,3} by the cyclic group C3:

In[1]:=
s = Subsets[Range[3], {2}]
Out[1]=
In[2]:=
ResourceFunction["SubsetGroup"][CyclicGroup[3], s]
Out[2]=

The permutation group induced on the set of all 2-subsets of {1,2,3,4} by the cyclic group C4:

In[3]:=
s = Subsets[Range[4], {2}]
Out[3]=
In[4]:=
ResourceFunction["SubsetGroup"][CyclicGroup[4], s]
Out[4]=

Scope (3) 

Specify the group as a permutation List:

In[5]:=
ResourceFunction[
 "SubsetGroup"][{{1, 2, 3, 4}, {2, 3, 4, 1}, {3, 4, 1, 2}, {4, 1, 2, 3}}, Subsets[Range[4], {2}]]
Out[5]=

Or an abstract group:

In[6]:=
ResourceFunction["SubsetGroup"][SymmetricGroup[3], Subsets[Range[3], {2}]]
Out[6]=

The permutation group induced on the set of ordered 2-subsets by C4:

In[7]:=
DeleteCases[Tuples[Range[4], {2}], {x_, x_}]
Out[7]=
In[8]:=
ResourceFunction["SubsetGroup"][CyclicGroup[4], %, "Ordered"]
Out[8]=

Applications (3) 

Permutation group on the edges of the 5-vertex wheel graph:

In[9]:=
g = WheelGraph[5]
Out[9]=
In[10]:=
ResourceFunction["SubsetGroup"][GraphAutomorphismGroup[g], List @@@ EdgeList[g]]
Out[10]=

The number of colorings of 4-node simple graphs using at most n colors (OEIS A063842):

In[11]:=
res = Module[{s, ei}, Table[Total[
     Table[CycleIndexPolynomial[
       ResourceFunction["SubsetGroup"][
        GraphData[{4, k}, "AutomorphismGroup"], ei = GraphData[{4, k}, "EdgeIndices"]], Array[s, Length[ei]], Length[ei]], {k, 1, 11}]] /. Table[s[i] -> n, {i, 1, 4}], {n, 0, 31}]]
Out[11]=

Count the number of distinct dice as orbit representatives of a permutation group induced by a group of symmetries acting on a set of faces of a cube:

In[12]:=
OrbitRepresentatives[g_, x_] := First /@ GroupOrbits[g, x]
In[13]:=
symmetries = {{2, 3, 4, 1, 6, 7, 8, 5}, {3, 4, 1, 2, 7, 8, 5, 6}, {4, 1, 2, 3, 8, 5, 6, 7}, {2, 8, 5, 3, 6, 4, 1, 7}, {8, 7, 6, 5, 4, 3,
     2, 1}, {7, 1, 4, 6, 3, 5, 8, 2}, {4, 3, 5, 6, 8, 7, 1, 2}, {6, 5,
     8, 7, 2, 1, 4, 3}, {7, 8, 2, 1, 3, 4, 6, 5}, {2, 1, 7, 8, 6, 5, 3, 4}, {5, 6, 4, 3, 1, 2, 8, 7}, {7, 6, 5, 8, 3, 2, 1, 4}, {5, 8, 7, 6, 1, 4, 3, 2}, {4, 6, 7, 1, 8, 2, 3, 5}, {5, 3, 2, 8, 1, 7, 6,
     4}, {1, 7, 8, 2, 5, 3, 4, 6}, {1, 4, 6, 7, 5, 8, 2, 3}, {8, 2, 1,
     7, 4, 6, 5, 3}, {3, 2, 8, 5, 7, 6, 4, 1}, {8, 5, 3, 2, 4, 1, 7, 6}, {6, 4, 3, 5, 2, 8, 7, 1}, {6, 7, 1, 4, 2, 3, 5, 8}, {3, 5, 6, 4, 7, 1, 2, 8}, {1, 2, 3, 4, 5, 6, 7, 8}};
In[14]:=
faces = {{1, 2, 3, 4}, {1, 4, 6, 7}, {1, 2, 7, 8}, {2, 3, 5, 8}, {5, 6, 7, 8}, {3, 4, 5, 6}};
In[15]:=
ResourceFunction["SubsetGroup"][symmetries, faces]
Out[15]=
In[16]:=
OrbitRepresentatives[%, Permutations[Range[6]]] // Length
Out[16]=

Properties and Relations (2) 

n 2-subsets of {1,2,3,4,5,6} yield a permutation group of n-permutations:

In[17]:=
Subsets[Range[6], {2}]
Out[17]=
In[18]:=
ResourceFunction["SubsetGroup"][CyclicGroup[6], %]
Out[18]=
In[19]:=
GroupMultiplicationTable[%] // Grid
Out[19]=

The n ordered 2-subsets of {1,2,3,4,5,6} yield a permutation group of n-permutations:

In[20]:=
ordered = DeleteCases[Tuples[Range[6], {2}], {x_, x_}]
Out[20]=
In[21]:=
ResourceFunction["SubsetGroup"][CyclicGroup[6], %, "Ordered"]
Out[21]=
In[22]:=
Range[Length[ordered]] === %[[1, 1]]
Out[22]=

Version History

  • 1.0.0 – 05 October 2020

License Information