OFFSET
2,9
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.
LINKS
E. M. Palmer and R. W. Robinson, Enumeration under two representations of the wreath product, Acta Math., 131 (1973), 123-143.
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).
EXAMPLE
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.
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
CROSSREFS
KEYWORD
nonn,tabl
AUTHOR
Robert A. Russell, Sep 28 2020
STATUS
approved