A339122 Number of elements of the Rubik's Cube group of order A338883(n).

1, 170911549183, 33894540622394, 4346957030144256, 133528172514624, 140621059298755526, 153245517148800, 294998638981939200, 55333752398428896, 34178553690432192, 44590694400, 2330232827455554048, 23298374383021440, 14385471333209856, 150731886270873600

Offset

1,2

Comments

The most common order is 60, with a(33) = 4199961633799421952 elements, or about 9.71% of the group.

The least common order (excluding 1) is 11, with a(11) = 44590694400 elements, or about 0.0000001% of the group. Elements of order 11 are rare because they cannot affect the corner pieces of the cube.

Links

Ben Whitmore, Table of n, a(n) for n = 1..73

Tomas Rokicki, SpeedSolving Puzzles Community.

Formula

Sum_{n=1..73} a(n) = 43252003274489856000 = A075152(3).

Example

a(1) = 1 because the only element of order A338883(1) = 1 is the identity element.
a(73) = 51490480088678400 is the number of elements of order A338883(73) = 1260.

Mathematica

pN[p_] := Total[p]!/Times@@p/Times@@Factorial[Flatten[Tally[p]][[2 ;; ;; 2]]]
oddQ[p_] := OddQ[Total[p - 1]]
ord[p_] := LCM @@ p
oriN[p_, o_] := Module[{i, t, a = 0, ns = 0, s = 0, r}, t = ord[p]/p;
  For[i = 1, i <= Length[p], i++,
   If[Mod[t[[i]], o] == 0, a += p[[i]], ns += 1; s += p[[i]]]];
     {If[a == 0, r = o^(s - ns), r = o^a o^(s - ns - 1)], o^(a + s - 1) - r}]
val[p1_, o1_, p2_, o2_] :=
Module[{z}, z = pN[p1] pN[p2];
     {{LCM[ord[p1], ord[p2]], z oriN[p1, o1][[1]] oriN[p2, o2][[1]]},
     {{LCM[ord[p1] o1, ord[p2]], z oriN[p1, o1][[2]] oriN[p2, o2][[1]]}},   {{LCM[ord[p1], ord[p2] o2], z oriN[p1, o1][[1]] oriN[p2, o2][[2]]}},
  {{LCM[ord[p1] o1, ord[p2] o2], z oriN[p1, o1][[2]] oriN[p2, o2][[2]] }}}]
p8 = IntegerPartitions[8]; p12 = IntegerPartitions[12];
ce = Select[p8, ! oddQ[#] &]; co = Select[p8, oddQ[#] &];
ee = Select[p12, ! oddQ[#] &]; eo = Select[p12, oddQ[#] &];
res = {}; max = 0;
For[i = 1, i <= Length[ce], i++,
For[j = 1, j <= Length[ee], j++,
  AppendTo[res, val[ce[[i]], 3, ee[[j]], 2]]]]
For[i = 1, i <= Length[co], i++,
For[j = 1, j <= Length[eo], j++,
  AppendTo[res, val[co[[i]], 3, eo[[j]], 2]]]]
p = Partition[res // Flatten, 2]; c // Clear;
For[i = 1, i <= Length[p], i++,
  If [IntegerQ[c[p[[i, 1]]]], c[p[[i, 1]]] += p[[i, 2]],
   c[p[[i, 1]]] = p[[i, 2]]]; If[p[[i, 1]] > max, max = p[[i, 1]]]];
Select[Table[c[i], {i, 1, max}], IntegerQ[#] &] (* Herbert Kociemba, Jun 30 2022 *)

Prog

(Python) # See post #11 in SpeedSolving Puzzles Community link.

Crossrefs

Cf. A057731, A075152, A338883.

Sequence in context: A233503 A241501 A197633 * A105295 A288262 A233624

Adjacent sequences: A339119 A339120 A339121 * A339123 A339124 A339125

Keyword

nonn,fini,full

Author

Ben Whitmore, Nov 24 2020

Extensions

a(10) corrected by Ben Whitmore, Jun 27 2022

Status

approved