Implementation [of network systems]

The nodes in a network system can conveniently be labelled by numbers 1, 2, … n, and the network obtained at a particular step can be represented by a list of pairs, where the pair at position i gives the numbers corresponding to the nodes reached by following the above and below connections from node i. With this setup, a network consisting of just one node is {{1, 1}} and a 1D array of n nodes can be obtained with

CyclicNet[n_] := RotateRight[Table[Mod[{i - 1, i + 1}, n] + 1, {i, n}]]

With above connections represented as 1 and the below connections as 2, the node reached by following a succession s of connections from node i is given by

Follow[list_, i_, s_List] := Fold[list〚#1〛〚#2〛 &, i, s]

The total number of distinct nodes reached by following all possible succession of connections up to length d is given by

NeighborNumbers[list_, i_Integer, d_Integer] := Map[Length, NestList[Union[Flatten[list〚#〛]] &, Union[list〚i〛], d - 1]]

For each such list the rules for the network system then specify how the connections from node i should be rerouted. The rule {2, 3}  {{2, 1}, {1}} specifies that when NeighborNumbers gives {2, 3} for a node i, the connections from that node should become {Follow[list, i, {2, 1}], Follow[list, i, {1}]}. The rule {2, 3}  {{{2, 1}, {1, 1}}, {1}} specifies that a new node should be inserted in the above connection, and this new node should have connections {Follow[list, i, {2, 1}], Follow[list, i, {1, 1}]}. With rules set up in this way, each step in the evolution of a network system is given by

NetEvolveStep[{depth_Integer, rule_List}, list_List] := Block[{new = {}}, Join[Table[Map[NetEvolveStep1[#, list, i] &, Replace[NeighborNumbers[list, i, depth], rule]], {i, Length[list]}], new]]

NetEvolveStep1[s : {___Integer}, list_, i_] := Follow[list, i, s]

NetEvolveStep1[{s1 : {___Integer}, s2 : {___Integer}}, list_, i_] := Length[list] + Length[AppendTo[new, {Follow[list, i, s1], Follow[list, i, s2]}]]

The set of nodes that can be reached from node i is given by

ConnectedNodes[list_, i_] := FixedPoint[Union[Flatten[{#, list〚#〛}]] &, {i}]

and disconnected nodes can be removed using

RenumberNodes[list_, seq_] := Map[Position[seq, #]〚1, 1〛 &, list〚seq〛, {2}]

The sequence of networks obtained on successive steps by applying the rules and then removing all nodes not connected to node number 1 is given by

NetEvolveList[rule_, init_, t_Integer] := NestList[(RenumberNodes[#, ConnectedNodes[#, 1]] &)[NetEvolveStep[rule, #]] &, init, t]

Note that the nodes in each network are not necessarily numbered in the order that they appear on successive lines in the pictures in the main text. Additional information on the origin of each new node must be maintained if this order is to be found.