A318531 Number of finite sets of set partitions of {1,...,n} such that any two have join {{1,...,n}}.

2, 4, 18, 450, 436270

Offset

1,1

Links

Table of n, a(n) for n=1..5.

Example

The a(3) = 18 sets of set partitions:
        0
    {{1,2,3}}
   {{1,3},{2}}
   {{1,2},{3}}
   {{1},{2,3}}
  {{1},{2},{3}}
   {{1,3},{2}}   {{1,2,3}}
   {{1,2},{3}}   {{1,2,3}}
   {{1,2},{3}}  {{1,3},{2}}
   {{1},{2,3}}   {{1,2,3}}
   {{1},{2,3}}  {{1,3},{2}}
   {{1},{2,3}}  {{1,2},{3}}
  {{1},{2},{3}}  {{1,2,3}}
   {{1,2},{3}}  {{1,3},{2}}   {{1,2,3}}
   {{1},{2,3}}  {{1,3},{2}}   {{1,2,3}}
   {{1},{2,3}}  {{1,2},{3}}   {{1,2,3}}
   {{1},{2,3}}  {{1,2},{3}}  {{1,3},{2}}
   {{1},{2,3}}  {{1,2},{3}}  {{1,3},{2}}  {{1,2,3}}

Mathematica

stableSets[u_, Q_]:=If[Length[u]===0, {{}}, With[{w=First[u]}, Join[stableSets[DeleteCases[u, w], Q], Prepend[#, w]&/@stableSets[DeleteCases[u, r_/; r===w||Q[r, w]||Q[w, r]], Q]]]];
sps[{}]:={{}}; sps[set:{i_, ___}]:=Join@@Function[s, Prepend[#, s]&/@sps[Complement[set, s]]]/@Cases[Subsets[set], {i, ___}];
csm[s_]:=With[{c=Select[Tuples[Range[Length[s]], 2], And[OrderedQ[#], UnsameQ@@#, Length[Intersection@@s[[#]]]>0]&]}, If[c=={}, s, csm[Union[Append[Delete[s, List/@c[[1]]], Union@@s[[c[[1]]]]]]]]];
Table[Length[stableSets[sps[Range[n]], Length[csm[Union[#1, #2]]]>1&]], {n, 4}]

Crossrefs

Cf. A000110, A000258, A008277, A059849, A060639, A096827, A181939.

Cf. A318389, A318390, A318391, A318392, A318394, A318532.

Sequence in context: A347514 A306193 A323702 * A009667 A356123 A009508

Adjacent sequences: A318528 A318529 A318530 * A318532 A318533 A318534

Keyword

nonn,more

Author

Gus Wiseman, Aug 28 2018

Status

approved