cp's OEIS Frontend

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

%I A325019 #5 Jun 11 2019 06:09:53
%S A325019 1,0,1,4,3,0,1,19,141,394,450,180,0,0,1,306,33207,921908,10359075,
%T A325019 59584470,197644440,400752240,505197000,386694000,164656800,29937600,
%U A325019 0,0,0,0
%N A325019 Triangle read by rows: T(n,k) is the number of achiral colorings of the facets of a regular n-dimensional orthoplex using exactly k colors. Row n has 2^n columns.
%C A325019 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 16-cell with sixteen tetrahedral facets. The Schläfli symbol, {3,...,3,4}, of the regular n-dimensional orthoplex (n>1) consists of n-2 threes followed by a four. Each of its 2^n facets is an (n-1)-dimensional simplex. An achiral coloring is identical to its reflection. The last 2^(n-2) columns of row n are zero; there are no achiral colorings with that many colors.
%C A325019 Also the number of achiral colorings of the vertices of a regular n-dimensional orthotope (cube) using exactly k colors.
%H A325019 Robert A. Russell, <a href="/A325019/b325019.txt">Table of n, a(n) for n = 1..510</a>, rows 1..8, flattened.
%H A325019 E. M. Palmer and R. W. Robinson, <a href="https://projecteuclid.org/euclid.acta/1485889789">Enumeration under two representations of the wreath product</a>, Acta Math., 131 (1973), 123-143.
%F A325019 A325015(n,k) = Sum_{j=1..2^n} T(n,j) * binomial(k,j).
%F A325019 T(n,k) = 2*A325017(n,k) - A325016(n,k) = A325016(n,k) - 2*A325018(n,k) = A325017(n,k) - A325018(n,k).
%e A325019 Triangle begins with T(1,1):
%e A325019 1  0
%e A325019 1  4   3   0
%e A325019 1 19 141 394 450 180 0 0
%e A325019 For T(2,3)=3, each square has one of the three colors on two opposite edges.
%t A325019 a48[n_] := a48[n] = DivisorSum[NestWhile[#/2&,n,EvenQ],MoebiusMu[#]2^(n/#)&]/(2n); (* A000048 *)
%t A325019 a37[n_] := a37[n] = DivisorSum[n,MoebiusMu[n/#]2^#&]/n; (* A001037 *)
%t A325019 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^(n-1); (* even permutation *)
%t A325019 CI1[{n_Integer}] := CI1[{{n}}] = CI[sub = Divisors[n]; Transpose[If[EvenQ[n], {sub, a37 /@ sub}, {2 sub, (a37 /@ sub)/2}]]] 2^(n-1); (* odd permutation *)
%t A325019 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)
%t A325019 cix[{a_, b_}, {c_, d_}] := {LCM[a, c], (a b c d)/LCM[a, c]};
%t A325019 Unprotect[Times]; Times[CI[a_List], CI[b_List]] :=  (* combine *) CI[compress[Flatten[Outer[cix, a, b, 1], 1]]]; Protect[Times];
%t A325019 CI0[p_List] := CI0[p] = Expand[CI0[Drop[p, -1]] CI0[{Last[p]}] + CI1[Drop[p, -1]] CI1[{Last[p]}]]
%t A325019 CI1[p_List] := CI1[p] = Expand[CI0[Drop[p, -1]] CI1[{Last[p]}] + CI1[Drop[p, -1]] CI0[{Last[p]}]]
%t A325019 pc[p_List] := Module[{ci,mb},mb = DeleteDuplicates[p]; ci = Count[p, #] & /@ mb; n!/(Times @@ (ci!) Times @@ (mb^ci))] (* partition count *)
%t A325019 row[n_Integer] := row[n] = Factor[(Total[(CI1[#] pc[#]) & /@ IntegerPartitions[n]])/(n! 2^(n - 1))] /. CI[l_List] :> j^(Total[l][[2]])
%t A325019 array[n_, k_] := row[n] /. j -> k (* A325012 *)
%t A325019 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
%Y A325019 Cf. A325016 (oriented), A325017 (unoriented), A325018 (chiral), A325015 (up to k colors).
%Y A325019 Other n-dimensional polytopes: A325003 (simplex), A325011 (orthotope).
%Y A325019 Cf. A000048, A001037.
%K A325019 nonn,tabf
%O A325019 1,4
%A A325019 _Robert A. Russell_, Jun 09 2019