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,2

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.

Links

Table of n, a(n) for n=1..36.

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

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).

Example

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.

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

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).

Sequence in context: A337408 A059298 A214306 * A337407 A156914 A289656

Adjacent sequences: A337408 A337409 A337410 * A337412 A337413 A337414

Keyword

nonn,tabl

Author

Robert A. Russell, Aug 26 2020

Status

approved