|
%I #20 Jun 01 2023 19:54:05
%S 1,0,1,1,0,1,1,2,1,1,3,4,5,2,1,7,14,16,10,4,1,25,48,61,42,20,6,1,79,
%T 194,250,200,106,38,9,1,339,820,1145,958,569,230,66,12,1,1351,3794,
%U 5554,5096,3251,1486,486,112,16,1,6721,18960,29101,28010,19110,9470,3477,930,175,20,1
%N Triangle read by rows: T(n,k) is the number of partitions of the set {1,2,...,n}, having exactly k blocks consisting of entries of the same parity (0<=k<=n).
%C Row sums are the Bell numbers (A000110). T(n,0)=A124425(n).
%H Alois P. Heinz, <a href="/A124424/b124424.txt">Rows n = 0..140, flattened</a>
%F The generating polynomial of row n is P[n](t)=Q[n](t,t,1), where the polynomials Q[n]=Q[n](t,s,x) are defined by Q[0]=1; Q[n]=t*dQ[n-1]/dt + x*dQ[n-1]/ds + x*dQ[n-1]/dx + t*Q[n-1] if n is odd and Q[n]=x*dQ[n-1]/dt + s*dQ[n-1]/ds + x*dQ[n-1]/dx + s*Q[n-1] if n is even.
%F Sum_{k=0..n} k * T(n,k) = A363434(n). - _Alois P. Heinz_, Jun 01 2023
%e T(4,2) = 5 because we have 13|24, 14|2|3, 1|2|34, 1|23|4 and 12|3|4.
%e Triangle starts:
%e 1;
%e 0, 1;
%e 1, 0, 1;
%e 1, 2, 1, 1;
%e 3, 4, 5, 2, 1;
%e 7, 14, 16, 10, 4, 1;
%e ...
%p Q[0]:=1: for n from 1 to 11 do if n mod 2 = 1 then Q[n]:=expand(t*diff(Q[n-1],t)+x*diff(Q[n-1],s)+x*diff(Q[n-1],x)+t*Q[n-1]) else Q[n]:=expand(x*diff(Q[n-1],t)+s*diff(Q[n-1],s)+x*diff(Q[n-1],x)+s*Q[n-1]) fi od: for n from 0 to 11 do P[n]:=sort(subs({s=t,x=1},Q[n])) od: for n from 0 to 11 do seq(coeff(P[n],t,j),j=0..n) od; # yields sequence in triangular form
%p # second Maple program:
%p b:= proc(g, u) option remember;
%p add(Stirling2(g, k)*Stirling2(u, k)*k!, k=0..min(g, u))
%p end:
%p T:= proc(n, k) local g, u; g:= floor(n/2); u:= ceil(n/2);
%p add(add(add(binomial(g, i)*Stirling2(i, h)*binomial(u, j)*
%p Stirling2(j, k-h)*b(g-i, u-j), j=k-h..u), i=h..g), h=0..k)
%p end:
%p seq(seq(T(n,k), k=0..n), n=0..12); # _Alois P. Heinz_, Oct 24 2013
%t b[g_, u_] := b[g, u] = Sum[StirlingS2[g, k]*StirlingS2[u, k]*k!, {k, 0, Min[g, u]}] ; T[n_, k_] := Module[{g, u}, g = Floor[n/2]; u = Ceiling[n/2]; Sum[ Sum[ Sum[ Binomial[g, i]*StirlingS2[i, h]*Binomial[u, j]*StirlingS2[j, k-h]*b[g-i, u-j], {j, k-h, u}], {i, h, g}], {h, 0, k}]]; Table[Table[T[n, k], {k, 0, n}], {n, 0, 12}] // Flatten (* _Jean-François Alcover_, Feb 19 2015, after _Alois P. Heinz_ *)
%Y Cf. A000110, A124418, A124419, A124420, A124421, A124422, A124423, A124425, A363434.
%Y T(2n,n) gives A363435.
%K nonn,tabl
%O 0,8
%A _Emeric Deutsch_, Nov 01 2006
|
