Standard Order Rule Counting

Initializations

IntegerToRuleSignatures

IntegerToRuleSignatures[int_Integer]:=SortBy[Sort[Rule@@(({Length[#],First[#]}&/@Split[#])&/@#)&/@Select[Union[Flatten[Table[{ReverseSort[Take[#,k]],ReverseSort[Drop[#,k]]},{k,1,Length[#]-1}]&/@Flatten[Permutations/@Select[IntegerPartitions[int],Min[#]≥2&&Max[Last/@Tally[#]]≥2&],1],1]],Max[Last/@Tally[#[[1]]]]+Max[Last/@Tally[#[[2]]]]>2&]],Union[Join[Last/@First[#],Last/@Last[#]]]&];

IntegerToRuleSignaturesOnes[int_Integer]:=SortBy[Sort[Rule@@(({Length[#],First[#]}&/@Split[#])&/@#)&/@Select[Union[Flatten[Table[{ReverseSort[Take[#,k]],ReverseSort[Drop[#,k]]},{k,1,Length[#]-1}]&/@Flatten[Permutations/@Select[IntegerPartitions[int],Min[#]1&&Max[Last/@Tally[#]]≥2&],1],1]],Max[Last/@Tally[#[[1]]]]+Max[Last/@Tally[#[[2]]]]>2&]],Union[Join[Last/@First[#],Last/@Last[#]]]&];

IntegerToRuleSignaturesBoring[int_Integer]:=SortBy[Sort[Rule@@(({Length[#],First[#]}&/@Split[#])&/@#)&/@Select[Union[Flatten[Table[{ReverseSort[Take[#,k]],ReverseSort[Drop[#,k]]},{k,1,Length[#]-1}]&/@Flatten[Permutations/@Select[IntegerPartitions[int],Min[#]≥2&],1],1]],Max[Last/@Tally[#[[1]]]]+Max[Last/@Tally[#[[2]]]]==2&]],Union[Join[Last/@First[#],Last/@Last[#]]]&];

Small standard orders

GrowStandardOrder[order_,s_]:=Module[{max},max=Min[Max[order]+1,s];Append[order,#]&/@Range[max]];

StartTup[alpha_,tupsize_]:=Nest[Flatten[GrowStandardOrder[#,alpha]&/@#,1]&,{{1}},tupsize-1];

StartTup[4,12]//Length

700075

BellB[12]

4213597

rhs=Table[Select[Union[Union[Partition[#,2]]&/@Tuples[Range[mm],{2edges}]],Length[#]edges&]//Length,{edges,1,4},{mm,3,6}]

{{9,16,25,36},{36,120,300,630},{84,560,2300,7140},{126,1820,12650,58905}}

Table[Binomial[mm^2,edges],{edges,1,4},{mm,3,6}]

{{9,16,25,36},{36,120,300,630},{84,560,2300,7140},{126,1820,12650,58905}}

4^8/4!//Round

2731

6^8

1679616

StandardOrderFromIndex


canonicalizer


ConnectedWolframModelQ


Apply Signature


Bell Indexed Sampling (complete 8 to 10, sampled 11 to 20)


Bell Indexed Sampling Runs (¶ indicates a sample is stored above)


Analysis 9

niner={{{1,3}}{{2,3}},{{2,3}}{{1,3}},{{1,2}}{{1,3},{2,2}},{{1,3}}{{3,2}},{{2,2}}{{1,3},{1,2}},{{3,2}}{{1,3}},{{1,3},{1,2}}{{2,2}},{{1,3},{2,2}}{{1,2}},{{1,5}}{{2,2}},{{2,2}}{{1,5}}};

Length[niner]

Monitor[Table[{niner[[j]],Length[Select[ApplyWolframRuleSignaturetoList[niner[[j]],#]&/@orders9,FindCanonicalWolframModel[#]===#&&ConnectedWolframModelQ[#,Automatic]&]]},{j,1,10}],j]

Analysis 10

sigs=IntegerToRuleSignatures[10]

Monitor[Table[{sigs[[j]],Length[Select[ApplyWolframRuleSignaturetoList[sigs[[j]],#]&/@orders10,FindCanonicalWolframModel[#]===#&&ConnectedWolframModelQ[#,Automatic]&]]},{j,1,Length[sigs]}],{Length[sigs],j}]

Analysis 15

Canonical count estimate.

Table[Length[IntegerToRuleSignaturesOnes[k]],{k,6,15}]

{29,58,107,190,324,536,865,1366,2120,3232}

Table[Length[IntegerToRuleSignatures[k]],{k,8,20}]

{7,10,22,32,58,86,141,206,318,456,679,956,1381}

IntegerToRuleSignaturesOnes[8]

IntegerToRuleSignatures[8]

{{{1,2}}{{3,2}},{{2,2}}{{2,2}},{{3,2}}{{1,2}},{{1,2}}{{2,3}},{{2,3}}{{1,2}},{{1,4}}{{2,2}},{{2,2}}{{1,4}}}

IntegerToRuleSignatures[9]

Round[BellB[15]/(2!3!)]

115246545

count=Select[ApplyWolframRuleSignaturetoList[{{2,3}}{{3,3}},#]&/@orders15,FindCanonicalWolframModel[#]===#&&ConnectedWolframModelQ[#,Automatic]&]

5809 canonical connected rules in the sample of 100000

Round[BellB[15]5809/100000]

80336062

The actual number is 79359764

Select[ApplyWolframRuleSignaturetoList[{{3,3}}{{3,3}},#]&/@orders18,FindCanonicalWolframModel[#]===#&&ConnectedWolframModelQ[#,Automatic]&]

Round[BellB[18]2013/100000]

13730206108

Grand Analysis

1+1

BellB[24]

445958869294805289

2^24

16777216

Currently for connected rules only.

CountWolframModelRules[signature_Rule]:=Module[{len,sample,rule,samplecount},len=ruleSignatureLength[signature];If[len>21,Return[Row[{"length ",len," not yet sampled"}]]];rule=SortBy[signature[[1]],-Last[#]&]SortBy[signature[[2]],-Last[#]&];sample=orders[[len]];samplecount=Length[Select[ApplyWolframRuleSignaturetoList[rule,#]&/@sample,FindCanonicalWolframModel[#]===#&&ConnectedWolframModelQ[#,Automatic]&]];If[len≤10,samplecount,Round[BellB[len]samplecount/100000]]]

CountWolframModelRules[{{7,3}}{}]

71230472424

Table[CountWolframModelRules[{{k,2}}{}],{k,1,4}]

{2,8,32,167}

Length[orders12]

4213597

orders12=StartTup[12,12];

CountWolframModelRules[{{4,3}}{}]

$Aborted

CountWolframModelRules[{{4,3}}{}]

167364

Table[CountWolframModelRules[{{k,3}}{}],{k,1,3}]

{5,102,3268}

<|{1,2}2,{2,2}8,{3,2}32,{4,2}167,{5,2}928,{1,3}5,{2,3}102,{3,3}3268,|>

CountWolframModelRules[{{4,2}}{{6,2}}]

1551724747

The exact count for the below is 79359764:

CountWolframModelRules[{{2,3}}{{3,3}}]

80336062

CountWolframModelRules[{{2,3}}{{3,3}}]

BellB[21]

474869816156751

Flatten[Table[Select[IntegerToRuleSignatures[k],Length[#[[1]]]1&&Length[#[[2]]]1&&Last[Flatten[#[[1]]]]==Last[Flatten[#[[2]]]]&],{k,10,28}],1]

Select[try,Max[{First[Flatten[#[[1]]]],First[Flatten[#[[2]]]]}]≤5&&Max[{Last[Flatten[#[[1]]]],Last[Flatten[#[[2]]]]}]≤4&]

SplitBy[SortBy[Select[try,ruleSignatureLength[#]≤21&],ruleSignatureLength],ruleSignatureLength]

try=Flatten[{{{{3,2}}{{4,2}},{{4,2}}{{3,2}},{{5,2}}{{2,2}}},{{{3,3}}{{2,3}},{{4,3}}{{1,3}}},{{{1,4}}{{3,4}},{{2,4}}{{2,4}},{{3,2}}{{5,2}},{{3,4}}{{1,4}},{{4,2}}{{4,2}},{{5,2}}{{3,2}}},{{{1,3}}{{5,3}},{{2,3}}{{4,3}},{{3,3}}{{3,3}},{{4,2}}{{5,2}},{{4,3}}{{2,3}},{{5,2}}{{4,2}},{{5,3}}{{1,3}}},{{{1,4}}{{4,4}},{{2,4}}{{3,4}},{{3,4}}{{2,4}},{{4,4}}{{1,4}},{{5,2}}{{5,2}}},{{{2,3}}{{5,3}},{{3,3}}{{4,3}},{{4,3}}{{3,3}},{{5,3}}{{2,3}}}},1];

Length[try]

try[[1]]

{{3,2}}{{4,2}}

estimatecounts=Monitor[Table[{try[[tt]],CountWolframModelRules[try[[tt]]]},{tt,25,27}],tt]

{{{{3,3}}{{4,3}},2046688907636},{{{4,3}}{{3,3}},2369600382622},{{{5,3}}{{2,3}},1609808676771}}

estimates={{{{3,2}}{{4,2}},549790},{{{4,2}}{{3,2}},542154},{{{5,2}}{{2,2}},425705},{{{3,3}}{{2,3}},84332812},{{{4,3}}{{1,3}},48735459},{{{1,4}}{{3,4}},1706167142},{{{2,4}}{{2,4}},2254592980},{{{3,2}}{{5,2}},4087255},{{{3,4}}{{1,4}},1607234600},{{{4,2}}{{4,2}},6078482},{{{5,2}}{{3,2}},5135270},{{{1,3}}{{5,3}},5429331377},{{{2,3}}{{4,3}},9194395347},{{{3,3}}{{3,3}},13730206108},{{{4,2}}{{5,2}},109132289},{{{4,3}}{{2,3}},10776813537},{{{5,2}}{{4,2}},102311521},{{{5,3}}{{1,3}},5279274480},{{{1,4}}{{4,4}},2095345650115},{{{2,4}}{{3,4}},3522932417411},{{{3,4}}{{2,4}},3766553202700},{{{4,4}}{{1,4}},2083966335303},{{{5,2}}{{5,2}},2068966329},{{{2,3}}{{5,3}},1234661522008},{{{3,3}}{{4,3}},2046688907636},{{{4,3}}{{3,3}},2369600382622},{{{5,3}}{{2,3}},1609808676771}};

b24=BellMaskRadix[24];

$Aborted

Table[Binomial[6,n],{n,0,6}]

{1,6,15,20,15,6,1}