A320553 Number of set partitions of [n] such that for each block b the smallest integer interval containing b has at most three elements and for at least one block c the smallest integer interval containing c has exactly three elements.

2, 5, 12, 29, 66, 145, 315, 676, 1436, 3031, 6367, 13323, 27798, 57873, 120281, 249657, 517663, 1072520, 2220724, 4595938, 9508022, 19664296, 40659943, 84057614, 173750589, 359110196, 742150185, 1533651213, 3169118648, 6548358736, 13530454573, 27956404705

Offset

3,1

Links

Alois P. Heinz, Table of n, a(n) for n = 3..1000

Formula

G.f.: (x+2)*x^3/((x^2+x-1)*(x^4+2*x^3+x^2+x-1)).

a(n) = A129847(n) - A000045(n+1).

Example

a(4) = 5: 123|4, 13|24, 13|2|4, 1|234, 1|24|3.

Maple

b:= proc(n, m, l) option remember; `if`(n=0, 1,
      add(b(n-1, max(m, j), [subsop(1=NULL, l)[],
      `if`(j<=m, 0, j)]), j={l[], m+1} minus {0}))
    end:
A:= (n, k)-> `if`(n=0, 1, `if`(k<2, k, b(n, 0, [0$(k-1)]))):
a:= n-> (k-> A(n, k) -`if`(k=0, 0, A(n, k-1)))(3):
seq(a(n), n=3..35);

Mathematica

b[n_, m_, l_List] := b[n, m, l] = If[n == 0, 1, Sum[b[n - 1, Max[m, j], Append[ReplacePart[l, 1 -> Nothing], If[j <= m, 0, j]]], {j, Append[l, m + 1]~Complement~{0}}]];
A[n_, k_] := If[n == 0, 1, If[k < 2, k, b[n, 0, Array[0 &, k - 1]]]];
a[n_] := With[{k = 3}, A[n, k] - If[k == 0, 0, A[n, k - 1]]];
a /@ Range[3, 35] (* Jean-François Alcover, Dec 08 2020, after Alois P. Heinz *)

Crossrefs

Column k=3 of A276727.

Cf. A000045, A129847, A320616.

Sequence in context: A232534 A274594 A062422 * A266465 A079864 A131045

Adjacent sequences: A320550 A320551 A320552 * A320554 A320555 A320556

Keyword

nonn,easy

Author

Alois P. Heinz, Oct 15 2018

Status

approved