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

1, 2, 1, 3, 6, 1, 4, 24, 218, 1, 5, 70, 2285, 90054, 1, 6, 165, 703760, 1471640157, 573439556, 1, 7, 336, 10194250, 1466049174160, 6332134720430727, 50043770249328, 1, 8, 616, 90775566, 310441584462375, 629648890639384572032, 1839894096099964270283469, 59966884221697869216, 1

Offset: 1

Author

Robert A. Russell, Aug 26 2020

Keywords

• nonn
• tabl

Comments

Each chiral pair is counted as two when enumerating oriented arrangements. 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 oriented colorings of the regular (n-2)-dimensional orthotopes (hypercubes) in a regular n-dimensional orthotope.

Examples

			Table begins with T(1,1):
1   2     3      4        5        6         7          8           9 ...
1   6    24     70      165      336       616       1044        1665 ...
1 218 22815 703760 10194250 90775566 576941778 2863870080 11769161895 ...
For T(2,2)=6, the arrangements are AAAA, AAAB, AABB, ABAB, ABBB, and BBBB.
		

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. A337412 (unoriented), A337413 (chiral), A337414 (achiral).

Rows 1-4 are A000027, A006528, A060530, A331354.

Cf. A327083 (simplex edges), A337407 (orthotope edges), A325004 (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; If[EvenQ[Sum[If[EvenQ[j3], r1[[j3]], r2[[j3]]], {j3,n}]], (per = LCM @@ Table[If[cs[[j2]] == r1[[j2]], If[0 == cs[[j2]],1,j2], 2j2], {j2,n}]; Times @@ Binomial[cs, r1] 2^(n-Total[cs]) b^FiSum[]),0]);
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[m]=b;
row[n_Integer] := row[n] = Factor[(Total[(PartPol[#] pc[#])&/@ IntegerPartitions[n]])/(n! 2^(n-1))]
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) = A337412(n,k) + A337413(n,k) = 2*A337412(n,k) - A337414(n,k) = 2*A337413(n,k) + A337414(n,k).