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
In[]:=
checkruleV[rule_]:=With[{eo=TimeConstrained[WolframModel[rule,{{0,0,0},{0,0,0}},<|"MaxVertices"200,"MaxEdges"200,"MaxEvents"5000,"MaxGenerations"100,"MaxVertexDegree"20|>,TimeConstraint5],6]},If[eo["TerminationReason"]=!="MaxVertices"||!ConnectedHypergraphQ[eo["FinalState"]]||Median[Max[Abs[Differences[#]]]&/@eo["FinalState"]]<6,Null,Rasterize[HypergraphPlot[eo["FinalState"]],RasterSize50]rule]]
In[]:=
checkruleV[rule_,terms_]:=With[{eo=TimeConstrained[WolframModel[rule,{{0,0,0},{0,0,0}},<|"MaxVertices"200,"MaxEdges"200,"MaxEvents"5000,"MaxGenerations"100,"MaxVertexDegree"20|>,TimeConstraint5],6]},If[!MemberQ[terms,eo["TerminationReason"]]||!ConnectedHypergraphQ[eo["FinalState"]]||Median[Max[Abs[Differences[#]]]&/@eo["FinalState"]]<6,Null,Rasterize[HypergraphPlot[eo["FinalState"]],RasterSize50]rule]]
In[]:=
checkruleV[rule_,terms_,init_]:=With[{eo=TimeConstrained[WolframModel[rule,init,<|"MaxVertices"200,"MaxEdges"200,"MaxEvents"5000,"MaxGenerations"100,"MaxVertexDegree"20|>,TimeConstraint5],6]},If[!MemberQ[terms,eo["TerminationReason"]]||!ConnectedHypergraphQ[eo["FinalState"]]||Median[Max[Abs[Differences[#]]]&/@eo["FinalState"]]<6,Null,Rasterize[HypergraphPlot[eo["FinalState"]],RasterSize50]rule]]
In[]:=
selector[data_]:=Module[{acc={},di=ImageAdjust[First[#]]&/@data,dr,list},dr=DimensionReduce[First/@data,2];list=Transpose[{di,dr,Last/@data}];{Graphics[Inset[Button[Tooltip[Image[#1,ImageSize30],#1],AppendTo[acc,#3]],#2,BackgroundTransparent]&@@@list,ImageSize1000,FrameTrue],Column[{Button["Clear",acc={}],Button["Copy",CopyToClipboard[acc]]}]}]
In[]:=
pix[list_]:=InteractiveListSelectorSW[ParallelMapMonitored[With[{w=WolframModelTest[#,{{0,0,0},{0,0,0}}]},Labeled[GraphPlot[HypergraphToGraph[w["FinalState"]]],Length[w["Sizes"]]]{w["Rule"],w["Init"],Length[w["Sizes"]]}]&,list]]
In[]:=
DeleteCases[ParallelMapMonitored[checkruleV,Table[RandomWolframModel[{{2,3}}{{3,3}}],100]],Null]
Out[]=
In[]:=
$OutputCounter=1;
In[]:=
DeleteCases[ParallelMapMonitored[checkruleV,Table[RandomWolframModel[{{2,3}}{{3,3}}],10000]],Null];
In[]:=
Length[%98]
Out[]=
155
In[]:=
Export["/Users/sw/Dropbox/Physics/Data/23-33-Searches/"<>ToString[$OutputCounter++]<>".wxf",%98]
Out[]=
/Users/sw/Dropbox/Physics/Data/23-33-Searches/1.wxf
In[]:=
selector[Take[%98,154/2]]
Out[]=
In[]:=
selector[Drop[%98,154/2]]
Out[]=
In[]:=
pix@{{{1,2,3},{3,4,5}}{{6,5,7},{2,7,5},{6,4,1}},{{1,2,3},{4,5,6}}{{1,2,4},{4,5,1},{7,1,8}}}
Out[]=
In[]:=
MakeDirectPicturesG[{{{{1,2,3},{3,4,5}}{{6,5,7},{2,7,5},{6,4,1}},{{0,0,0},{0,0,0}},19}},8]
Out[]=
Older case
Older case
Do[Echo[{Now,Export["/Users/sw/Dropbox/Physics/Data/23-33-ManifoldSearch/"<>ToString[n]<>".wxf",EchoFunction[Length]@DeleteCases[ParallelMapMonitored[checkruleR,Take[arules,10^5{n,n+1}]],Null]]}],{n,3}]