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[]:=
ApplyPerm[perm_,rule_]:=Map[#[[perm]]&,#,{2}]&@rule
In[]:=
{#,ApplyPerm[{3,2,1},#]}&[{{1,2,3},{3,4,5}}{{6,7,1},{6,3,8},{5,7,8}}]
Out[]=
{{{1,2,3},{3,4,5}}{{6,7,1},{6,3,8},{5,7,8}},{{3,2,1},{5,4,3}}{{1,7,6},{8,3,6},{8,7,5}}}
In[]:=
RulePlot[WolframModel[#],VertexLabelsAutomatic]&/@%
Out[]=
In[]:=
XYifyRule[{{1,2,3},{3,4,5}}{{6,7,1},{6,3,8},{5,7,8}}]
Out[]=
{{1,2,3},{3,4,5}}{{6,7,1},{6,3,8},{5,7,8}}
In[]:=
RandomWolframModelRule[{{2,3}}{{3,3}}]
Out[]=
{{1,2,3},{2,4,5}}{{5,6,4},{6,5,3},{7,8,5}}
In[]:=
ApplyPerm[{3,2,1},%]
Out[]=
{{3,2,1},{5,4,2}}{{4,6,5},{3,5,6},{5,8,7}}
In[]:=
FindCanonicalWolframModel[%]
Out[]=
{{1,2,3},{4,3,5}}{{4,1,6},{2,6,1},{1,7,8}}
In[]:=
RulePlot[WolframModel[{{1,2,3},{2,4,5}}{{5,6,4},{6,5,3},{7,8,5}}]]
Out[]=
In[]:=
RulePlot[WolframModel[#],VertexLabelsAutomatic,ImageSize300]&/@{#,FindCanonicalWolframModel[ApplyPerm[{3,2,1},#]]}&[{{1,2,3},{2,4,5}}{{5,6,4},{6,5,3},{7,8,5}}]
Out[]=
In[]:=
samp=ParallelTable[RandomWolframModelRule[{{2,3}}{{3,3}}],10000];
In[]:=
psamp=Function[perm,perm->Pick[samp,ParallelMapMonitored[(FindCanonicalWolframModel[Map[#[[perm]]&,#,{2}]]===#)&,samp]]]/@Rest[Permutations[Range[3]]]
Out[]=
In[]:=
First[#]Length[Last[#]]&/@%
Out[]=
{{1,3,2}7,{2,1,3}3,{2,3,1}0,{3,1,2}0,{3,2,1}10}
In[]:=
First[#]Length[Last[#]]&/@{{1,3,2}{{{1,2,3},{4,3,5}}{{6,3,1},{3,7,8},{9,4,3}},{{1,2,3},{4,3,5}}{{2,6,7},{5,6,7},{3,1,4}},{{1,2,3},{1,4,5}}{{1,6,7},{8,6,7},{9,3,4}},{{1,2,3},{4,3,5}}{{6,3,3},{5,2,7},{2,7,5}},{{1,2,3},{4,3,5}}{{6,1,4},{6,7,8},{9,2,5}},{{1,2,2},{1,3,3}}{{4,5,1},{6,1,7},{2,8,9}},{{1,2,3},{4,3,2}}{{1,5,5},{2,6,6},{3,7,7}}},{2,1,3}{{{1,1,2},{3,4,1}}{{2,2,5},{6,6,5},{4,3,2}},{{1,1,2},{2,2,3}}{{2,2,4},{2,5,6},{7,2,6}},{{1,2,3},{2,1,4}}{{1,5,6},{5,2,7},{8,9,4}},{{1,1,2},{3,4,2}}{{5,6,4},{6,7,3},{8,9,1}}},{2,3,1}{},{3,1,2}{},{3,2,1}{{{1,2,3},{4,2,5}}{{6,2,7},{6,8,9},{10,11,7}},{{1,2,1},{2,3,2}}{{3,4,3},{5,6,1},{1,7,8}},{{1,2,3},{3,4,5}}{{6,7,1},{7,8,9},{5,9,6}},{{1,2,3},{3,4,5}}{{3,6,3},{4,7,2},{8,7,9}},{{1,2,1},{2,3,2}}{{4,5,4},{5,2,5},{6,5,6}},{{1,2,3},{4,2,5}}{{2,6,2},{3,6,1},{3,7,1}},{{1,2,3},{3,4,5}}{{6,7,1},{6,3,8},{5,7,8}}}}
Out[]=
{{1,3,2}7,{2,1,3}4,{2,3,1}0,{3,1,2}0,{3,2,1}7}
In[]:=
samp=ParallelTable[RandomWolframModelRule[{{2,3}}{{2,3}}],10000];
In[]:=
psamp=Function[perm,perm->Pick[samp,ParallelMapMonitored[(FindCanonicalWolframModel[Map[#[[perm]]&,#,{2}]]===#)&,samp]]]/@Rest[Permutations[Range[3]]]
Out[]=
In[]:=
First[#]Length[Last[#]]&/@%
Out[]=
{{1,3,2}56,{2,1,3}45,{2,3,1}0,{3,1,2}0,{3,2,1}43}
In[]:=
allrules=Import["/Users/sw/Dropbox/Physics/Data/RuleEnumerations/22-32c.wxf"];
In[]:=
pall=Function[perm,perm->Pick[allrules,ParallelMapMonitored[(FindCanonicalWolframModel[Map[#[[perm]]&,#,{2}]]===#)&,allrules]]]/@Rest[Permutations[Range[2]]]
Out[]=
Significance
Significance
R (Θ S) = Θ(R S)
Check “interesting” rules....
Check “interesting” rules....