

A325018


Triangle read by rows: T(n,k) is the number of chiral pairs of colorings of the facets of a regular ndimensional orthoplex using exactly k colors. Row n has 2^n columns.


6



0, 1, 0, 0, 3, 3, 0, 1, 63, 662, 2400, 3900, 2940, 840, 0, 94, 97692, 10308758, 337560150, 5098740090, 42976836210, 224685801060, 775389028050, 1830791421900, 3007909258200, 3439214024400, 2685727044000, 1366701336000, 408648240000, 54486432000
(list;
graph;
refs;
listen;
history;
text;
internal format)



OFFSET

1,5


COMMENTS

Also called cross polytope and hyperoctahedron. For n=1, the figure is a line segment with two vertices. For n=2 the figure is a square with four edges. For n=3 the figure is an octahedron with eight triangular faces. For n=4, the figure is a 16cell with sixteen tetrahedral facets. The SchlĂ¤fli symbol, {3,...,3,4}, of the regular ndimensional orthoplex (n>1) consists of n2 threes followed by a four. Each of its 2^n facets is an (n1)dimensional simplex. The chiral colorings of its facets come in pairs, each the reflection of the other.
Also the number of chiral pairs of colorings of the vertices of a regular ndimensional orthotope (cube) using exactly k colors.


LINKS

Robert A. Russell, Table of n, a(n) for n = 1..510, rows 1..8, flattened.
E. M. Palmer and R. W. Robinson, Enumeration under two representations of the wreath product, Acta Math., 131 (1973), 123143.


FORMULA

A325014(n,k) = Sum_{j=1..2^n} T(n,j) * binomial(k,j).
T(n,k) = A325016(n,k)  A325017(n,k) = (A325016(n,k)  A325019(n,k)) / 2 = A325017(n,k)  A325019(n,k).


EXAMPLE

Triangle begins with T(1,1):
0 1
0 0 3 3
0 1 63 662 2400 3900 2940 840
For T(2,3)=3, each square has one of the three colors on two adjacent edges.


MATHEMATICA

a48[n_] := a48[n] = DivisorSum[NestWhile[#/2&, n, EvenQ], MoebiusMu[#]2^(n/#)&]/(2n); (* A000048 *)
a37[n_] := a37[n] = DivisorSum[n, MoebiusMu[n/#]2^#&]/n; (* A001037 *)
CI0[{n_Integer}] := CI0[{n}] = CI[Transpose[If[EvenQ[n], p2 = IntegerExponent[n, 2]; sub = Divisors[n/2^p2]; {2^(p2+1) sub, a48 /@ (2^p2 sub) }, sub = Divisors[n]; {sub, a37 /@ sub}]]] 2^(n1); (* even perm. *)
CI1[{n_Integer}] := CI1[{n}] = CI[sub = Divisors[n]; Transpose[If[EvenQ[n], {sub, a37 /@ sub}, {2 sub, (a37 /@ sub)/2}]]] 2^(n1); (* odd perm. *)
compress[x : {{_, _} ...}] := (s = Sort[x]; For[i = Length[s], i > 1, i = 1, If[s[[i, 1]]==s[[i1, 1]], s[[i1, 2]] += s[[i, 2]]; s = Delete[s, i], Null]]; s)
cix[{a_, b_}, {c_, d_}] := {LCM[a, c], (a b c d)/LCM[a, c]};
Unprotect[Times]; Times[CI[a_List], CI[b_List]] := (* combine *) CI[compress[Flatten[Outer[cix, a, b, 1], 1]]]; Protect[Times];
CI0[p_List] := CI0[p] = Expand[CI0[Drop[p, 1]] CI0[{Last[p]}] + CI1[Drop[p, 1]] CI1[{Last[p]}]]
CI1[p_List] := CI1[p] = Expand[CI0[Drop[p, 1]] CI1[{Last[p]}] + CI1[Drop[p, 1]] CI0[{Last[p]}]]
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[((CI0[#]  CI1[#]) pc[#]) & /@ IntegerPartitions[n]])/(n! 2^n)] /. CI[l_List] :> j^(Total[l][[2]])
array[n_, k_] := row[n] /. j > k (* A325014 *)
Table[LinearSolve[Table[Binomial[i, j], {i, 1, 2^n}, {j, 1, 2^n}], Table[array[n, k], {k, 1, 2^n}]], {n, 1, 6}] // Flatten


CROSSREFS

Cf. A325016 (oriented), A325017 (unoriented), A325019 (achiral), A325014 (up to k colors).
Other ndimensional polytopes: A325010 (orthotope).
Cf. A000048, A001037.
Sequence in context: A141947 A216804 A010607 * A118522 A179119 A098316
Adjacent sequences: A325015 A325016 A325017 * A325019 A325020 A325021


KEYWORD

nonn,tabf


AUTHOR

Robert A. Russell, Jun 09 2019


STATUS

approved



