cp's OEIS Frontend

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

%I A318531 #6 Aug 29 2018 16:49:13
%S A318531 2,4,18,450,436270
%N A318531 Number of finite sets of set partitions of {1,...,n} such that any two have join {{1,...,n}}.
%e A318531 The a(3) = 18 sets of set partitions:
%e A318531         0
%e A318531     {{1,2,3}}
%e A318531    {{1,3},{2}}
%e A318531    {{1,2},{3}}
%e A318531    {{1},{2,3}}
%e A318531   {{1},{2},{3}}
%e A318531    {{1,3},{2}}   {{1,2,3}}
%e A318531    {{1,2},{3}}   {{1,2,3}}
%e A318531    {{1,2},{3}}  {{1,3},{2}}
%e A318531    {{1},{2,3}}   {{1,2,3}}
%e A318531    {{1},{2,3}}  {{1,3},{2}}
%e A318531    {{1},{2,3}}  {{1,2},{3}}
%e A318531   {{1},{2},{3}}  {{1,2,3}}
%e A318531    {{1,2},{3}}  {{1,3},{2}}   {{1,2,3}}
%e A318531    {{1},{2,3}}  {{1,3},{2}}   {{1,2,3}}
%e A318531    {{1},{2,3}}  {{1,2},{3}}   {{1,2,3}}
%e A318531    {{1},{2,3}}  {{1,2},{3}}  {{1,3},{2}}
%e A318531    {{1},{2,3}}  {{1,2},{3}}  {{1,3},{2}}  {{1,2,3}}
%t A318531 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]]]];
%t A318531 sps[{}]:={{}};sps[set:{i_,___}]:=Join@@Function[s,Prepend[#,s]&/@sps[Complement[set,s]]]/@Cases[Subsets[set],{i,___}];
%t A318531 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]]]]]]]]];
%t A318531 Table[Length[stableSets[sps[Range[n]],Length[csm[Union[#1,#2]]]>1&]],{n,4}]
%Y A318531 Cf. A000110, A000258, A008277, A059849, A060639, A096827, A181939.
%Y A318531 Cf. A318389, A318390, A318391, A318392, A318394, A318532.
%K A318531 nonn,more
%O A318531 1,1
%A A318531 _Gus Wiseman_, Aug 28 2018