Code to enumerate a certain sequence

Denote by $$a(n)$$ the number of families $$\mathcal{F} \subseteq \mathcal{P}(X)$$ on a finite set $$X$$ with $$n$$ elements satisfying:

• $$\emptyset, X \in \mathcal{F}$$
• For all $$U, V \in \mathcal{F}$$ it holds ture that $$U \cap V \in \mathcal{F}$$
• For all $$x \in X$$ it holds true that $$\left \{ x \right \} \in \mathcal{F}$$

If we were to drop the last restriction, the sequence is given in OEIS as A102894.

Can someone help me and write a code to enumerate the sequence $$a(n)$$?

• Since $|X|=n$ one has $|\mathcal{P}(X)| = 2^n$ and $|\mathcal{P}(\mathcal{P}(X))| = 2^{2^n}$. This means that with a brute force approach, where one tries all subsets of the power set of $X$ and checks whether they satisfy your condition, there are $2^{2^n}$ candidates, which already for $n=6$ is prohibitive. So what is the largest $n$ you hope to get to? And what algorithm do you propose to get there, better than brute force? Jul 29 at 3:00
• Since I needed only the first few terms, I believe a brute force approach is just fine as of now. Jul 29 at 10:10
• You are counting Hausdorff topologies on X? yesterday
• No, such families $\mathcal{F}$ are not necessarily closed under union. yesterday

Adapting the code given in A102894, a brute force approach would be this.

(* Warning: Only use with n <= 4 *)
allCandidates[n_] := Subsets[Subsets[Range[n]]];
MemberQ[#,{}],
MemberQ[#,Range[n]],
SubsetQ[#,Intersection@@@Tuples[#,2]],
SubsetQ[#,Map[{#}&,Range[n]]]
]&];


With this I get

Table[a[n],{n,0,4}]
(* {1,1,1,8,545} *)


One can also look at the families, for example

allAdmissibleFamilies[3]
(*
{{{},{1},{2},{3},{1,2,3}},
{{},{1},{2},{3},{1,2},{1,2,3}},
{{},{1},{2},{3},{1,3},{1,2,3}},
{{},{1},{2},{3},{2,3},{1,2,3}},
{{},{1},{2},{3},{1,2},{1,3},{1,2,3}},
{{},{1},{2},{3},{1,2},{2,3},{1,2,3}},
{{},{1},{2},{3},{1,3},{2,3},{1,2,3}},
{{},{1},{2},{3},{1,2},{1,3},{2,3},{1,2,3}}}
*)


Note. This code has the benefit of being very readable. I think that might be its only benefit. Not only does it try all candidates, it even generates all candidates at once, which means that one immediately runs out of memory. Hence the recommendation to only use this for n <= 4. The first improvement would be a more memory-friendly brute force approach.

• What if we, instead the third condition, required complements of singletons to not be in the family $\mathcal{F}$? I belive we would only need to alter the part SubsetQ[#,Map[{#}&,Range[n]]] ? Jul 29 at 10:16
• @TianVlašić So no subsets of length $n-1$ you mean. I think you just have to replace SubsetQ[#,Map[{#}&,Range[n]]] by DisjointQ[#,Subsets[Range[n],{n-1}]]. Jul 29 at 10:22
• That works thank you! Jul 29 at 10:51
• Still keeping in mind that "altered" third condition of no subset of length $n-1$, do you propose any way to enumerate the number of such families on a set of 5 elements? I think it might be computationally possible. I found the sequence I initially requested on oeis as oeis.org/A334255, so its latter terms are known. yesterday