AgeHypergraphPlot[WolframModel[#,{{0,0,0},{0,0,0}},500],"RedBlueTones",.002]&/@{{{1,2,2},{3,1,4}}{{2,5,2},{2,3,5},{4,5,5}},{{1,1,2},{1,3,4}}{{4,4,3},{2,5,3},{2,5,3}},{{1,1,2},{1,3,4}}{{4,4,5},{5,4,2},{3,2,5}},{{1,2,1},{1,3,4}}{{4,5,4},{5,4,3},{1,2,5}}}
In[]:=
Out[]=
AgeHypergraphPlot[WolframModel[{{1,2,2},{3,1,4}}{{2,5,2},{2,3,5},{4,5,5}},{{0,0,0},{0,0,0}},100],"RedBlueTones",.002]
In[]:=
Out[]=
AgeHypergraphPlot[WolframModel[{{1,2,2},{3,1,4}}{{2,5,2},{2,3,5},{4,5,5}},{{0,0,0},{0,0,0}},101],"RedBlueTones",.002]
In[]:=
Out[]=
RulePlot[WolframModel[{{1,2,2},{3,1,4}}{{2,5,2},{2,3,5},{4,5,5}}]]
In[]:=
Out[]=
Table[AgeHypergraphPlot[WolframModel[{{1,2,2},{3,1,4}}{{2,5,2},{2,3,5},{4,5,5}},{{0,0,0},{0,0,0}},t],"RedBlueTones",.002],{t,97,99}]
In[]:=
Out[]=
Table[AgeHypergraphPlot[WolframModel[{{1,2,2},{3,1,4}}{{2,5,2},{2,3,5},{4,5,5}},{{0,0,0},{0,0,0}},t],"RedBlueTones",.002],{t,100,106}]
In[]:=
Out[]=
AgeHypergraphPlot[WolframModel[{{1,2,2},{3,1,4}}{{2,5,2},{2,3,5},{4,5,5}},{{0,0,0},{0,0,0},{0,0,0}},300],"RedBlueTones",.002]
In[]:=
Out[]=
AgeHypergraphPlot[WolframModel[{{1,1,2},{1,3,4}}{{4,4,3},{2,5,3},{2,5,3}},{{0,0,0},{0,0,0},{0,0,0}},300],"RedBlueTones",.002]
In[]:=
Out[]=
AgeHypergraphPlot[WolframModel[{{1,1,2},{1,3,4}}{{4,4,3},{2,5,3},{2,5,3}},{{0,0,0},{0,0,0},{0,0,0},{0,0,0}},300],"RedBlueTones",.002]
In[]:=
Out[]=
AgeHypergraphPlot[WolframModel[{{1,1,2},{1,3,4}}{{4,4,3},{2,5,3},{2,5,3}},{{0,0,0},{0,0,0},{0,0,0},{0,0,0}},10],"RedBlueTones",.002]
In[]:=
Out[]=
HypergraphPlot/@WolframModel[{{1,1,2},{1,3,4}}{{4,4,3},{2,5,3},{2,5,3}},{{0,0,0},{0,0,0},{0,0,0},{0,0,0}},10,"StatesList"]
In[]:=
Out[]=
HypergraphPlot/@WolframModel[{{1,1,2},{1,3,4}}{{4,4,3},{2,5,3},{2,5,3}},Table[{0,0,0},5],10,"StatesList"]
In[]:=
Out[]=
HypergraphPlot@WolframModel[{{1,1,2},{1,3,4}}{{4,4,3},{2,5,3},{2,5,3}},Table[{0,0,0},5],100,"FinalState"]
In[]:=
Out[]=
HypergraphPlot/@WolframModel[{{1,1,2},{1,3,4}}{{4,4,3},{2,5,3},{2,5,3}},{{0,0,0},{0,0,0},{0,0,0}},20,"StatesList"]
In[]:=
Out[]=
AgeHypergraphPlot[WolframModel[{{1,1,2},{1,3,4}}{{4,4,3},{2,5,3},{2,5,3}},{{0,0,0},{0,0,0}},300],"RedBlueTones",.002]
In[]:=
Out[]=
AgeHypergraphPlot[WolframModel[{{1,2,2},{3,1,4}}{{2,5,2},{2,3,5},{4,5,5}},{{0,0,0},{0,0,0},{0,0,0}},300],"RedBlueTones",.002]
GraphPlot3D[HypergraphToGraph[WolframModel[{{1,1,2},{1,3,4}}{{4,4,5},{5,4,2},{3,2,5}},{{0,0,0},{0,0,0}},500,"FinalState"]]]
In[]:=
Out[]=
GraphPlot3D[HypergraphToGraph[WolframModel[{{1,1,2},{1,3,4}}{{4,4,5},{5,4,2},{3,2,5}},{{0,0,0},{0,0,0}},600,"FinalState"]]]
In[]:=
Out[]=
GraphPlot3D[HypergraphToGraph[WolframModel[{{1,1,2},{1,3,4}}{{4,4,5},{5,4,2},{3,2,5}},{{0,0,0},{0,0,0}},50,"FinalState"]]]
In[]:=
Out[]=
GraphPlot3D[HypergraphToGraph[#],ImageSize400]&/@WolframModel[{{1,1,2},{1,3,4}}{{4,4,5},{5,4,2},{3,2,5}},{{0,0,0},{0,0,0}},30,"StatesList"]
In[]:=
Out[]=
GraphPlot3D[HypergraphToGraph[#],ImageSize400]&/@Take[WolframModel[{{1,1,2},{1,3,4}}{{4,4,5},{5,4,2},{3,2,5}},{{0,0,0},{0,0,0}},300,"StatesList"],10;;-1;;10]
In[]:=
Out[]=
HypergraphToGraph@WolframModel[{{1,1,2},{1,3,4}}{{4,4,5},{5,4,2},{3,2,5}},{{0,0,0},{0,0,0}},50,"FinalState"]
In[]:=
Out[]=
UndirectedGraph[%]
In[]:=
Out[]=
gx=
;
In[]:=
FindFundamentalCycles[%]
In[]:=
Out[]=
Length/@%250
In[]:=
{8,3,7,7,3,8,8,8,7,1,5,3,9,7,10,3,7,7,3,8,8,8,8,7,9,8,6,5,8,7,7,3,6,6,3,6,8,8,7,5,5,8,9,9,9,9,9,3,9,8,7,7,6,3,6,6,4,6,7,5,4,6,6,3,5,3,7,6,8,4,7,3,6,5,6,4,4,5,3,4,3,6,4,3,4,3,5,3,3}
Out[]=
Histogram[%]
In[]:=
Out[]=
HighlightGraph[gx,
gx500=UndirectedGraph[HypergraphToGraph@WolframModel[{{1,1,2},{1,3,4}}{{4,4,5},{5,4,2},{3,2,5}},{{0,0,0},{0,0,0}},500,"FinalState"]];
In[]:=
FindFundamentalCycles[UndirectedGraph[HypergraphToGraph@WolframModel[{{1,1,2},{1,3,4}}{{4,4,5},{5,4,2},{3,2,5}},{{0,0,0},{0,0,0}},500,"FinalState"]]];
In[]:=
Histogram[Length/@%]
In[]:=
Out[]=
HighlightGraph[gx500,Flatten[Select[%256,Length[#]17&]]]
In[]:=
Out[]=
GraphPlot3D[%]
In[]:=
Out[]=
GraphPlot3D[HighlightGraph[gx500,Flatten[Select[%256,Length[#]3&]]]]
In[]:=
Out[]=
With[{g=UndirectedGraph[HypergraphToGraph@WolframModel[{{1,1,2},{1,3,4}}{{4,4,5},{5,4,2},{3,2,5}},{{0,0,0},{0,0,0}},1000,"FinalState"]]},GraphPlot3D[HighlightGraph[g,Flatten[Select[FindFundamentalCycles[g],Length[#]3&]]]]]
In[]:=
Out[]=
With[{g=UndirectedGraph[HypergraphToGraph@WolframModel[{{1,1,2},{1,3,4}}{{4,4,5},{5,4,2},{3,2,5}},{{0,0,0},{0,0,0}},1500,"FinalState"]]},GraphPlot3D[HighlightGraph[g,Flatten[Select[FindFundamentalCycles[g],Length[#]3&]]]]]
In[]:=
Out[]=
With[{g=UndirectedGraph[HypergraphToGraph@WolframModel[{{1,1,2},{1,3,4}}{{4,4,5},{5,4,2},{3,2,5}},{{0,0,0},{0,0,0}},2000,"FinalState"]]},GraphPlot3D[HighlightGraph[g,Flatten[Select[FindFundamentalCycles[g],Length[#]3&]]]]]
In[]:=
Out[]=
With[{g=UndirectedGraph[HypergraphToGraph@WolframModel[{{1,1,2},{1,3,4}}{{4,4,5},{5,4,2},{3,2,5}},{{0,0,0},{0,0,0}},2000,"FinalState"]]},GraphPlot3D[HighlightGraph[g,Flatten[Select[FindFundamentalCycles[g],Length[#]4&]]]]]
In[]:=
Out[]=
ContourPlot3D[x^3+y^2+z0,{x,-10,10},{y,-10,10},{z,-10,10}]
In[]:=
Out[]=
ContourPlot3D[x^2+y^2+z^210,{x,-10,10},{y,-10,10},{z,-10,10}]
In[]:=
Out[]=
ContourPlot3D[x^2+y^3+z^210,{x,-10,10},{y,-10,10},{z,-10,10}]
In[]:=
Out[]=
ContourPlot3D[x^3+y^3+z^320,{x,-10,10},{y,-10,10},{z,-10,10}]
In[]:=
Out[]=
ContourPlot3D[x^3+y^3+z^30,{x,-10,10},{y,-10,10},{z,-10,10}]
In[]:=
Out[]=
ContourPlot3D[x^5+y^5+z^50,{x,-10,10},{y,-10,10},{z,-10,10}]
In[]:=
Out[]=
ContourPlot3D[x+y+z0,{x,-10,10},{y,-10,10},{z,-10,10}]
In[]:=
Out[]=
ContourPlot3D[x^2+y^3+z^40,{x,-10,10},{y,-10,10},{z,-10,10}]
In[]:=
Out[]=
gpts=GraphEmbedding[HypergraphToGraph@WolframModel[{{1,1,2},{1,3,4}}{{4,4,5},{5,4,2},{3,2,5}},{{0,0,0},{0,0,0}},2000,"FinalState"],"SpringElectricalEmbedding",3];
In[]:=
Graphics3D[Point[gpts]]
In[]:=
Out[]=
Mean[gpts]
In[]:=
{20.6483,13.5298,7.95267}
Out[]=
Graphics3D[{Point[gpts],Red,PointSize[.04],Point[Mean[gpts]]}]
In[]:=
Out[]=
Graphics3D[{Point[gpts],Red,PointSize[.04],Point[Mean[gpts]]},AxesTrue]
In[]:=
Out[]=
Graphics3D[{Point[gpts],Red,PointSize[.04],Point[Mean[gpts]]},AxesTrue,PlotRange{{0,30},Automatic,Automatic}]
In[]:=
Out[]=
Graphics3D[{Point[gpts],Red,PointSize[.04],Point[Mean[gpts]]},AxesTrue,PlotRange{{30,Automatic},Automatic,Automatic}]
In[]:=
Out[]=
cornucopia