WOLFRAM NOTEBOOK

Colored Networks --- Simplified

In[]:=
<<SetReplace`

Approach

[[ Same as before, but without explicit vertices ]]
In[]:=
init={{p1r,p1y,p1g},{p2r,p2y,p2g},{p1r,p2r},{p2r,p1r},{p1y,p2y},{p2y,p1y},{p1g,p2g},{p2g,p1g}};

1

In[]:=
evolution1=WolframModel[{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1r,p2r},{p2r,p1r}}{{p1g,p3y,p3g},{p4r,p4y,p1y},{p2g,p5y,p5g},{p6r,p6y,p2y},{p3y,p4r},{p3g,p5g},{p4r,p3y},{p4y,p6y},{p5y,p6r},{p5g,p3g},{p6r,p5y},{p6y,p4y}},init,8]
Out[]=
In[]:=
HypergraphPlot[evolution1[-1]]
Out[]=

2

In[]:=
evolution2=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}},init,8]
Out[]=
In[]:=
HypergraphPlot[evolution2[-1]]
Out[]=
In[]:=
evolution2=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}},init,10]
Out[]=
In[]:=
HypergraphPlot[evolution2[-1]]
Out[]=

3

In[]:=
evolution3=WolframModel[{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1r,p2r},{p2r,p1r}}{{p1g,p3y,p3g},{p1y,p4y,p4g},{p2g,p5y,p5g},{p2y,p6y,p6g},{p3y,p5y},{p3g,p4g},{p4y,p6y},{p4g,p3g},{p5y,p3y},{p5g,p6g},{p6y,p4y},{p6g,p5g}},init,8]
Out[]=
In[]:=
HypergraphPlot[evolution3[-1]]
Out[]=

4

In[]:=
evolution4=WolframModel[{{p1r,p1y,p1g},{p2r,p2y,p2g},{p1y,p2y},{p2y,p1y}}{{p3r,p1r,p3g},{p4r,p1g,p4g},{p5r,p2r,p5g},{p6r,p2g,p6g},{p3r,p6r},{p3g,p4g},{p4r,p5r},{p4g,p3g},{p5r,p4r},{p5g,p6g},{p6r,p3r},{p6g,p5g}},init,8]
Out[]=
In[]:=
HypergraphPlot[evolution4[-1]]
Out[]=

5

6

7

Wolfram Cloud

You are using a browser not supported by the Wolfram Cloud

Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.


I understand and wish to continue anyway »

You are using a browser not supported by the Wolfram Cloud. Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.