A287417 Number A(n,k) of set partitions of [n] such that all absolute differences between least elements of consecutive blocks and between consecutive elements within the blocks are not larger than k; square array A(n,k), n>=0, k>=0, read by antidiagonals.
1, 1, 1, 1, 1, 0, 1, 1, 2, 0, 1, 1, 2, 3, 0, 1, 1, 2, 5, 4, 0, 1, 1, 2, 5, 12, 5, 0, 1, 1, 2, 5, 15, 27, 6, 0, 1, 1, 2, 5, 15, 46, 58, 7, 0, 1, 1, 2, 5, 15, 52, 139, 121, 8, 0, 1, 1, 2, 5, 15, 52, 187, 410, 248, 9, 0, 1, 1, 2, 5, 15, 52, 203, 677, 1189, 503, 10, 0
Offset: 0
Examples
A(5,3) = 46 = 52 - 6 = A000110(5) - 6 counts all set partitions of [5] except: 1234|5, 15|234, 15|23|4, 15|24|3, 15|2|34, 15|2|3|4. Square array A(n,k) begins: 1, 1, 1, 1, 1, 1, 1, 1, ... 1, 1, 1, 1, 1, 1, 1, 1, ... 0, 2, 2, 2, 2, 2, 2, 2, ... 0, 3, 5, 5, 5, 5, 5, 5, ... 0, 4, 12, 15, 15, 15, 15, 15, ... 0, 5, 27, 46, 52, 52, 52, 52, ... 0, 6, 58, 139, 187, 203, 203, 203, ... 0, 7, 121, 410, 677, 824, 877, 877, ...
Links
- Alois P. Heinz, Antidiagonals n = 0..40, flattened
- Wikipedia, Partition of a set
Crossrefs
Programs
-
Maple
b:= proc(n, k, l, t) option remember; `if`(n<1, 1, `if`(t-n>k, 0, b(n-1, k, map(x-> `if`(x-n>=k, [][], x), [l[], n]), n)) +add( b(n-1, k, sort(map(x-> `if`(x-n>=k, [][], x), subsop(j=n, l))), `if`(t-n>k, infinity, t)), j=1..nops(l))) end: A:= (n, k)-> b(n, min(k, n-1), [], n): seq(seq(A(n, d-n), n=0..d), d=0..14); -
Mathematica
b[n_, k_, l_, t_] := b[n, k, l, t] = If[n < 1, 1, If[t - n > k, 0, b[n - 1, k, If[# - n >= k, Nothing, #]& /@ Append[l, n], n]] + Sum[b[n - 1, k, Sort[If[# - n >= k, Nothing, #]& /@ ReplacePart[l, j -> n]], If[t - n > k, Infinity, t]], {j, 1, Length[l]}]]; A[n_, k_] := b[n, Min[k, n - 1], {}, n]; Table[A[n, d - n], {d, 0, 14}, { n, 0, d}] // Flatten (* Jean-François Alcover, May 24 2018, translated from Maple *)
Formula
A(n,k) = Sum_{j=0..k} A287416(n,j).