1,33,3

In[]:=
RandomWolframModel[{{1,3}}{{3,3}}]
Out[]=
{{1,2,3}}{{3,1,4},{4,1,4},{5,6,7}}
In[]:=
Select[Table[RandomWolframModel[{{1,3}}{{3,3}}],100],ConnectedWolframModelQ]
Out[]=
$Aborted
In[]:=
ParallelMapMonitored[RandomWolframModel[{{1,3}}{{3,3}}]&,Range[50]]
Out[]=
In[]:=
Select[%,ConnectedWolframModelQ]
Out[]=
In[]:=
rules=%26;
In[]:=
res=ParallelMapMonitored[WolframModelTest[#,{{0,0,0}}]&,rules];
In[]:=
res2=DeleteDuplicates[Select[res,ConnectedHypergraphQ[#FinalState]&]];
In[]:=
Length[res2]
Out[]=
12
In[]:=
MakePictures[res2]
Out[]=
In[]:=
MakeDirectPictures[{{{{1,2,3}}{{4,5,3},{2,3,5},{6,5,1}},{{0,0,0}},5},{{{1,2,3}}{{4,5,1},{1,6,4},{3,4,2}},{{0,0,0}},5}},2]
Out[]=
In[]:=
GraphPlot3D[HypergraphToGraph[WolframModel[{{1,2,3}}{{4,5,3},{2,3,5},{6,5,1}},{{0,0,0}},6,"FinalState"]]]
Out[]=
In[]:=
rules=Select[ParallelMapMonitored[RandomWolframModel[{{1,3}}{{3,3}}]&,Range[50]],ConnectedWolframModelQ]
Out[]=
In[]:=
res=ParallelMapMonitored[WolframModelTest[#,{{0,0,0}}]&,rules];
In[]:=
res2=DeleteDuplicates[Select[res,ConnectedHypergraphQ[#FinalState]&]];
In[]:=
Length[res2]
Out[]=
10
In[]:=
MakePictures[res2]
Out[]=
In[]:=
rules=Select[ParallelMapMonitored[RandomWolframModel[{{1,3}}{{3,3}}]&,Range[200]],ConnectedWolframModelQ]
Out[]=