login
Irregular triangular array of coefficients of the cd-index of the symmetric group S_n (or Boolean algebra B_n), n>=1.
1

%I #13 Mar 28 2021 18:40:16

%S 1,1,1,1,1,2,2,1,3,5,3,4,1,4,9,9,4,12,10,12,1,5,14,19,14,5,25,35,42,

%T 18,35,25,34,1,6,20,34,34,20,6,44,84,100,72,140,100,28,72,84,44,136,

%U 112,112,136,1,7,27,55,69,55,27,7,70,168,198,196,378,268,126,324,378,198,40,126,196,168,70,364,504,504,612,256,420,504,256,504,364,496

%N Irregular triangular array of coefficients of the cd-index of the symmetric group S_n (or Boolean algebra B_n), n>=1.

%C Equivalently, the cd-index of the face lattice of the (n-1)-dimensional simplex.

%C These polynomials encode the numbers given in A335845. The row lengths are A000045(n). The row sums are A000111(n).

%D R. P. Stanley, Enumerative Combinatorics, Vol I, second edition, page 54 and section 3.17.

%H Margaret M. Bayer, <a href="https://arxiv.org/abs/1901.04939">The cd-Index: A Survey</a>, arXiv:1901.04939 [math.CO], 2019.

%e 1,

%e 1,

%e 1, 1,

%e 1, 2, 2,

%e 1, 3, 5, 3, 4,

%e 1, 4, 9, 9, 4, 12, 10, 12,

%e 1, 5, 14, 19, 14, 5, 25, 35, 42, 18, 35, 25, 34

%e The terms of the polynomials are ordered lexicographically. For example, row 5 represents the polynomial: c^4 + 3c^2d + 5cdc + 3dc^2 + 4d^2.

%t Join[{{1}},Table[h[list_]:=(-1)^(Length[list]+1)Apply[Multinomial,list];g[S_]:=Abs[Total[Map[h,Map[Differences,Map[Prepend[#,0]&,Map[Append[#,nn]&,Subsets[S]]]]]]];rhs=Drop[Map[g,Subsets[Range[nn-1]]],-2^(nn-2)];Clear[c,d];fib=Reverse[Map[#/.{2->d,1->c}&,Level[Map[Permutations,IntegerPartitions[nn-1,nn-1,{1,2}]],{2}]]];c:={{a},{b}};d:={{a,b},{b,a}};f[list1_,list2_]:=Level[Table[Table[Join[list1[[i]],list2[[k]]],{i,1,Length[list1]}],{k,1,Length[list2]}],{2}];rr=Table[Map[Fold[f,#[[1]],Rest[#]]&,fib][[i]]->Subscript[x,i],{i,1,Fibonacci[nn]}];eqn[list_]:=Total[Select[Map[Fold[f,#[[1]],Rest[#]]&,fib],MemberQ[#,list]&]/.rr]==FromDigits[Part[rhs,Flatten[Position[charmon=Drop[Map[Table[If[MemberQ[#,i],b,a],{i,1,nn-1}]&,Subsets[Range[nn-1]]],-2^(nn-2)],list]]]];charmon=Drop[Map[Table[If[MemberQ[#,i],b,a],{i,1,nn-1}]&,Subsets[Range[nn-1]]],-2^(nn-2)];Table[Subscript[x,i],{i,1,Fibonacci[nn]}]/.Flatten[Solve[Map[eqn[#]&,charmon]]],{nn,2,10}]]//Flatten

%Y Cf. A000045, A000111, A335845.

%K nonn,tabf

%O 1,6

%A _Geoffrey Critzer_, Mar 28 2021