login
A318394
Number of finite sets of set partitions of {1,...,n} such that any two have meet {{1},...,{n}}.
4
2, 4, 18, 316, 37492
OFFSET
1,1
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,2},{3}} {{1,3},{2}}
{{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},{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,3},{2}}
{{1},{2},{3}} {{1},{2,3}} {{1,2},{3}}
{{1},{2},{3}} {{1},{2,3}} {{1,2},{3}} {{1,3},{2}}
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, ___}];
spmeet[a_, b_]:=DeleteCases[Union@@Outer[Intersection, a, b, 1], {}]; spmeet[a_, b_, c__]:=spmeet[spmeet[a, b], c];
Table[Length[stableSets[sps[Range[n]], Max@@Length/@spmeet[#1, #2]>1&]], {n, 5}]
KEYWORD
nonn,more
AUTHOR
Gus Wiseman, Aug 25 2018
STATUS
approved