|
%I #19 Feb 20 2021 03:36:07
%S 2,6,10,40,80,250,510,1890,4270,13738,30630,101960,234864,705046,
%T 1580578,5136840,11991928,36095322,82990606,255579576,595920680,
%U 1719038038,3926998938,11665004238,26978093154,75938910058,172678519950,489262646480,1114189211016
%N f(f(n+1))-f(f(n)), where f(m) = binary partition(m) = A000123(m).
%H Alois P. Heinz, <a href="/A111414/b111414.txt">Table of n, a(n) for n = 0..2500</a>
%p b:= proc(n, j) option remember; local nn, r; if n<0 then 0 elif j=0 then 1 elif j=1 then n+1 elif n<j then b(n-1, j) +b(2*n, j-1) else nn:= 1 +floor(n); r:= n-nn; (nn-j) *binomial(nn, j) *add (binomial(j, h) /(nn-j+h) *b(j-h+r, j) *(-1)^h, h=0..j-1) fi end: f:= proc(n) local t; t:= ilog2(2*n+1); b(n /2^(t-1), t) end: a:= n-> f(f(n+1)) -f(f(n)): seq (a(n), n=0..50); # _Alois P. Heinz_, Sep 28 2011
%t b[n_, j_] := b[n, j] = Module[{nn, r}, Which[n<0, 0, j == 0, 1, j == 1, n+1, n<j, b[n-1, j]+b[2*n, j-1], True, nn = 1+Floor[n]; r = n-nn; (nn-j)*Binomial[nn, j]*Sum[Binomial[j, h]/(nn-j+h)*b[j-h+r, j]*(-1)^h, {h, 0, j-1}]]];
%t f[n_] := Module[{t}, t = Length[IntegerDigits[2n+1, 2]]-1; b[n/2^(t-1), t]];
%t a[n_] := f[f[n+1]] - f[f[n]];
%t Table[a[n], {n, 0, 50}] (* _Jean-François Alcover_, Mar 19 2014, after _Alois P. Heinz_ *)
%Y Cf. A000123.
%K nonn
%O 0,1
%A _N. J. A. Sloane_, Nov 12 2005
|
