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

5, 17, 45, 121, 336, 901, 2347, 6014, 15314, 38766, 97531, 244054, 608339, 1511919, 3748379, 9273353, 22901665, 56477538, 139114445, 342325451, 841676972, 2067997764, 5078117000, 12463618356, 30577931115, 74993361731, 183870516407, 450708620604, 1104563863868

Offset: 4

Author

Alois P. Heinz, Oct 15 2018

Keywords

• nonn
• easy

Examples

			a(5) = 17: 1234|5, 124|35, 124|3|5, 134|25, 134|2|5, 13|245, 13|25|4, 14|235, 14|23|5, 1|2345, 1|235|4, 14|25|3, 14|2|35, 14|2|3|5, 1|245|3, 1|25|34, 1|25|3|4.
		

Links

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

Crossrefs

Column k=4 of A276727.

Cf. A129847, A276720, A320617.

Programs

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)))(4):
seq(a(n), n=4..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 = 4}, A[n, k] - If[k == 0, 0, A[n, k - 1]]];
a /@ Range[4, 35] (* Jean-François Alcover, Dec 08 2020, after Alois P. Heinz *)

Formula

G.f.: -(-x^8 -3*x^7 +x^6 +7*x^5 +5*x^4) / (x^12 +5*x^11 +7*x^10 -x^9 -13*x^8 -19*x^7 -14*x^6 -6*x^5 +x^4 +2*x^2 +2*x-1).

a(n) = A276720(n) - A129847(n).