Wolfram Cloud Page

WOLFRAM NOTEBOOK

In[]:=

GridGraph[{10,10},VertexLabels->{x_:>RandomInteger[20]}]

Out[]=

In[]:=

LifetimeGraphList[g_,max_]:={g,Association[Thread[VertexList[g]->RandomInteger[max,VertexCount[g]]]]}

In[]:=

Clear[ShowGraph]

In[]:=

ShowGraph[{g_,life_}]:=Graph[g,VertexLabels->Normal[life]]

In[]:=

ShowGraph[LifetimeGraphList[GridGraph[{10,10}],20]]

Out[]=

In[]:=

lg=LifetimeGraphList[GridGraph[{10,10}],20];

In[]:=

Clear[EvolutionGraph,EvolutionPath]

In[]:=

EvolutionGraph[{graph_,lifetimes_},init_,compare_:Greater]:=ResourceFunction["FixedPointGraph"][Function[loc,Select[VertexOutComponent[graph,loc,{1}],lifetimes[#]>lifetimes[loc]&]],init]

In[]:=

EvolutionPath[{graph_,lifetimes_},init_,compare_:Greater]:=Module[{next,res},res=FixedPointList[Function[loc,If[SameQ[loc,{}],{},next=First[loc];RandomSample[Select[VertexOutComponent[graph,next,{1}],lifetimes[#]>lifetimes[next]&]]]],{init}];Map[First,Most[Most[res]]]]

In[]:=

EvolutionPath[lg,23]

Out[]=

{23,24}

In[]:=

HighlightGraph[ShowGraph[lg],Style[Subgraph[First[lg],EvolutionPath[lg,23]],Thick,Red]]

Out[]=

In[]:=

Table[HighlightGraph[ShowGraph[lg],Style[Subgraph[First[lg],EvolutionPath[lg,RandomInteger[100]]],Thick,Red]],6]

Out[]=





In[]:=

VertexList@GridGraph[{5,5,5}]

Out[]=

{1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125}

In[]:=