A337885 Array read by descending antidiagonals: T(n,k) is the number of chiral pairs of colorings of the triangular faces of a regular n-dimensional simplex using k or fewer colors.

0, 0, 0, 0, 0, 0, 0, 0, 6, 0, 0, 1, 405, 1368, 0, 0, 5, 7904, 4775706, 6711288, 0, 0, 15, 76880, 1522540416, 9923557498416, 1785683627824, 0, 0, 35, 486522, 132342705750, 234239763858347776, 12979826761630383196344, 53302696800142157920, 0

Offset: 2

Author

Robert A. Russell, Sep 28 2020

Keywords

• nonn
• tabl

Comments

Each member of a chiral pair is a reflection, but not a rotation, of the other. An n-simplex has n+1 vertices. For n=2, the figure is a triangle with one triangular face. For n=3, the figure is a tetrahedron with 4 triangular faces. For higher n, the number of triangular faces is C(n+1,3).

Also the number of chiral pairs of colorings of the peaks of a regular n-dimensional simplex. A peak of an n-simplex is an (n-3)-dimensional simplex.

Examples

			Table begins with T(2,1):
 0    0       0          0            0             0               0 ...
 0    0       0          1            5            15              35 ...
 0    6     405       7904        76880        486522         2300305 ...
 0 1368 4775706 1522540416 132342705750 5076500214744 110809322249220 ...
For T(3,4)=1, the chiral pair is ABCD-ABDC.
		

Links

• E. M. Palmer and R. W. Robinson, Enumeration under two representations of the wreath product, Acta Math., 131 (1973), 123-143.

Crossrefs

Cf. A337883 (oriented), A337884 (unoriented), A337886 (achiral), A051168 (binary Lyndon words).

Other elements: A325000(n,k-n) (vertices), A327085 (edges).

Other polytopes: A337889 (orthotope), A337893 (orthoplex).

Rows 2-4 are A000004, A000332, A331352.

Programs

Mathematica

m=2; (* dimension of color element, here a triangular face *)
lw[n_,k_]:=lw[n, k]=DivisorSum[GCD[n,k],MoebiusMu[#]Binomial[n/#,k/#]&]/n (*A051168*)
cxx[{a_, b_},{c_, d_}]:={LCM[a, c], GCD[a, c] b d}
compress[x:{{, } ...}] := (s=Sort[x];For[i=Length[s],i>1,i-=1,If[s[[i,1]]==s[[i-1,1]], s[[i-1,2]]+=s[[i,2]]; s=Delete[s,i], Null]]; s)
combine[a : {{, } ...}, b : {{, } ...}] := Outer[cxx, a, b, 1]
CX[p_List, 0] := {{1, 1}} (* cycle index for partition p, m vertices *)
CX[{n_Integer}, m_] := If[2m>n, CX[{n}, n-m], CX[{n},m] = Table[{n/k, lw[n/k, m/k]}, {k, Reverse[Divisors[GCD[n, m]]]}]]
CX[p_List, m_Integer] := CX[p, m] = Module[{v = Total[p], q, r}, If[2 m > v, CX[p, v - m], q = Drop[p, -1]; r = Last[p]; compress[Flatten[Join[{{CX[q, m]}}, Table[combine[CX[q, m - j], CX[{r}, j]], {j, Min[m, r]}]], 2]]]]
pc[p_] := Module[{ci, mb}, mb = DeleteDuplicates[p]; ci = Count[p, #] &/@ mb; Total[p]!/(Times @@ (ci!) Times @@ (mb^ci))] (* partition count *)
row[n_Integer] := row[n] = Factor[Total[If[EvenQ[Total[1-Mod[#, 2]]],1,-1] pc[#] j^Total[CX[#, m+1]][[2]] & /@ IntegerPartitions[n+1]]/(n+1)!]
array[n_, k_] := row[n] /. j -> k
Table[array[n,d+m-n], {d,8}, {n,m,d+m-1}] // Flatten

Formula

The algorithm used in the Mathematica program below assigns each permutation of the vertices to a partition of n+1. It then determines the number of permutations for each partition and the cycle index for each partition using a formula for binary Lyndon words. If the value of m is increased, one can enumerate colorings of higher-dimensional elements beginning with T(m,1).

T(n,k) = A337883(n,k) - A337884(n,k) = (A337883(n,k) - A337886(n,k)) / 2 = A337884(n,k) - A337886(n,k).