%I #33 Sep 13 2020 14:40:38

%S 1,1,2,5,1,21,3,70,50,450,270,4326,602,99,12,1,34944,5376,209863,

%T 139714,13303,1573632,1366016,530432,158720,21824925,15302031,2715243,

%U 74601,302273664,161855232,14872704,2854894485,2600075865,712988175,59062275

%N Number T(n,k) of permutations of [n] with exactly k (possibly overlapping) occurrences of the consecutive step pattern given by the binary expansion of n, where 1=up and 0=down; triangle T(n,k), n>=0, read by rows.

%C Sum_{k>0} k*T(n,k) = A249249(n).

%H Alois P. Heinz, <a href="/A242783/b242783.txt">Rows n = 0..130, flattened</a>

%e T(7,3) = 12 because 12 permutations of {1,2,3,4,5,6,7} have exactly 3 (possibly overlapping) occurrences of the consecutive step pattern up, up, up given by the binary expansion of 7 = 111_2: (1,2,3,4,5,7,6), (1,2,3,4,6,7,5), (1,2,3,5,6,7,4), (1,2,4,5,6,7,3), (1,3,4,5,6,7,2), (2,1,3,4,5,6,7), (2,3,4,5,6,7,1), (3,1,2,4,5,6,7), (4,1,2,3,5,6,7), (5,1,2,3,4,6,7), (6,1,2,3,4,5,7), (7,1,2,3,4,5,6).

%e Triangle T(n,k) begins:

%e : n\k : 0 1 2 3 4 ...

%e +-----+------------------------------------

%e : 0 : 1;

%e : 1 : 1; [row 1 of A008292]

%e : 2 : 2; [row 2 of A008303]

%e : 3 : 5, 1; [row 3 of A162975]

%e : 4 : 21, 3; [row 4 of A242819]

%e : 5 : 70, 50; [row 5 of A227884]

%e : 6 : 450, 270; [row 6 of A242819]

%e : 7 : 4326, 602, 99, 12, 1; [row 7 of A220183]

%e : 8 : 34944, 5376; [row 8 of A242820]

%e : 9 : 209863, 139714, 13303; [row 9 of A230695]

%e : 10 : 1573632, 1366016, 530432, 158720; [row 10 of A230797]

%p T:= proc(n) option remember; local b, k, r, h;

%p k:= iquo(n,2,'r'); h:= 2^ilog2(n);

%p b:= proc(u, o, t) option remember; `if`(u+o=0, 1, expand(

%p add(b(u-j, o+j-1, irem(2*t, h))*`if`(r=0 and t=k, x, 1), j=1..u)+

%p add(b(u+j-1, o-j, irem(2*t+1, h))*`if`(r=1 and t=k, x, 1), j=1..o)))

%p end: forget(b);

%p (p-> seq(coeff(p, x, i), i=0..degree(p)))(b(n, 0, 0))

%p end:

%p seq(T(n), n=0..15);

%t T[n_] := T[n] = Module[{b, k, r, h}, {k, r} = QuotientRemainder[n, 2]; h = 2^Floor[Log[2, n]]; b[u_, o_, t_] := b[u, o, t] = If[u + o == 0, 1, Expand[ Sum[b[u - j, o + j - 1, Mod[2*t, h]]*If[r == 0 && t == k, x, 1], {j, 1, u}] + Sum[b[u + j - 1, o - j, Mod[2*t + 1, h]]*If[r == 1 && t == k, x, 1], {j, 1, o}]]]; Function[p, Table[Coefficient[p, x, i], {i, 0, Exponent[p, x]}]][b[n, 0, 0]]]; Table[T[n], {n, 0, 15}] // Flatten (* _Jean-François Alcover_, Feb 20 2016, after _Alois P. Heinz_ *)

%Y Column k=0-10 give: A242785, A246221, A246222, A246223, A246224, A246225, A246226, A246227, A246228, A246229, A243105.

%Y Row sums give A000142.

%Y Cf. A242784, A249249, A295987, A335308.

%K nonn,tabf,look

%O 0,3

%A _Alois P. Heinz_, May 22 2014