A271270
Number of set partitions of [n] such that for each pair of consecutive blocks (b,b+1) at least one pair of consecutive numbers (i,i+1) exists with i member of b and i+1 member of b+1.
Original entry on oeis.org
1, 1, 2, 5, 14, 43, 145, 536, 2157, 9371, 43630, 216397, 1137703, 6313675, 36848992, 225464838, 1442216870, 9620746697, 66781675113, 481413175433, 3597627996006, 27825925290597, 222422033403527, 1834910286704787, 15603508329713182, 136616625732498989
Offset: 0
A000110(4) - a(4) = 15 - 14 = 1: 13|2|4.
A000110(5) - a(5) = 52 - 43 = 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[], 1}={1}, 1, 0), add(b(n-1, j, max(m, j),
`if`(j=m+1, [l[], `if`(j=i+1, 1, 0)],
`if`(j=i+1, 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[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_] := b[n, 0, 0, {}]; Table[a[n], {n, 0, 18}] (* Jean-François Alcover, Jan 30 2017, translated from Maple *)
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 *)
A271273
Number of set partitions of [n] into m blocks such that at least one pair of distinct cyclically consecutive blocks (b,c) = (b,(b mod m)+1) exists having no pair of numbers (i,j) = (i,(i mod n)+1) with i member of b and j member of c.
Original entry on oeis.org
0, 0, 0, 0, 2, 16, 93, 503, 2736, 15397, 90556, 558245, 3607387, 24409819, 172696471, 1275310652, 9813238958, 78548445033, 652960116962, 5628482431333, 50236822145840, 463647958566143, 4419123858908203, 43445718995990792, 440083379418080388, 4588225614805060248
Offset: 0
a(4) = 2: 13|2|4, 1|24|3.
a(5) = 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-> 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[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_] := BellB[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