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 »
WOLFRAM NOTEBOOK
Map[{Echo@#->Length[EnumerateHypergraphs[{#}]]}&,{{1,2},{2,2},{3,2},{4,2},{5,2},{1,3},{2,3},{3,3},{4,3}}]
In[]:=
results=<|{1,2}2,{2,2}8,{3,2}32,{4,2}167,{5,2}928,{6,2}5924,{7,2}40211,{8,2}293370,{1,3}5,{2,3}102,{3,3}3268,{4,3}164391,{1,4}15,{2,4}2032,{3,4}->678358,{1,5}52,{2,5}57109|>;
In[]:=
Grid[#,FrameAll,AlignmentRight]&/@Partition[KeyValueMap[{RSF0[{#1}],#2}&,results],UpTo[8]]
Out[]=
In[]:=
allUnorderedHypergraphs[{{1,2}}]
Out[]=
Catenate[Sort[Select[(FunctionRepository`$332a409256df43d682a296e7caf418d7`ApplyWolframRuleSignaturetoList[{{1,2}}{},#1]&)/@FunctionRepository`$332a409256df43d682a296e7caf418d7`MaskedRadixStandardOrder[#1],FunctionRepository`$332a409256df43d682a296e7caf418d7`ConnectedWolframModelQ[#1,Automatic]&===FunctionRepository`$332a409256df43d682a296e7caf418d7`xFindCanonicalWolframModel[#1]&]]&]
In[]:=
Map[{Echo@#->Length[allUnorderedHypergraphs[{#}]]}&,{{1,2},{2,2},{3,2},{4,2},{5,2},{1,3},{2,3}}]
»
{1,2}
»
{2,2}
»
{3,2}
»
{4,2}
»
{5,2}
»
{1,3}
»
{2,3}
Out[]=
{{{1,2}2},{{2,2}4},{{3,2}11},{{4,2}30},{{5,2}95},{{1,3}3},{{2,3}15}}
In[]:=
allUnorderedHypergraphs[{{1,3}}]
Out[]=
{{{1,1,1}},{{1,1,2}},{{1,2,3}}}
In[]:=
allUnorderedHypergraphs[{{2,3}}]
Out[]=
In[]:=
unorderedHypergraphPlot[#,VertexLabelsAutomatic]&/@allUnorderedHypergraphs[{{1,3}}]
Out[]=
In[]:=
unorderedHypergraphPlot[{{1,1,2},{1,3,4}},VertexLabelsAutomatic]
Out[]=
In[]:=
unorderedHypergraphPlot[{{1,2,3},{1,4,5}},VertexLabelsAutomatic]
Out[]=
Rules
Rules
In[]:=
RandomWolframModel[{{2,3}}{{3,3}}]
Out[]=
{{1,2,3},{3,4,5}}{{1,2,1},{3,6,4},{7,8,4}}
In[]:=
unorderedHypergraphEvolutionStatesPlots[{{1,2,3},{3,4,5}}{{1,2,1},{3,6,4},{7,8,4}},5]
Out[]=
In[]:=
unoEvolve[rule_,steps_]:=orderedToUnorderedHypergraph/@WolframModel[unorderedToOrderedHypergraphRule[rule],initialUnorderedHypergraphSelfLoop@rule,steps,"StatesList"]
In[]:=
unoEvolve[{{1,2,3},{3,4,5}}{{1,2,1},{3,6,4},{7,8,4}},4]
Out[]=
In[]:=
ConnectedHypergraphQ/@%
Out[]=
{True,True,True,False,False}
In[]:=
Select[Table[RandomWolframModel[{{2,3}}{{3,3}}],50],ConnectedHypergraphQ[Last[unoEvolve[#,4]]]&]
Out[]=