PairedDimension[{rule_,init_,steps_}]:=With[{wm=WolframModel[rule,init,steps,"StatesList"]},GraphicsColumn[{HypergraphPlot[Last[wm]],ListLinePlot[(*ahackforaListLinePlotbug*)Select[Length[#]>3&]@(HypergraphDimensionEstimateList/@Select[wm,Length[#]>10&]),FrameTrue,PlotRange{0,Automatic}]},FrameTrue,FrameStyleLightGray]]
In[]:=
ParallelEvaluate[Off[ParallelMap::subpar]]
In[]:=
{Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null,Null}
Out[]=
In[]:=
HypergraphPlot::invalidEdges:First argument of HypergraphPlot must be list of lists, where elements represent vertices.
(kernel 63)
HypergraphPlot::invalidEdges:First argument of HypergraphPlot must be list of lists, where elements represent vertices.
(kernel 64)
HypergraphPlot
::invalidEdges
:First argument of HypergraphPlot must be list of lists, where elements represent vertices.
During evaluation of In[112]:=
HypergraphPlot
::invalidEdges
:First argument of HypergraphPlot must be list of lists, where elements represent vertices.
During evaluation of In[112]:=
Out[]=
{{{{x,y}}{{x,z},{y,z},{z,z}},{{1,1}},5},{{{x,y}}{{y,z},{y,w},{z,w},{z,x}},{{0,0}},6},{{{1,2,3}}{{4,4,2},{4,1,3}},{{0,0,0}},10},{{{1,2},{1,3}}{{1,4},{1,5},{2,4},{4,3},{5,3}},{{0,0},{0,0}},11},{{{1,2},{3,2}}{{4,5},{4,1},{5,1},{5,2},{3,4}},{{0,0},{0,0}},11},{{{1,2},{1,3},{4,2}}{{5,2},{5,2},{5,1},{5,4},{3,5}},{{0,0},{0,0},{0,0}},16},{{{1,2,3},{2,4,5}}{{4,5,4},{5,6,1},{3,2,6}},{{0,0,0},{0,0,0}},18},{{{1,2},{1,3},{4,2}}{{5,1},{5,1},{5,3},{5,4},{1,2}},{{0,0},{0,0},{0,0}},16},{{{1,2,3},{2,4,5}}{{6,7,2},{5,7,8},{4,2,8},{9,3,5}},{{0,0,0},{0,0,0}},18},{{{1,2,3},{1,4,5}}{{3,2,6},{2,5,6},{7,4,3},{1,8,7}},{{0,0,0},{0,0,0}},19},{{{1,2,3},{3,4}}{{5,5,5},{5,6,4},{3,1},{1,5}},{{0,0,0},{0,0}},16},{{{1,2,3},{2,4}}{{5,6,4},{4,1,6},{2,1},{3,6}},{{0,0,0},{0,0}},50}}
In[]:=
Out[]=
Length[%]
In[]:=
12
Out[]=
PairedDimension[{rule_,init_,steps_}]:=With[{wm=WolframModel[rule,init,steps,"StatesList"]},GraphicsColumn[{HypergraphPlot[Last[wm]],ListLinePlot[(*ahackforaListLinePlotbug*)Select[Length[#]>3&]@(HypergraphDimensionEstimateList/@(If[Length[#]>20,Take[#,1;;-1;;Floor[Length[#]/20]],#]&@Select[wm,Length[#]>10&])),FrameTrue,PlotRange{0,Automatic}]},FrameTrue,FrameStyleLightGray]]
GraphicsGrid[Partition[ParallelMapMonitored[PairedDimension,{{{{x,y}}{{x,z},{y,z},{z,z}},{{1,1}},5},{{{x,y}}{{y,z},{y,w},{z,w},{z,x}},{{0,0}},6},{{{1,2,3}}{{4,4,2},{4,1,3}},{{0,0,0}},10},{{{1,2},{1,3}}{{1,4},{1,5},{2,4},{4,3},{5,3}},{{0,0},{0,0}},11},{{{1,2},{3,2}}{{4,5},{4,1},{5,1},{5,2},{3,4}},{{0,0},{0,0}},11},{{{1,2},{1,3},{4,2}}{{5,2},{5,2},{5,1},{5,4},{3,5}},{{0,0},{0,0},{0,0}},16},{{{1,2,3},{2,4,5}}{{4,5,4},{5,6,1},{3,2,6}},{{0,0,0},{0,0,0}},18},{{{1,2},{1,3},{4,2}}{{5,1},{5,1},{5,3},{5,4},{1,2}},{{0,0},{0,0},{0,0}},16},{{{1,2,3},{2,4,5}}{{6,7,2},{5,7,8},{4,2,8},{9,3,5}},{{0,0,0},{0,0,0}},18},{{{1,2,3},{1,4,5}}{{3,2,6},{2,5,6},{7,4,3},{1,8,7}},{{0,0,0},{0,0,0}},19},{{{1,2,3},{3,4}}{{5,5,5},{5,6,4},{3,1},{1,5}},{{0,0,0},{0,0}},16},{{{1,2,3},{2,4}}{{5,6,4},{4,1,6},{2,1},{3,6}},{{0,0,0},{0,0}},50}}],4],ImageSizeFull]
Downsam