In[]:=
RuleCode[rule_List]:=Map[ResourceFunction["TupleIndex"],rule/.RuleList,{0,3}]
In[]:=
RuleCode[{{{1,2,3},{4,3},{5,5}}{{3,2,5},{3,5,4},{1,4},{2,6},{7,8}}}]
Out[]=
18748082043703361682100
In[]:=
ResourceFunction["TupleFromIndex"][%60,2]
Out[]=
{54378,136923635811}
In[]:=
Map[ti,{{{1,2,3},{4,3},{5,5}}{{3,2,5},{3,5,4},{1,4},{2,6},{7,8}}}/.RuleList,{0,3}]
Out[]=
ti[{ti[{ti[{ti[{1,2,3}],ti[{4,3}],ti[{5,5}]}],ti[{ti[{3,2,5}],ti[{3,5,4}],ti[{1,4}],ti[{2,6}],ti[{7,8}]}]}]}]
In[]:=
BellB[19]
Out[]=
5832742205057
In[]:=
Flatten[{{{1,2,3},{4,3},{5,5}},{{3,2,5},{3,5,4},{1,4},{2,6},{7,8}}}]
Out[]=
{1,2,3,4,3,5,5,3,2,5,3,5,4,1,4,2,6,7,8}
In[]:=
StandardOrderMap[list_List]:=Module[{alphabet},alphabet=DeleteDuplicates[Flatten[list]];list/.Thread[alphabetRange[Length[alphabet]]]];
In[]:=
BellIndexing[n_]:=Times@@MapIndexed[#2[[1]]^(#1-1)&,Differences[Flatten[{1,Position[#,1]+1,n+1}]]]&/@Table[IntegerDigits[k,2,n-1],{k,0,2^(n-1)-1}];
In[]:=
StandardOrderIndex[stan_List]:=Module[{len,in,bell,high,max,mask,binaryindex,bellindex,digits,radix,mixedindex},len=Length[stan];in=StandardOrderMap[Flatten[stan]];If[Last[in]len,Return[BellB[len]]];bell=BellIndexing[len];high=Prepend[Table[If[in[[n]]>Max[Take[in,n-1]],in[[n]],0],{n,2,Length[in]}],1];binaryindex=FromDigits[Drop[Sign[high],1],2];bellindex=Total[Take[bell,binaryindex]];max=Table[Max[Take[in,n]],{n,1,Length[in]}];mask=Sign[in-high];{digits,radix}=Transpose[Select[Transpose[{maskin-1,maskmax}],Max[#]>0&]];mixedindex=FromDigits[digits,MixedRadix[radix]];bellindex+mixedindex+1];
In[]:=
StandardOrderIndex[{1,2,3,4,3,5,5,3,2,5,3,5,4,1,4,2,6,7,8}]
Out[]=
3797815661519
In[]:=
ResourceFunction["FindCanonicalWolframModel"][{{x,y},{x,z}}{{x,z},{x,w},{y,w},{z,w}}]
Out[]=
{{1,2},{1,3}}{{1,2},{1,4},{2,4},{3,4}}
In[]:=
Flatten[%/.RuleList]
Out[]=
{1,2,1,3,1,2,1,4,2,4,3,4}
In[]:=
StandardOrderIndex[%]
Out[]=
1119038
In[]:=
maxConnectedAtoms[{{2,2},{4,2}}]
Out[]=
7
Total[#1*(#2-1)&@@@sig]+1
Out[]=
7
FullyConnectedRuleQ
{{n,1}}{{m,1}}
{{1,2}}{{n,2}}
{{2,2}}{{4,2}}
{{2,3}}{{3,3}}
In[]:=
EnumerateWolframModelRules[{{2,2}}{{4,2}},Automatic,"Monitored"True]
Out[]=
$Aborted
In[]:=
Directory[]
Out[]=
/Users/sw
SetDirectory[NotebookDirectory[]]
In[]:=
EnumerateWolframModelRules[{{2,2}}{{3,2}},Automatic,"Monitored"True]
Out[]=
In[]:=
EnumerateWolframModelRules[{{2,2}}{{3,2}},Automatic,"Monitored"True]
Out[]=
In[]:=
EnumerateWolframModelRules[{{1,3}}{{3,3}},Automatic,"Monitored"True]
Out[]=
In[]:=
EnumerateWolframModelRules[{{2,3}}{{3,3}},Automatic,"Monitored"True]
In[]:=
Export[$PhysicsDataDirectory<>"23to33.wxf",%]
Out[]=
/Users/sw/Dropbox/Physics/Data23to33.wxf
In[]:=
Length[%212]
Out[]=
340396
In[]:=
Export[$PhysicsDataDirectory<>"22to42.wxf",%165]
Out[]=
/Users/sw/Dropbox/Physics/Data22to42.wxf
In[]:=
Export[$PhysicsDataDirectory<>"22to32.wxf",%164]
Out[]=
/Users/sw/Dropbox/Physics/Data22to32.wxf
In[]:=
Clear[EnumerateWolframModelRules]
In[]:=
EnumerateWolframModelRules[{{2,2}}{{5,2}},5,"Monitored"True]
{{1,2},{2,2}}{{3,2}}
In[]:=
Tuples[Tuples[Range[9],2],2]
Out[]=
In[]:=
SortBy[%,Total[Flatten[#]]&]
Out[]=
Rule Signatures
Rule Signatures