Return to Revisions

It's not an original answer, it's just a supplement to the answer of thorimur.

g1 = Graph[(Sort /@ 
      Flatten[Map[
        Thread[#[[1]] \[UndirectedEdge] #[[2]]] &, {{1, {2, 3, 4, 
           5}}, {2, {1, 3, 5, 6}}, {3, {1, 4, 2, 6}}, {4, {1, 3, 5, 
           6}}, {5, {1, 2, 4, 6}}, {6, {2, 3, 4, 5}}}]]) // 
    DeleteDuplicates, 
   VertexLabels -> "Name"];(*Adjacency between faces*)

UnrestrictedColoringQ[g_, coloring_Association] := 
  ContainsExactly[VertexList[g], Keys[coloring]];

ColoringQ[g_, c_Association] := 
  FreeQ[Map[c, EdgeList[g], {2}], v_ \[UndirectedEdge] v_, 1] /; 
   UnrestrictedColoringQ[g, c];

AllUnrestrictedColorings[g_] := 
  With[{vs = VertexList[g]}, 
   AssociationThread[vs, #] & /@ 
    Tuples[Table[i, {i, Length[vs]}], Length[vs]]];

AllLabeledColorings[g_] := 
  Select[AllUnrestrictedColorings[g], ColoringQ[g, #] &];

AutMod[g_, clist : {___Association}, autg_List : Null] := 
 With[{AutG = 
    Replace[autg, Null :> GroupElements[GraphAutomorphismGroup[g]]]}, 
  DeleteDuplicates[
   Function[c, 
     Function[h, 
       KeySort@KeyMap[Function[v, PermutationReplace[v, h]], c]] /@ 
      AutG] /@ clist, ContainsExactly]]


(*With g1 as above:*)
H = GroupElements@
   PermutationGroup[{Cycles[{{2, 3, 4, 5}}], Cycles[{{1, 2, 6, 4}}]}];
G1 = GroupElements@
   FiniteGroupData["Octahedral", "PermutationGroupRepresentation"];
G2 = GroupElements@
   PermutationGroup[{Cycles[{{2, 3, 4, 5}}], Cycles[{{1, 2, 6, 4}}], 
     Cycles[{{1, 6}}]}];
num1 = AutMod[g1, AllLabeledColorings[g1]] // Length
num2 = AutMod[g1, AllLabeledColorings[g1], G1] // Length
num3 = AutMod[g1, AllLabeledColorings[g1], G2] // Length
num4 = AutMod[g1, AllLabeledColorings[g1], H] // Length

The above code takes about 800 seconds to calculate num2. And the results of the above codes are 215, 1860, 215, 230.

Where num1 = num3, this conclusion is very useful. But one thing I'm confused about is that groups G1 and G2 are both groups of order 48, representing regular hexahedral groups.