A338115 Triangle read by rows: T(n,k) is the number of chiral pairs of colorings of the faces (and peaks) of a regular n-dimensional simplex using exactly k colors. Row n has C(n+1,3) columns.

0, 0, 0, 0, 1, 0, 6, 387, 6320, 41350, 135792, 246540, 252000, 136080, 30240, 0, 1368, 4771602, 1503445800, 124777747050, 4305186592884, 77999895773184, 849555062883744, 6053648136215400, 29824571700428400

Offset

2,7

Comments

An n-dimensional simplex has n+1 vertices, C(n+1,3) faces, and C(n+1,3) peaks, which are (n-3)-dimensional simplexes. For n=2, the figure is a triangle with one face. For n=3, the figure is a tetrahedron with four triangular faces and four peaks (vertices). For n=4, the figure is a 4-simplex with ten triangular faces and ten peaks (edges). The Schläfli symbol {3,...,3}, of the regular n-dimensional simplex consists of n-1 3's. Each member of a chiral pair is a reflection, but not a rotation, of the other.

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

Links

Table of n, a(n) for n=2..26.

G. Royle, Partitions and Permutations

Formula

A337885(n,k) = Sum_{j=1..C(n+1,3)} T(n,j) * binomial(k,j).

T(n,k) = A338113(n,k) - A338114(n,k) = (A338113(n,k) - A338116(n,k)) / 2 = A338114(n,k) - A338116(n,k).

T(3,k) = [k==4]; T(4,k) = A327089(4,k).

Example

Triangle begins with T(2,1):
  0
  0 0   0    1
  0 6 387 6320 41350 135792 246540 252000 136080 30240
  ...
For T(4,4)=1, each of the four tetrahedron faces (vertices) is a different color.

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[LinearSolve[Table[Binomial[i, j], {i, Binomial[n+1, m+1]}, {j, Binomial[n+1, m+1]}], Table[array[n, k], {k, Binomial[n+1, m+1]}]], {n, m, m+4}] // Flatten

Crossrefs

Cf. A338113 (oriented), A338114 (unoriented), A338116 (achiral), A337885 (k or fewer colors), [k==n+1] (vertices and facets), A327089 (edges and ridges).

Sequence in context: A193133 A162137 A119645 * A283228 A278322 A229599

Adjacent sequences: A338112 A338113 A338114 * A338116 A338117 A338118

Keyword

nonn,tabf

Author

Robert A. Russell, Oct 10 2020

Status

approved