Random Wolfram Model Harvester
Random Wolfram Model Harvester
Investigating random generated models from the → signature permutation lists
2
3
3
3
Please, see also the complementary statistical analysis document: Random Wolfram Model Statistics
Create permutation lists for signature 23→33
Create permutation lists for signature →
2
3
3
3
Main difference to the EnumerateHypergraphs -resource function here is that permutations filters all non-connected edge lists. This procedure reduces the amount of items in the list significantly and gives more interesting items in the random generation process. I have also selected lists that has at least five variables (symbols) in left hand side and six in right hand side in total.
(*Lefthandrulepermutationswithsixvariables.*)perm236L=Select[ToExpression[#]&/@Permutations[ToString[#]&/@Permutations[Range[6],{3,3}],{2,2}],(*Filteroutallnon-connectededgelistsandthosethathaslesspermutingvariablesthan5.*)And[First@#≠Last@#,ContainsAny[First@#,Last@#],Length@Keys[Counts[Flatten[#]]]>4]&];perm236I=Length[perm236L];second[l_]:=l[[2]];(*Righthandrulepermutations.*)perm336L=Select[ToExpression[#]&/@Permutations[ToString[#]&/@Permutations[Range[6],{3,3}],{3,3}],(*Filteroutallnon-connectededgelistsandthosethathaslesspermutingvariablesthan6.*)And[First@#≠second@#,second@#≠Last@#,First@#≠Last@#,ContainsAny[First@#,second@#],ContainsAny[second@#,Last@#],Length@Keys[Counts[Flatten[#]]]>5]&];perm336I=Length[perm336L];(*Randomleft-rightrulegetterfrompreinstantiatedpermutationlists.*)randomPermutationRule[lft_,rht_,l1_,l2_]:=Block[{a={},b={}},(*Takerandomlistitemsfrompermutationslists.*)a=lft[[RandomInteger[l1]]];b=rht[[RandomInteger[l2]]];(*Makesurethatresultingleftandrightlistsdoesnothavesamesetsofvariables.Thisensuresmoreinterestingmodelsappearinthefinaloutput.*)While[Or[aTake[b,{1,2}],aTake[b,{2,3}]],b=rht[[RandomInteger[l2]]]];Return[{a,b}];];
Show what is in the permutations lists:
In[]:=
Short[perm236L]Short[perm336L]
Out[]//Short=
{{{1,2,3},{1,4,5}},{{1,2,3},{1,4,6}},{{1,2,3},{1,5,4}},6475,{{6,5,4},{6,3,1}},{{6,5,4},{6,3,2}}}
Out[]//Short=
{{{1,2,3},{1,2,4},{1,5,6}},{{1,2,3},{1,2,4},{1,6,5}},466556,{{6,5,4},{6,5,3},{6,1,2}},{{6,5,4},{6,5,3},{6,2,1}}}
Helper functions
Helper functions
In[]:=
(*Someshorthands.*)WM=ResourceFunction["WolframModel"];H2G=ResourceFunction["HypergraphToGraph"];CHQ=ResourceFunction["ConnectedHypergraphQ"];(*Calculatethecrowthrateofthefinalhypergraphstatelist.Exponentiallygrowinglistsarepossiblyjustuninterestingmodelswithlotsofonesandotherrepeatingitems.*)growthRate[states_]:=Block[{r={},l=Length[#]&/@states},For[i=1,i<Length[l],i++,AppendTo[r,N[l[[i+1]]/l[[i]]]]];Return[N[Mean[r]]]];(*Mainfilterfunction.Feelfreetoaltervertexcountandgrowthratevalues.Othercriteriacanbeassignedhere,forexamplesomesophisticatedvertexneihbourhood,volume,degreeandconnectivityclauses.*)filterModels[evobj_]:=And[(*Filterfixedpointmodels.*)evobj["TerminationReason"]≠"FixedPoint",(*Preventsinglepointcenteredmodelsbylimitingtheamountof1'sintheeventstatelist.*)Length[Select[Last@evobj["AllEventsStatesList"],MemberQ[#,1]&]]<Length[Last@evobj["AllEventsStatesList"]]/4,(*Vertexcountcriteria,however,vertexmightgrowupaftermoreevolutions...*)And[#≥4,#<7]&@Max[Counts[Flatten[evobj["FinalState"]]]],(*Limitmodelsbygrowthrate,alsothisratiomightslightlychangeaftermorerevolutions...*)And[#≥1.,#<1.3]&@growthRate[Rest[evobj["StatesList"]]],(*Getonlyconnectedmodels.*)CHQ[evobj["FinalState"]]]
Random select models
Random select models
In[]:=
(*Setuplimitforrandomiterations,from100to10000isgoodenoughdependingonhowstrictfiltersareused.*)randomiterations=1000;(*Collectmodelstothevariable.*)selectedmodels={(*Wolframmodelevolultionobject.*)#,(*Hyperlinktothegigalinkwebsitefor3Dmodelling.*)Hyperlink[#["Rules"],StringJoin["http://gigabrain.io/physics/index.html?rule=",ToString[#["Rules"]],"&init=",ToString[First[#["StatesList"]]],"&steps=10&modelId=undefined&modeType=0"]],(*Modelstatesgrowthrate.*)growthRate[Rest[#["StatesList"]]],(*Edges/vertexratio.*)N[#1/#2,3]&[N[EdgeCount@H2G@#["FinalState"]],N[VertexCount@H2G@#["FinalState"]]](*Getsixteenevolutionsfortheitemsthatpassesthefilter.*)}&@WM[#["Rules"],Automatic,16]&/@(*Randomselectrulesandfiltermodelsbasedonconnectivity,fixedpoint,growthrateandvertexcountcriteria.*)Select[WM[First[#]Last[#],Automatic,10]&@randomPermutationRule[perm236L,perm336L,perm236I,perm336I]&/@Range[randomiterations],(*Itmightbeagoodideatostartevenwithlessstepsandfilterthosemodelsthatpassestheinitialconnectivityandfixedpointcriteria,thencontinuetouseruleswithagreaterstepsusedinthemodel...*)filterModels[#]&];(*Thisisthemainprogramnotebookcell.Afterhittingshift&returnitmighttakesometimetoretrivethemodels.Iflooptakestoomuchtime,abortwithalt-.andrecheckfiltervaluesandtrywithsmalleriterationnumber,orjustletitrunforanight,sigh.*)
How many models got selected by n random iterations?
In[]:=
Length[selectedmodels]
Out[]=
16
Output models
Output models
Take one for example:
In[]:=
Dataset[Join[{{"Model","Rule","Growth Rate","Edge/Vertex"}},Take[selectedmodels,1]]]
Out[]=
Manually selected models from random output with growth rate between 1 and 1.3 plus vertex count limited between 4 and 7. Output graphic grid with links to gigabrain.io website for 3D modelling purposes. First the helper function:
In[]:=
showGraphicsRow[finalstatemodel_,growthrate_,edgevertexratio_,hyperlink_]:=Function[graph,Block[{finalstatemodelflatten=Flatten[finalstatemodel],vertexdegreegraph=VertexDegree[graph]},Show[GraphicsRow[Framed[#,BackgroundWhite,FrameMarginsLarge,FrameStyleWhite]&/@{Labeled[UndirectedGraph[graph,VertexStyle(Function[{v,vd},vColorData[49][Part[vd,v]]][#,vertexdegreegraph]&/@Sort@DeleteDuplicates@finalstatemodelflatten),EdgeStyleGrayLevel[0.85,0.85],ImageSizeScaled[0.80]],hyperlink],Labeled[MatrixPlot[WeightedAdjacencyMatrix[UndirectedGraph[graph]],ColorFunction(ColorData[49][#*10]&),FrameNone],"Adjacency matrix"],Labeled[MatrixPlot[Partition[Values[Function[{v,vd},vColorData[49][Part[vd,v]]][#,vertexdegreegraph]&/@Sort@DeleteDuplicates@finalstatemodelflatten],Floor[Sqrt[Length[finalstatemodel]]]],FrameNone],"Vertex ° matrix"],Labeled[ListLinePlot[MeanDegreeConnectivity[graph],FillingAxis,Axes{True,True}],"Mean ° connectivity",{Bottom,Bottom}],Labeled[ListLinePlot[{Legended[#,Placed["Vertex °",Below]],Function[x,Legended[x&/@#,Placed["avg",Below]]][Mean[#]](*,Function[x,Legended[Abs[#-x]&/@#,Placed["mean diff",Below]]][Mean[#]]*)}&@vertexdegreegraph,FillingAxis,Axes{True,True}],"Growth rate: "<>ToString[growthrate]<>" E/V: "<>ToString[edgevertexratio]]}],SpacingsScaled[0.05],BackgroundWhite]]][H2G[finalstatemodel]]
And finally the main graphics creator (split result to smaller chunks if there are dozens or more items in the selected models variable):
Further work
Further work
Klein bottle - Rule {{3,6,5}, {2,4,5}} -> {{1,4,6}, {3,1,2}, {1,5,6}}
2D lattice disc - Rule {{1,4,6}, {8,3,4}} -> {{2,3,4}, {4,2,1}, {8,2,1}}
Leafed spherical explosion - Rule {{4,5,1}, {4,1,3}} -> {{4,6,3}, {4,2,6}, {3,1,6}}
Pointed hat - Rule {{1, 2, 5}, {3, 4, 5}} -> {{1, 6, 2}, {3, 6, 4}, {4, 2, 5}}
Ouroboroing - Rule {{{3, 1, 4}, {3, 2, 6}} -> {{5, 1, 6}, {3, 5, 2}, {4, 6, 5}}}
End notes
End notes
Totally automated task is very hard to create because one need to constantly examine the properties of the models and tweak out the filters. Good idea would be to use some fixed standard graphs and try to find subgraphs based on them. One could also create a persistent store and API based cloud app with CloudDeploy, make a button click action to send interesting items via API to persistent cloud store and re-examine those models later. That would also help to keep on track with already investigated models. One might also set up a constantly running cloud task that generates reports with interesting rules and emails them by daily manner. Many possibilities, the endless forms most beautiful.
With these end notes, happy harvesting new universes!
With these end notes, happy harvesting new universes!
References
References