Here's a naive brute-force approach using lists. First, let's take advantage of the fact that in `Subsets[X]`, `{}` always appears first and `X` appears last; and that in `Subsets[PX]`, the order of elements in `PX` is preserved. That means we can just check the first and last element to see if `{}` and `X` are members: ``` bounded[F_, X_] := Cases[F, {{}, ___, X}] ``` Then we test for intersections as you do, except we use `Subsets`; while `Tuples` is faster, this lets us perform fewer `Intersection`s: ``` intersectionClosedQ[F_] := SubsetQ[F, Intersection @@@ Subsets[F, {2}]] ``` For the third condition, we break it up into several steps. First we get the pairs of nonempty disjoint sets. We'll do this readably by filtering the length-2 subsets of $\mathcal{F}$—we can optimize later! (In particular, if we had kept track of information about which elements were formed as intersections of which other elements in the previous step, we could look at the preimage of `{}`. Maybe we should have also hung onto `Subsets[F]`.) We can also take advantage of the fact that we know the first element of any family will be `{}`, so we can just drop the first element as a way to consider only nonempty sets, instead of writing something like `DeleteCases[F, {}]`. ``` disjointPairs[F_] := Select[Subsets[Drop[F, 1], {2}], Apply[DisjointQ]] ``` Then we create the weak closure-under-complementation condition. "There exists" translates into `Or` or `AnyTrue`, and `Complement` implements the set complement. (The `f[a][b]` syntax just makes mapping a little more convenient via when we're ready to do it (via `AllTrue`), but we could just as well use a function with two arguments instead.) I'm guessing it's better computationally to compute the set of all pairs of complemented sets in $\mathcal{F}$ first. We also preserve "duplicates"—pairs of the form $(H, \bar{H})$ and $(\bar{H}, H)$ are both included—so that comparing is easy later. ``` complementedPairs[F_, X_] := Select[{#, Complement[X, #]} & /@ F, MemberQ[F, #[[2]]] &] weaklyComplementedPairQ[cpF_][disjointpair_] := AnyTrue[cpF, And @@ MapThread[SubsetQ, {#, disjointpair}] &] (* A potential optimization would be to compute disjointPairs[F] first, and only proceed if nonempty. *) weaklyComplementedQ[F_, X_] := AllTrue[disjointPairs[F], weaklyComplementedPairQ[complementedPairs[F, X]]] ``` Putting it all together: ``` validFamilies[n_Integer?Positive] := With[{X = Range[n]}, Select[bounded[Subsets@Subsets@X, X], F |-> intersectionClosedQ[F] && weaklyComplementedQ[F, X] ]] bruteForceA[n_Integer?Positive] := Length[validFamilies[n]] ``` With these definitions, we find that `Table[bruteForceA[n], {n,1,4}]` is `{1, 4, 35, 857}`. Evaluating `bruteForceA[5]` takes up over 25 GB of temporary storage and then crashes my kernel. So, some optimization is required to proceed further. I recommend inspecting `validFamilies[n]` for small values of `n` to make sure it works as expected! This computation can be optimized far more than it currently is, so perhaps `bruteForceA[5]` is not totally intractable; also, there's the (admittedly small) chance of a closed-form solution. Even "carving out" certain spaces of valid families, getting a closed form for those, then counting the rest manually might help. If I have time, I'd like to try to optimize this! We might `Compile` to C code and represent subsets as integers. Also, instead of building all families and then filtering, we could try to find a way to only build valid families in the first place.