%I #16 Dec 08 2020 08:37:04
%S 2,5,12,29,66,145,315,676,1436,3031,6367,13323,27798,57873,120281,
%T 249657,517663,1072520,2220724,4595938,9508022,19664296,40659943,
%U 84057614,173750589,359110196,742150185,1533651213,3169118648,6548358736,13530454573,27956404705
%N 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.
%H Alois P. Heinz, <a href="/A320553/b320553.txt">Table of n, a(n) for n = 3..1000</a>
%F G.f.: (x+2)*x^3/((x^2+x-1)*(x^4+2*x^3+x^2+x-1)).
%F a(n) = A129847(n) - A000045(n+1).
%e a(4) = 5: 123|4, 13|24, 13|2|4, 1|234, 1|24|3.
%p b:= proc(n, m, l) option remember; `if`(n=0, 1,
%p add(b(n-1, max(m, j), [subsop(1=NULL, l)[],
%p `if`(j<=m, 0, j)]), j={l[], m+1} minus {0}))
%p end:
%p A:= (n, k)-> `if`(n=0, 1, `if`(k<2, k, b(n, 0, [0$(k-1)]))):
%p a:= n-> (k-> A(n, k) -`if`(k=0, 0, A(n, k-1)))(3):
%p seq(a(n), n=3..35);
%t 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}}]];
%t A[n_, k_] := If[n == 0, 1, If[k < 2, k, b[n, 0, Array[0 &, k - 1]]]];
%t a[n_] := With[{k = 3}, A[n, k] - If[k == 0, 0, A[n, k - 1]]];
%t a /@ Range[3, 35] (* _Jean-François Alcover_, Dec 08 2020, after _Alois P. Heinz_ *)
%Y Column k=3 of A276727.
%Y Cf. A000045, A129847, A320616.
%K nonn,easy
%O 3,1
%A _Alois P. Heinz_, Oct 15 2018