A185983
Triangle read by rows: number of set partitions of n elements with k circular connectors.
Original entry on oeis.org
1, 1, 0, 1, 0, 1, 1, 0, 3, 1, 1, 0, 8, 4, 2, 1, 1, 20, 15, 14, 1, 1, 6, 53, 61, 68, 11, 3, 1, 25, 159, 267, 295, 97, 32, 1, 1, 93, 556, 1184, 1339, 694, 242, 28, 3, 1, 346, 2195, 5366, 6620, 4436, 1762, 371, 48, 2, 1, 1356, 9413, 25400, 34991, 27497, 12977, 3650, 634, 53, 3
Offset: 0
For a(4,2) = 8, the set partitions are 1/234, 134/2, 124/3, 123/4, 12/34, 14/23, 1/24/3, and 13/2/4.
For a(5,1) = 1, the set partition is 13/25/4.
For a(6,6) = 3, the set partitions are 135/246, 14/25/36, 1/2/3/4/5/6.
Triangle begins:
1;
1, 0;
1, 0, 1;
1, 0, 3, 1;
1, 0, 8, 4, 2;
1, 1, 20, 15, 14, 1;
1, 6, 53, 61, 68, 11, 3;
...
-
b:= proc(n, i, m, t) option remember; `if`(n=0, x^(t+
`if`(i=m and m<>1, 1, 0)), add(expand(b(n-1, j,
max(m, j), `if`(j=m+1, 0, t+`if`(j=1 and i=m
and j<>m, 1, 0)))*`if`(j=i+1, x, 1)), j=1..m+1))
end:
T:= n-> (p-> seq(coeff(p, x, i), i=0..n))(b(n, 1, 0$2)):
seq(T(n), n=0..12); # Alois P. Heinz, Mar 30 2016
-
b[n_, i_, m_, t_] := b[n, i, m, t] = If[n == 0, x^(t + If[i == m && m != 1, 1, 0]), Sum[Expand[b[n - 1, j, Max[m, j], If[j == m + 1, 0, t + If[j == 1 && i == m && j != m, 1, 0]]]*If[j == i + 1, x, 1]], {j, 1, m + 1}]];
T[n_] := Function[p, Table[Coefficient[p, x, i], {i, 0, n}]][b[n, 1, 0, 0] ];
Table[T[n], {n, 0, 12}] // Flatten (* Jean-François Alcover, May 19 2016, after Alois P. Heinz *)
A271271
Number of set partitions of [n] such that at least one pair of consecutive blocks (b,b+1) exists having no pair of consecutive numbers (i,i+1) with i member of b and i+1 member of b+1.
Original entry on oeis.org
0, 0, 0, 0, 1, 9, 58, 341, 1983, 11776, 72345, 462173, 3075894, 21330762, 154050330, 1157493707, 9037925277, 73244123107, 615295131046, 5351329029624, 48126530239366, 447043890866154, 4284293705043796, 42317095568379559, 430355360965092107, 4501973706497500364
Offset: 0
a(4) = 1: 13|2|4.
a(5) = 9: 124|3|5, 134|2|5, 135|2|4, 13|25|4, 13|2|45, 13|2|4|5, 14|23|5, 14|2|3|5, 1|24|3|5.
-
b:= proc(n, i, m, l) option remember; `if`(n=0,
`if`(l=[] or {l[]}={1}, 1, 0), add(b(n-1, j, max(m, j),
`if`(j=m+1, `if`(j=i+1, [l[],1], [l[],0]),
`if`(j=i+1, subsop(j=1, l), l))), j=1..m+1))
end:
a:= n-> combinat[bell](n)-b(n, 0$2, []):
seq(a(n), n=0..18);
-
b[n_, i_, m_, l_] := b[n, i, m, l] = If[n == 0, If[Union[l, {1}] == {1}, 1, 0], Sum[b[n-1, j, Max[m, j], If[j == m+1, Join[l, If[j == i+1, {1}, {0}] ], If[j == i+1, ReplacePart[l, j -> 1], l]]], {j, 1, m+1}]]; a[n_] := BellB[n] - b[n, 0, 0, {}]; Table[a[n], {n, 0, 18}] (* Jean-François Alcover, Feb 02 2017, translated from Maple *)
A271272
Number of set partitions of [n] into m blocks such that for each pair of distinct cyclically consecutive blocks (b,c) = (b,(b mod m)+1) at least one pair of numbers (i,j) = (i,(i mod n)+1) exists with i member of b and j member of c.
Original entry on oeis.org
1, 1, 2, 5, 13, 36, 110, 374, 1404, 5750, 25419, 120325, 606210, 3234618, 18202851, 107647893, 666903189, 4316424771, 29116689197, 204259773724, 1487336089532, 11221857590608, 87591879539120, 706286859093554, 5875489876724901, 50364717424939105, 444367708336858660
Offset: 0
A000110(4) - a(4) = 15 - 13 = 2: 13|2|4, 1|24|3.
A000110(5) - a(5) = 52 - 36 = 16: 124|3|5, 12|35|4, 134|2|5, 135|2|4, 13|25|4, 13|2|45, 13|2|4|5, 14|23|5, 1|235|4, 14|2|3|5, 15|24|3, 1|245|3, 1|24|3|5, 1|25|34, 1|25|3|4, 1|2|35|4.
-
b:= proc(n, i, m, l) option remember; `if`(n=0,
`if`(l=[] or {l[]}={1} or i=m and {subsop(1=1, l)[]}=
{1}, 1, 0), add(b(n-1, j, max(m, j), `if`(l=[], [1],
`if`(j=m+1, subsop(1=0, `if`(j=i+1, [l[],1], [l[],0])),
`if`(j=i+1 or j=1 and i=m, subsop(j=1, l), l)))), j=1..m+1))
end:
a:= n-> b(n, 0$2, []):
seq(a(n), n=0..18);
-
b[n_, i_, m_, l_] := b[n, i, m, l] = If[n==0, If[l=={} || Union[l]=={1} || i==m && Union @ ReplacePart[l, 1 -> 1] == {1}, 1, 0], Sum[b[n-1, j, Max[m, j], If[l=={}, {1}, If[j==m+1, ReplacePart[If[j==i+1, Append[l, 1], Append[l, 0]], 1 -> 0], If[j==i+1 || j==1 && i==m, ReplacePart[l, j -> 1], l]]]], {j, 1, m+1}]]; a[n_] := b[n, 0, 0, {}]; Table[a[n], {n, 0, 18} ] (* Jean-François Alcover, Feb 15 2017, translated from Maple *)
Showing 1-3 of 3 results.
Comments