WOLFRAM NOTEBOOK

Legacy (ignore)

In[]:=
WolframModel[{{{1},{1,2}}{{1,2},{2}},{{1,2},{2,2,2},{2,3}}{{1,2},{3,3,3,3},{2,3}},{{1,2},{2,2,2,2},{2,3}}{{1,2},{1,1,1},{2,3}}},Append[Catenate[Table[{{i,i+1},{1,1,1}+i,{i+1,i+2}},{i,1,19,2}]],{2}],20,"StatesPlotsList"]
Out[]=
In[]:=
WolframModelPlot[{{1,2},{2,3,4},{4,5},{5,6,7},{7,8},{8,9,10},{10,11},{11,12,1}}]
Out[]=
In[]:=
#/.Max[#]1&@Catenate[#+{{1,2},{2,3,4,5}}&/@Range[0,20,4]]
Out[]=
{{1,2},{2,3,4,5},{5,6},{6,7,8,9},{9,10},{10,11,12,13},{13,14},{14,15,16,17},{17,18},{18,19,20,21},{21,22},{22,23,24,1}}
In[]:=
Norm[{0.8675851446178168`,3.973369616111425`}]
Out[]=
4.06699
In[]:=
coordinates=With[{center=Mean/@Transpose[#]},With[{matrix=RotationMatrix[{#1-center,{0,Norm[#1-center]}}]},With[{firstVertexFixedCoordinates=matrix.(#-center)&/@#},If[firstVertexFixedCoordinates2,1<0,{-#1,#2}&@@@firstVertexFixedCoordinates,firstVertexFixedCoordinates]]]]&@SetReplace`PackageScope`hypergraphEmbedding["Ordered","Polygons",{}][#]1,All,2,1,1&/@WolframModel[{{1,2},{2,3,4,5}}{{1,2,3,4},{4,5}},{{1,2},{2,3,4,5},{5,6},{6,7,8,9},{9,10},{10,11,12,13},{13,14},{14,15,16,17},{17,18},{18,19,20,21},{21,22},{22,23,24,25},{25,1}},20,"StatesList"];
In[]:=
evolution=WolframModel[{{1,2},{2,3,4,5}}{{1,2,3,4},{4,5}},{{1,2},{2,3,4,5},{5,6},{6,7,8,9},{9,10},{10,11,12,13},{13,14},{14,15,16,17},{17,18},{18,19,20,21},{21,22},{22,23,24,25},{25,1}},20]
Out[]=
In[]:=
MapThread[WolframModelPlot[#,VertexCoordinateRulesThread[Range[25]#2]]&,{evolution["StatesList"],coordinates}]
Out[]=
In[]:=
Graph3D@evolution["CausalGraph"]
Out[]=
In[]:=
#/.Max[#]1&@Catenate[#+{{1,2},{2,3,4,5}}&/@Range[0,100,4]]
Out[]=
In[]:=
evolution=WolframModel[{{1,2},{2,3,4,5}}{{1,2,3,4},{4,5}},{{1,2},{2,3,4,5},{5,6},{6,7,8,9},{9,10},{10,11,12,13},{13,14},{14,15,16,17},{17,18},{18,19,20,21},{21,22},{22,23,24,25},{25,26},{26,27,28,29},{29,30},{30,31,32,33},{33,34},{34,35,36,37},{37,38},{38,39,40,41},{41,42},{42,43,44,45},{45,46},{46,47,48,49},{49,50},{50,51,52,53},{53,54},{54,55,56,57},{57,58},{58,59,60,61},{61,62},{62,63,64,65},{65,66},{66,67,68,69},{69,70},{70,71,72,73},{73,74},{74,75,76,77},{77,78},{78,79,80,81},{81,82},{82,83,84,85},{85,86},{86,87,88,89},{89,90},{90,91,92,93},{93,94},{94,95,96,97},{97,98},{98,99,100,101},{101,102},{102,103,104,1},{1,2}},40]
Out[]=
In[]:=
coordinates=With[{center=Mean/@Transpose[#]},With[{matrix=RotationMatrix[{#1-center,{0,Norm[#1-center]}}]},With[{firstVertexFixedCoordinates=matrix.(#-center)&/@#},If[firstVertexFixedCoordinates2,1<0,{-#1,#2}&@@@firstVertexFixedCoordinates,firstVertexFixedCoordinates]]]]&@SetReplace`PackageScope`hypergraphEmbedding["Ordered","Polygons",{}][#]1,All,2,1,1&/@evolution["StatesList"];
In[]:=
MapThread[WolframModelPlot[#,VertexCoordinateRulesThread[Range[evolution["AtomsCountTotal"]]#2]]&,{evolution["StatesList"],coordinates}]

No particle

Small example

Large example

Bigger case

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.