Graph that visualizes subset relations

First, off I am a bloody beginner when it comes to programming in general and Mathematica in particular. I only started using it so I can make sense of my suggestions for the semantics in my syntax thesis ( I am a generativist linguist). Please be gentle. I have the following problem: I would like to visualize the subset relation of a given Set e.g.

A = {{{M1, W2}, {M1, W3}, {M1, W4}, {M2, W1}, {M2, W2}, {M2, W3}, {M2, W4},
{M3, W1}, {M3, W2}, {M3, W3}, {M3, W4}, {M4, W1}, {M4, W2}, {M4, W3}, {M4, W4},
{M1,M2,M3,W1,W2,W3}, {M1,M2,M3,M4,W1,W2,W3,W4}}}


Now I have found this code here:

ClearAll[hasseF]
hasseF = TransitiveReductionGraph@*RelationGraph
hasseF[SubsetQ, Subsets[{{M1, W1}, {M1, W2}, {M2, W1}, {M2, W2}}],
VertexShapeFunction -> "Name"]


However, I have four issues with this:

1. It displays the sets as matrices (?), not as sets. I would like them to be displayed as sets

2. The arrows should either go into the opposite direction or there shouldn't be any arrow tips at all (which I would prefer honestly).

3. The whole thing looks a bit crooked. Is there any way to make it look more symmetrical?

4. The only way to feed it sets is via the subsets function, however the set I posted in the introduction is a subset of a powerset.

Nicolas

• TransitiveReductionGraph is still buggy as of Mathematica 12.0 (but I'm very optimistic about a fix in 12.1). The graph you construct with RelationGraph has vertices that are lists. Of course, such as graph is extremely useful. But unfortunately, several built-in functions (including Subgraph) will mishandle such graphs. Thus it's somewhat dangerous to use them. Dec 11 '19 at 13:09

Reversing the graph and reformatting the nodes should get you started:

ClearAll[hasseF]
vf[{xc_, yc_}, name_, {w_, h_}] :=   Text[Grid[name, Dividers -> {False, True}], {xc, yc}];
hasseF = ReverseGraph@*TransitiveReductionGraph@*RelationGraph

hasseF[
SubsetQ,
Subsets[{{M1, W1}, {M1, W2}, {M2, W1}, {M2, W2}}],
VertexShapeFunction -> vf
]


Edit:

@Henrik's comment was correct. But after reflecting on the other parts of your question, I suspect a simpler answer might be in hand. Is this what you wanted?

a1 = {{M1, W2}, {M1, W3}, {M1, W4}, {M2, W1}, {M2, W2}, {M2, W3}, {M2,
W4}, {M3, W1}, {M3, W2}, {M3, W3}, {M3, W4}, {M4, W1}, {M4,
W2}, {M4, W3}, {M4, W4}, {M1, M2, M3, W1, W2, W3}, {M1, M2, M3, M4,
W1, W2, W3, W4}};
TransitiveReductionGraph@RelationGraph[Not[SubsetQ[#1, #2]] && SubsetQ[#2, #1] &, a1,
VertexShapeFunction -> "Name", ImageSize -> Full]

• Thank you Alan, however your code doesn't do anything when I copy paste it. I am probably missing the point here, but as I said I am not really aware of what I'm doing here. Nov 17 '19 at 17:34
• I believe that @Alan only forgot to tell you to use vf as VertexShapeFunction. You may also try the following vertex shape function vf[{xc_, yc_}, name_, {w_, h_}] := {Black, Text[InputForm[name], {xc, yc}]};. Alas, bad spacing then leads to overlaps... Nov 17 '19 at 17:40
• All that is missing is a semicolon. Nov 17 '19 at 17:51
• Thank you so much you guys @Alan, Henrik and David. Henrik's solution works for me: I just replaced the subsets function with the actual set I need: My sets are not really the powerset of {{M1, W1}, {M1, W2}, {M2, W1}, {M2, W2}}. They are a subset of the powerset (for those who are interested I am working on a semantics that derives that the men and women must minimally be four people, minimally containing two men and two women). Your alternative would not really striaghtforwardly show what I want to show, Alan. The only thing I would like to get rid of are the arrow tips. Nov 17 '19 at 18:09

You may use ResourceFunction UpSetChart from the Wolfram Function Repository.

With A in OP then

ResourceFunction["UpSetChart"][A]


As the contributor of the function any feedback on its utility is welcome.

Hope this helps.