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}] &]
(* If there are no nonempty disjoint pairs—a common situation—
return `True` without calculating further. *)
weaklyComplementedQ[{}] = True
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.