In[]:=
HypergraphPlotSW[list_,opts___]:=Module[{wtfun=(1/Length[#]&),rules=Flatten[Function[e,Annotation[#,EdgeWeight(wtfun[e])]&/@(If[Length[e]>2,Append[#,Style[Last[e]First[e],Opacity[0]]],#]&@(Rule@@@Partition[e,2,1]))]/@list],g,rep},g=Graph[rules,opts];rep=Thread[VertexList[g]->GraphEmbedding[g]];GraphPlot[g,Prolog{Style[If[Length[#]>2,Polygon[#/.rep],{}],Opacity[.3],Lighter[Blue,.7]]&/@list},opts]]
In[]:=
HypergraphPlotSW[{{1,2,3},{2,3,4},{3,4,1}}]
Out[]=
In[]:=
OrderedHypergraphPlot[{{1,2,3},{2,3,4},{3,4,1}},"HyperedgeStyle""Colors"]
Out[]=
In[]:=
HypergraphPlotSW/@({{1,2,3}}{{5,6,1},{6,4,2},{4,5,3}})
Out[]=
In[]:=
Map[HypergraphPlotSW[#,VertexLabelsAutomatic]&,({{p1r,p1y,p1g},{p2r,p2y,p2g},{p1r,p2r},{p2r,p1r}}{{p1g,p3y,p3g},{p4r,p4y,p1y},{p2g,p5y,p5g},{p6r,p6y,p2y},{p3y,p6y},{p3g,p4r},{p4r,p3g},{p4y,p5y},{p5y,p4y},{p5g,p6r},{p6r,p5g},{p6y,p3y}})]
Out[]=
In[]:=
HypergraphPlotSW@WolframModel[{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1r,p2r},{p2r,p1r}}{{p1g,p3y,p3g},{p1y,p4y,p4g},{p2g,p5y,p5g},{p2y,p6y,p6g},{p3y,p6g},{p3g,p4y},{p4y,p3g},{p4g,p5y},{p5y,p4g},{p5g,p6y},{p6y,p5g},{p6g,p3y}},{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1r,p2r},{p2r,p1r},{p1y,p2y},{p2y,p1y},{p1g,p2g},{p2g,p1g}},4,"FinalState"]
Out[]=
This fails because the edges are supposed to be of different styles but this does not work:
(Should be a self-3-edge) [Like a triangle folding on itself] [ take an equilateral triangle, and put all the points on top of each others, leaving the “fabric” hanging between them ]
In[]:=
HypergraphPlotSW[{{1,1,1}}]
Out[]=
In[]:=
Graphics[{Style[RegularPolygon[3],Opacity[.3],Lighter[Blue,.7]],Style[Disk[{0,0},.1],Gray]}]
Out[]=
In[]:=
Graph[{Style[12,Red],Style[12,Green]}]
Out[]=
In[]:=
$Version
Out[]=
12.1.0 for Mac OS X x86 (64-bit) (October 9, 2019)
In[]:=
HypergraphPlotSW[{{1,1,2}}]
Out[]=
In[]:=
HypergraphPlotSW[{{1,2,3}}]
Out[]=
In[]:=
HypergraphPlotSW[{{1,2,3,1,2}}]
Constrained Vertex Coordinates
Constrained Vertex Coordinates
RulePlot
RulePlot