login
A242783
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.
24
1, 1, 2, 5, 1, 21, 3, 70, 50, 450, 270, 4326, 602, 99, 12, 1, 34944, 5376, 209863, 139714, 13303, 1573632, 1366016, 530432, 158720, 21824925, 15302031, 2715243, 74601, 302273664, 161855232, 14872704, 2854894485, 2600075865, 712988175, 59062275
OFFSET
0,3
COMMENTS
Sum_{k>0} k*T(n,k) = A249249(n).
LINKS
EXAMPLE
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).
Triangle T(n,k) begins:
: n\k : 0 1 2 3 4 ...
+-----+------------------------------------
: 0 : 1;
: 1 : 1; [row 1 of A008292]
: 2 : 2; [row 2 of A008303]
: 3 : 5, 1; [row 3 of A162975]
: 4 : 21, 3; [row 4 of A242819]
: 5 : 70, 50; [row 5 of A227884]
: 6 : 450, 270; [row 6 of A242819]
: 7 : 4326, 602, 99, 12, 1; [row 7 of A220183]
: 8 : 34944, 5376; [row 8 of A242820]
: 9 : 209863, 139714, 13303; [row 9 of A230695]
: 10 : 1573632, 1366016, 530432, 158720; [row 10 of A230797]
MAPLE
T:= proc(n) option remember; local b, k, r, h;
k:= iquo(n, 2, 'r'); h:= 2^ilog2(n);
b:= proc(u, o, t) option remember; `if`(u+o=0, 1, expand(
add(b(u-j, o+j-1, irem(2*t, h))*`if`(r=0 and t=k, x, 1), j=1..u)+
add(b(u+j-1, o-j, irem(2*t+1, h))*`if`(r=1 and t=k, x, 1), j=1..o)))
end: forget(b);
(p-> seq(coeff(p, x, i), i=0..degree(p)))(b(n, 0, 0))
end:
seq(T(n), n=0..15);
MATHEMATICA
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 *)
CROSSREFS
KEYWORD
nonn,tabf,look
AUTHOR
Alois P. Heinz, May 22 2014
STATUS
approved