Function Repository Resource:

NestWhileGraph

Source Notebook

Iteratively construct graphs up to a termination condition

Contributed by: Bradley Klee

ResourceFunction["NestWhileGraph"][f,expr,test]

generates a directed graph whose nodes are obtained by applying f repeatedly, starting from expr, and continuing until applying test to the result no longer yields True.

ResourceFunction["NestWhileGraph"][f,expr,test,m]

supplies a list of the most recent m results to test at each step.

ResourceFunction["NestWhileGraph"][f,expr,test,All]

supplies a list of all results so far to test at each step.

ResourceFunction["NestWhileGraph"][f,expr,test,m,max]

applies f at most max times.

Details

ResourceFunction["NestWhileGraph"] accepts all the options of Graph.
When testing on more than one successive graph, results are time ordered with older results occurring earlier in the list.
Setting DirectedEdges to False returns an undirected graph.
Typically the iterator f should be a list-valued function whose elements are also valid inputs to f.
The most general form for a typical output allows internal cycles.
If an iteration returns to a previously visited value, it does not use that value as an input at the next step.
Output graphs will not have duplicate edges.

Examples

Basic Examples (3) 

Construct a graph by applying f while VertexCount is less than 5:

In[1]:=
ResourceFunction["NestWhileGraph"][f, x, VertexCount[#] < 5 &, VertexLabels -> Automatic]
Out[1]=

Apply a similar termination condition only to growth-front subgraph:

In[2]:=
ResourceFunction["NestWhileGraph"][{f[#], g[#]} &, 0, Function[{g1, g2},
     VertexCount@VertexDelete[g2, VertexList[g1]]
     ] @@ # <= 8 &, 2]
Out[2]=

Terminate the growth of a graph according to properties of its vertex set:

In[3]:=
ResourceFunction["NestWhileGraph"][{# + 1, 2 # + 1} &, 0,
 Function[{g0}, Length[Select[VertexList[g0],
       VertexInDegree[g0, #] == 2 &]]][#] < 8 &, 1]
Out[3]=

Explore a grid graph through multiway spacetime evolution until every vertex has been visited:

In[4]:=
Function[{dim}, Graph3D[#, GraphLayout -> "SpringElectricalEmbedding"] &@
   With[{moves = Association[# -> VertexOutComponent[
           GridGraph[{dim, dim}], #, {1}] & /@ Range[dim^2]]},
    ResourceFunction["NestWhileGraph"][
     Thread[{moves[#[[1]]], #[[2]] + 1}] &, {{1, 0}},
     UnsameQ[Union[First /@ Flatten[VertexList /@ #, 1]],
       Range[dim^2]] &, All  ]]][5]
Out[4]=

Generate a torus graph:

In[5]:=
Function[{n, m}, ResourceFunction["NestWhileGraph"][{
     Mod[Plus[#, {1, 0}], {n, m}],
     Mod[Plus[#, {0, 1}], {n, m}]} &,
   {{0, 0}}, UnsameQ @@ # &, 2]][12, 6]
Out[5]=

Generate a few different Cayley graphs for the Octahedral group:

In[6]:=
Grid[{Function[{cyca, cycb}, Graph3D[ResourceFunction["NestWhileGraph"][{
          PermutationProduct[Cycles[{cyca}], #],
          PermutationProduct[Cycles[{cycb}], #]} &, Cycles[{{}}],
        UnsameQ @@ # &, 2], ImageSize -> 180]][#1, #2] & @@@ {
    {{1, 2, 3, 4}, {3, 4}}, {{1, 2, 3}, {3, 4}}, {{1, 2, 3, 4}, {2, 3,
       4}}}},
 Frame -> All, FrameStyle -> LightGray, Spacings -> {2, 2}]
Out[6]=

Scope (1) 

When setting DirectedEdges to False, outputs become undirected graphs:

In[7]:=
Grid[{Function[{cyca, cycb}, Graph3D[ResourceFunction["NestWhileGraph"][{
          PermutationProduct[Cycles[{cyca}], #],
          PermutationProduct[Cycles[{cycb}], #]} &, Cycles[{{}}],
        UnsameQ @@ # &, 2, DirectedEdges -> False], ImageSize -> 180]
      ][#1, #2] & @@@ {{{1, 2, 3, 4}, {3, 4}}, {{1, 2, 3}, {3, 4}},
    {{1, 2, 3, 4}, {2, 3, 4}}}},
 Frame -> All, FrameStyle -> LightGray, Spacings -> {2, 2}]
Out[7]=

Options (1) 

Termination can also be accomplished by introducing a cutoff for recursion depth:

In[8]:=
ResourceFunction["NestWhileGraph"][f, x, True &, 1, 4, VertexLabels -> Automatic]
Out[8]=

Neat Examples (2) 

Construct the game graph of a loopy game:

In[9]:=
With[{IterateGameState = Function[{board, player},
    With[{loc = Position[board, player][[1, 1]]},
     Union[Switch[{Total[#[[1]]], #},
         {_, {{__, 1}, -1}}, 1,
         {_, {{-1, __}, 1}}, -1,
         {0, {_, _}}, #,
         {1, {_, _}}, ReplacePart[#, {1, -1} -> -1],
         {-1, {_, _}}, ReplacePart[#, {1, 1} -> 1]
         ] & /@ Complement[{ReplacePart[board, If[0 < (loc + player #) < 7,
             {loc -> 0, (loc + player #) -> player}, {}]],
           -player} & /@ {1, 2},
        {{board, -player}}]]]]},
 gameGraph = SimpleGraph@
   ResourceFunction["NestWhileGraph"][IterateGameState @@ # &,
    {{{1, 0, 0, 0, 0, -1}, 1}}, UnsameQ @@ # &, 2,
    GraphLayout -> "LayeredDigraphEmbedding"]]
Out[9]=

Find loops in the game graph:

In[10]:=
Grid[Partition[With[{cycles = FindCycle[gameGraph, Infinity, All]},
   HighlightGraph[gameGraph, PathGraph[#], ImageSize -> {40, Automatic}] & /@ cycles], 11],
 Frame -> All, FrameStyle -> LightGray, Spacings -> {1, 1}]
Out[10]=

Generate a graph with structure related to prime numbers:

In[11]:=
primeg = ResourceFunction["NestWhileGraph"][Function[{val},
   Append[val + # & /@ FactorInteger[val][[All, 1]], val + 1]]
  , 1, UnsameQ[Length@Intersection[
      Prime /@ Range[15], VertexList[#]], 15] &]
Out[11]=

Notice false positives on the growth front:

In[12]:=
TableForm[#[Sort@Select[
      Sort@VertexList[primeg],
      VertexInDegree[primeg, #] == 1 &],
    Prime /@ Range[25]
    ] & /@ {Intersection, Complement}]
Out[12]=

Publisher

Brad Klee

Version History

  • 1.0.1 – 05 July 2022
  • 1.0.0 – 10 June 2022

Related Resources

License Information