Generating a topological space diagram for an n-element set

Question

Over on StackOverflow I asked a similar question for the n=3 case, but the answer given doesn't easily generalize.

How can I make a diagram such as this:

But for a general n-element space instead?

Answer 1

I suspect this is a fundamentally difficult problem, because as you pointed out, it boils down to drawing hypergraphs which, it seems, Mathematica does not have built in support for.

It isn't hard though, to automatically generate some kind of visualization of topologies.

I used the elegant topologyQ function proposed by kguler over at the stackoverflow question you linked to:

topologyQ[x_List] := Intersection[x, #] === # &[
Union[{Union @@ x}, Intersection @@@ Rest@#, Union @@@ #] &@
Subsets@x]

And then a little bit of (substantially less elegant) code I wrote myself:

RandomTopoTable[n_] := 
Module[{Sets = 
 Reverse[Sort[
  RandomSample[#, RandomChoice[Range[Length[#]]]] &[
   Subsets[Range[n]]]]], 
GenerateRow = 
 Function[{set}, {#, Background -> If[MemberQ[set, #], Red, White],
     Frame -> True} & /@ Range[n]]}, 
{If[topologyQ[Sets] && MemberQ[Sets, Range[n]],
  Style["GOOD", Darker[Green]], Style["BAD", Red]], 
  Grid[({Range[n]}~Join~((Item @@@ # &) /@ (GenerateRow /@ Sets))), 
  Frame -> All, Background -> {Lighter[Gray], None}]}];

Table[Column[RandomTopoTable[3]], {20}]

And this is the output for n=3, but it works for other choices of n too:

This is presenting a random sample of the subsets of the subsets of original set, e.g. a random selection of "potential topologies".