A337413 Array read by descending antidiagonals: T(n,k) is the number of chiral pairs of colorings of the edges of a regular n-dimensional orthoplex (cross polytope) using k or fewer colors.

0, 0, 0, 0, 0, 0, 0, 3, 74, 0, 0, 15, 10704, 40927, 0, 0, 45, 345640, 731279799, 280317324, 0, 0, 105, 5062600, 732272925320, 3163614120031068, 24869435516248, 0, 0, 210, 45246810, 155180061396500, 314800331906964016128, 919853357924272852197243, 29931599129719666392, 0

Offset: 1

Author

Robert A. Russell, Aug 26 2020

Keywords

• nonn
• tabl

Comments

Each member of a chiral pair is a reflection, but not a rotation, of the other. For n=1, the figure is a line segment with one edge. For n=2, the figure is a square with 4 edges. For n=3, the figure is an octahedron with 12 edges. The number of edges is 2n*(n-1) for n>1.

Also the number of chiral pairs of colorings of the regular (n-2)-dimensional orthotopes (hypercubes) in a regular n-dimensional orthotope.

Examples

			Table begins with T(1,1):
0  0     0      0       0        0         0          0          0 ...
0  0     3     15      45      105       210        378        630 ...
0 74 10704 345640 5062600 45246810 288005144 1430618784 5881281480 ...
For T(2,3)=3, the chiral arrangements are AABC-AACB, ABBC-ACBB, and ABCC-ACCB.
		

Links

• K. Balasubramanian, Computational enumeration of colorings of hyperplanes of hypercubes for all irreducible representations and applications, J. Math. Sci. & Mod. 1 (2018), 158-180.

Crossrefs

Cf. A337411 (oriented), A337412 (unoriented), A337414 (achiral).

Rows 2-4 are A050534, A337406, A331356.

Cf. A327085 (simplex edges), A337409 (orthotope edges), A325006 (orthoplex vertices).

Programs

Mathematica

m=1; (* dimension of color element, here an edge *)
Fi1[p1_] := Module[{g, h}, Coefficient[Product[g = GCD[k1, p1]; h = GCD[2 k1, p1]; (1 + 2 x^(k1/g))^(r1[[k1]] g) If[Divisible[k1, h], 1, (1+2x^(2 k1/h))^(r2[[k1]] h/2)], {k1, Flatten[Position[cs, n1_ /; n1 > 0]]}], x, m+1]];
FiSum[] := (Do[Fi2[k2] = Fi1[k2], {k2, Divisors[per]}];DivisorSum[per, DivisorSum[d1 = #, MoebiusMu[d1/#] Fi2[#] &]/# &]);
CCPol[r_List] := (r1 = r; r2 = cs - r1; per = LCM @@ Table[If[cs[[j2]] == r1[[j2]], If[0 == cs[[j2]],1,j2], 2j2], {j2,n}]; If[EvenQ[Sum[If[EvenQ[j3], r1[[j3]], r2[[j3]]], {j3,n}]],1,-1]Times @@ Binomial[cs, r1] 2^(n-Total[cs]) b^FiSum[]);
PartPol[p_List] := (cs = Count[p, #]&/@ Range[n]; Total[CCPol[#]&/@ Tuples[Range[0,cs]]]);
pc[p_List] := Module[{ci, mb}, mb = DeleteDuplicates[p]; ci = Count[p, #]&/@ mb; n!/(Times@@(ci!) Times@@(mb^ci))] (*partition count*)
row[n_Integer] := row[n] = Factor[(Total[(PartPol[#] pc[#])&/@ IntegerPartitions[n]])/(n! 2^n)]
array[n_, k_] := row[n] /. b -> 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 axes to a partition of n and then considers separate conjugacy classes for axis reversals. It uses the formulas in Balasubramanian's paper. If the value of m is increased, one can enumerate colorings of higher-dimensional elements beginning with T(m,1).

T(n,k) = A337411(n,k) - A337412(n,k) = (A337411(n,k) - A337414(n,k)) / 2 = A337412(n,k) - A337414(n,k).