A290351
Euler transform of the Bell numbers (A000110).
Original entry on oeis.org
1, 1, 3, 8, 26, 88, 340, 1411, 6417, 31474, 166242, 939646, 5659613, 36158227, 244049562, 1733702757, 12919475840, 100690425442, 818554392962, 6924577964036, 60828588178031, 553821749290234, 5217264062756556, 50776256646839085, 509823607380230570
Offset: 0
-
b:= proc(n) option remember; `if`(n=0, 1, add(
b(n-j)*binomial(n-1, j-1), j=1..n))
end:
a:= proc(n) option remember; `if`(n=0, 1, add(add(d*
b(d), d=numtheory[divisors](j))*a(n-j), j=1..n)/n)
end:
seq(a(n), n=0..30);
-
b[n_]:=b[n]=If[n==0, 1, Sum[b[n - j] Binomial[n - 1, j - 1], {j, n}]]; a[n_]:=a[n]=If[n==0, 1, Sum[Sum[d*b[d], {d, Divisors[j]}] a[n - j], {j, n}]/n]; Table[a[n], {n, 0, 50}] (* Indranil Ghosh, Jul 28 2017, after Maple code *)
A305852
Weigh transform of the Fubini numbers (ordered Bell numbers, A000670).
Original entry on oeis.org
1, 1, 3, 16, 91, 658, 5567, 54917, 620081, 7905592, 112382245, 1762646331, 30231516786, 562750751610, 11297034281595, 243241826522376, 5591075279423398, 136633359995403580, 3537193288612096901, 96697587673174195740, 2783492094736121087958
Offset: 0
-
g:= proc(n) option remember; `if`(n=0, 1,
add(g(n-j)*binomial(n, j), j=1..n))
end:
b:= proc(n, i) option remember; `if`(n=0, 1, `if`(i<1, 0,
add(binomial(g(i), j)*b(n-i*j, i-1), j=0..n/i)))
end:
a:= n-> b(n$2):
seq(a(n), n=0..30);
-
g[n_] := g[n] = If[n == 0, 1,
Sum[g[n - j] Binomial[n, j], {j, 1, n}]];
b[n_, i_] := b[n, i] = If[n == 0, 1, If[i<1, 0,
Sum[Binomial[g[i], j] b[n - i j, i - 1], {j, 0, n/i}]]];
a[n_] := b[n, n];
a /@ Range[0, 30] (* Jean-François Alcover, Dec 21 2020, after Alois P. Heinz *)
A007003
Euler transform of numbers of preferential arrangements.
Original entry on oeis.org
1, 2, 5, 19, 97, 658, 5458, 53628, 606871, 7766312, 110811174, 1743359979, 29972475254, 558940415943, 11235765584497, 242168565186139, 5570683131749362, 136215122718876230, 3527978807819506487, 96480528944412962039, 2778048842021042988465
Offset: 0
-
with(numtheory): etr:= proc(p) local b; b:=proc(n) option remember; local d,j; if n=0 then 1 else add(add(d*p(d), d=divisors(j)) *b(n-j), j=1..n)/n fi end end: f:= proc(n) option remember; local k; if n<=1 then 1 else add(binomial(n, k) *f(n-k), k=1..n) fi end: aa:= etr(k->f(k-1)): a:= n->aa(n+1): seq(a(n), n=0..30); # Alois P. Heinz, Sep 08 2008
-
etr[p_] := Module[{b}, b[n_] := b[n] = If[n == 0, 1, Sum[Sum[d*p[d], {d, Divisors[j]}]*b[n-j], {j, 1, n}]/n]; b]; f[n_] := f[n] = If[n <= 1, 1, Sum[Binomial[n, k]*f[n-k], {k, 1, n}]]; aa := etr[f[#-1]&]; a[n_] := aa[n+1]; Table[a[n], {n, 0, 30}] (* Jean-François Alcover, Mar 10 2014, after Alois P. Heinz *)
Showing 1-3 of 3 results.