The Easter Egg Problem:

Towards a Space of Solutions

 

Adrian German

Indiana University Bloomington

 

 

Problem Specification

 

The Easter Egg Problem was formulated by George Danner in 2003:

 

 

http://forum.wolframscience.com/showthread.php?threadid=148

 

http://forum.wolframscience.com/attachment.php?s=164bb52d25c01f3bb3366befefb22e83&postid=382

 

Idea and Basic Constraints for a Solution

 

We will develop a solution based on a simple, near-sighted agent in a cartesian lattice. Our solution can be easily generalized to any number of agents. An agent can only see as far as twice its own size in all directions. The agent will work on the border of a closed, non-intersecting curve (one curve per agent). The basic constraints refer to the topology these curves can have. We start with these, below.

 

Initialization Code

 

These definitions simply allow us to plot graphically the basic topological constraints for the type of curve we use.

 

f[specs_] :=

  Flatten[

   Table[{i, j, specs[[i, j]]},

   {i, 1, Length[specs]},

   {j, 1, Length[specs[[1]]]}], 1];

 

g[rects_] :=

Map[With[

     {x = Part[#, 1],

      y = Part[#, 2],

      color = Part[#, 3]} ,

     If[color ===  None,

      Thick, 

      {EdgeForm[Gray], color, Rectangle[{x - 1, y - 1}, {x, y}]}] ] &,

   rects];

 

h [specs_] := Flatten[g[f[specs]]];

add[patt_, x_, y_, angle_] :=

  With[

   {arrow =

     {Thick,

      EdgeForm[Black],

      Yellow,

      Polygon[{{0, 0}, {4, 0}, {4, -1/2}, {5, 1/2}, {4, 3/2}, {4, 1}, {0, 1}}]}},

   Append[ patt,

           Translate[Scale[Rotate[arrow, angle Degree], 1/4], {x - 5/2, y + 1/2}]]];

 

rule[cells_, x_, y_, angle_] := Graphics[add[h[cells],  x, y, angle]];

 

rule[cells_] := Graphics[h[cells]]

 

With these definitions we can now show the only five distinct types of configurations the curve might have at any given point.  

 

 List[

    rule[{{White, White, Blue}, {White, Blue, White}, {White, White, Blue}}],

    rule[{{White, White, Blue}, {White, Blue, White}, {White, Blue, White}}],

    rule[{{White, White, Blue}, {White, Blue, White}, {Blue, White, White}}],

    rule[{{White, White, Blue}, { Blue, Blue, White}, {White, White, White}}],

    rule[{{White, White, White}, {Blue, Blue, Blue}, {White, White, White}}]

 ]

 

 {,,,,}

 

Note that configurations that are obtained through rotations by 90 degrees are also allowed, but were not included here.

 

Note also that every point on the curve has two and only two neighbors. 

 

 

The Basic Rules

 

The agent acts as the head of a Turing machine, constantly rewriting the border. There are 11 rewriting rules, shown below. For each rule rotations by 90 degrees of both the left and right hand sides have not been represented, but need to be taken into account during pattern matching. In each diagram the border is pink, the inside is shown in blue, the outside in white. In a typical left hand side of a rule the agent is on the border, its cell shown in yellow. The agent constantly moves, always staying on the border, looking for a pattern that can trigger a substitution rule. The momentum is not shown on the left hand side of any rule, but is explicitly shown on the right hand side with an arrow. The arrow points to the current location (cell) of the agent, and indicates the direction of movement. If no substitution rule applies, the movement continues in accordance with this momentum, in the direction of the arrow.  All substitution rules below represent expansions (the inside only grows, never shrinks) and such that the topological constraints mentioned earlier are respected.

 

Here's the first rule:

 

 one =

  List[

    rule[{{Blue, Blue, Pink, White},

          {Blue,Yellow, White, White},

          {Blue, Blue, Pink, White}}],

    rule[{{Blue, Blue, Pink, White},

          {Blue,Blue, Pink, White},

          {Blue, Blue, Pink, White}}, 2, 2-1/2,0]]

 

 {,}

 

The second rule is a refinement of the first in terms of connectivity with its immediate neighborhood: 

 

 two =

  List[

    rule[{{Blue, Blue, Pink, White},

          {Blue, Yellow, White, White},

          {Blue, Blue, Pink, Pink}}],

    rule[{{Blue, Blue, Pink, White},

          {Blue, Blue, Pink, White},

          {Blue, Blue, Blue, Pink}}, 2, 2, 225]]

 

 {,}

 

The third rule is the mirror image of the second (can't be obtained through rotation): 

 

 three =

  List[

    rule[{{Blue, Blue, Pink, Pink},

          {Blue, Yellow, White, White},

          {Blue, Blue, Pink, White}}],

    rule[{{Blue, Blue, Blue, Pink},

          {Blue, Blue, Pink, White},

          {Blue, Blue, Pink, White}}, 1, 2, -45]]

 

 {,}

 

The fourth rule is a combination of the previous two rules: 

 

 four =

   List[

    rule[

     {{Blue, Blue, Pink, Pink},

      {Blue, Yellow, White, White},

      {Blue, Blue, Pink, Pink, Pink}}],

    rule[

     {{Blue, Blue, Blue, Pink},

      {Blue, Blue, Pink, White},

      {Blue, Blue, Blue, Pink}}, 1, 2, -45]]

 

 {,}

 

This fifth rule is in some sense the complement of the first rule: 

 

 five =

   List[

    rule[

     {{None, White, White, White},

      {White, White, White, Pink},

      {White, White, Yellow, Blue},

      {White, White, White, Pink},

      {None, White, White, White}}],

    rule[

     {{None, White, White, White},

      {White, White, Pink, Pink},

      {White, Pink, Blue, Blue},

      {White, White, Pink, Pink},

      {None, White, White, White}}, 2, 1, 135]]

 

 {,}

 

The next two rules are related: the border configuration is the same, but the inside is on one side in one case, and on the other in the next.  

 

 six =

   List[

    rule[

     {{Blue, Blue, Pink, White},

      {Blue, Yellow, White, White},

      {Blue, Pink, White, White}}],

    rule[

     {{Blue, Blue, Pink, White},

      {Blue, Blue, Pink, White},

      {Blue, Pink, White, White}}, 2, 1, -45]]

 

 {,}

 

Since the rules expand only the inside the border changes slightly differently in the case of rule seven: 

 

 seven =

   List[

    rule[

     {{None, White, White, White},

      {White, White, White, Pink},

      {White, White, Yellow, Blue},

      {White, White, Pink, Blue}}],

    rule[

     {{None, White, White, White},

      {White, White, Pink, Pink},

      {White, Pink, Blue, Blue},

      {White, White, Pink, Blue}}, 3, 1,45]]

 

 {,}

 

Rule eight describes the expansion in the case of a straight diagonal pattern: 

 

 eight =

   List[

    rule[

     {{Blue, Blue, Pink, White},

      {Blue, Yellow, White, White},

      {Pink, White, White, White},

      {White, White, White, None}}],

    rule[

     {{Blue, Blue, Pink, White},

      {Blue, Blue, Pink, White},

      {Pink, Pink, White, White},

      {White, White, White, None}}, 2,1, -45]]

 

 {,}

 

Rules nine and ten are, again, complementary in some sense:

 

 nine =

   List[

    rule[

     {{Blue, Blue, Pink, White},

      {Pink, Yellow, White, White},

      {White, White, White, White},

      {White, White, White, None}}],

    rule[

     {{ Blue, Blue, Pink, White},

      {Pink, Blue, Pink, White},

      {White, Pink, White, White},

      {White, White, White, None}}, 2, 0, 225]]

 

 {,}

 

The border changes to a different configuration in rule ten, since the inside is on the other side: 

 

 ten =

   List[

    rule[

     {{White, White, White},

      {White, White, Pink},

      {Pink,Yellow, Blue},

      {Blue, Blue, Blue}}],

    rule[

     {{White, White, White},

      {White, Pink, Pink},

      {Pink, Blue, Blue},

      {Blue, Blue, Blue}}, 3/2, 1, -90]]

 {,}

 

The last rule deals with a straight line non-diagonal border:

 

 eleven =

   List[

    rule[

     {{Blue, Pink, White, White},

      {Blue, Yellow, White, White},

      {Blue, Pink, White, White}}],

    rule[

     {{Blue, Pink, White, White},

      {Blue, Blue, Pink, White},

      {Blue, Pink, White, White}}, 1, 1, 225]]

 

 {,}

 

 

The Initial Configuration

 

Each agent creates a minimal border, surrounding its initial position, steps on it and starts movement as shown below:

 

 initial =

   rule[

    {{None, White, White, White, None},

     {White, White, Pink, White, White},

     {White, Pink, Blue, Pink, White},

     {White, White, Pink, White, White},

     {None, White, White, White, None}}, 3, 1, -135]

 

 

 

 

The rewriting rules are then applied, in a loop.

 

 

Implementation

 

In this section we present a simple implementation of the rules shown earlier, and make a few basic comments on it.

 

Let's start assuming a 1600 cells neighborhood that needs to be explored.

 

 size = 40

 40

 

 w = Table[0, {size}, {size}];

 

So w is the area in which we demonstrate the behavior of the agent that's exploring the area.

 

The show function below is meant to plot graphically the area. Currently the area is empty.

 

 show[w_] := ArrayPlot[w, ColorRules -> {1 -> Blue,

                                         0 -> White,

                                         2 -> Pink,

                                         3 -> Orange,

                                         4 -> Yellow,

                                         5 -> Red}]

 

 show[w]

 

 

 

Now let's add some eggs (goals, targets, whatever we want to name them) and place the agent in the center.

 

 

init[mat_] :=

   Module[

    {w, i, j},

     w = mat;

     i = Floor[size/2];

     j = Floor[size/3];

     {w[[i, i]], w[[i-1, i]], w[[i+1, i]], w[[i,i-1]], w[[i, i + 1]]} = {1,2, 4, 2, 3};

   {w[[j, j]], w[[2 j,Floor[3  size /6]]], w[[Floor[2 size/5],Floor[3 size/5]]]} = {5, 5, 5};

 

    w]

 

 

 show[init[w]]

 

 

 

So this is where our simple illustration starts.

 

Next I define a map function that I am sure is in Mathematica already, only I haven't found it so I am defining it for expediency (and will continue looking for it).

 

 myMap[f_, l1_, l2_] :=

   If[Length[l1] == 0, {},

    If[ListQ[First[l1]],

     Prepend[myMap[f, Rest[l1], Rest[l2]], myMap[f, First[l1], First[l2]]],

     Prepend[myMap[f, Rest[l1], Rest[l2]], f[First[l1], First[l2]]]]]

 

Another function needed helps me rotate a pattern by 90 degrees left:

 

 turnLeft[p_, n_] := Nest[Reverse[Transpose[#]] &, p, n]

 

Finally, here's the one state update function:

 

update[mat_] :=

  Module[

    {w, i, j, a, b, zone, B, pattern1, replace1, pattern2, replace2,

     pattern3, replace3, pattern4, replace4, pattern5, replace5, pattern6,

     replace6, pattern7, replace7, pattern8, replace8, pattern9, replace9,

     pattern10, replace10, pattern11, replace11},

 

  (* note that B stands for a Border cell *)

 

  B = 2 | 3| 4;

 

  (* internally 1 is inside, 0 is outside,

     2 is empty border, 4 is agent on the border,

     3 is previous position of agent on border for momentum purposes *)

 

  w = mat;

 

  {i, j} = First[Position[w, 4]];

  {a, b} = First[Position[w, 3]];

 

  (* also notice the patterns and replacement rules are almost transparent in this notation *)

 

  pattern1 = {

    {_, 0, 0, 0, _},

    {_, B, 0, B, _},

    {_, 1, B, 1, _},

    {_, 1, 1, 1, _},

    {_, _, _, _, _}};

  replace1 = {

    {_, _, _, _, _},

    {_, 2, 3, 4, _},

    {_, _, 1, _, _},

    {_, _, _, _, _},

    {_, _, _, _, _}

    };

 

  pattern2 = {

    {_, 0, 0, B, _},

    {_, B, 0, B, _},

    {_, 1, B, 1, _},

    {_, 1, 1, 1, _},

    {_, _, _, _, _}};

  replace2 = {

    {_, _, _, 3, _},

    {_, 2, 4, 1, _},

    {_, _, 1, _, _},

    {_, _, _, _, _},

    {_, _, _, _, _}

    };

 

  pattern3 = {

    {_, B, 0, 0, _},

    {_, B, 0, B, _},

    {_, 1, B, 1, _},

    {_, 1, 1, 1, _},

    {_, _, _, _, _}};

  replace3 = {

    {_, 3, _, 0, _},

    {_, 1, 4, 2, _},

    {_, _, 1, _, _},

    {_, _, _, _, _},

    {_, _, _, _, _}

    };

 

  pattern4 = {

    {_, B, 0, B, _},

    {_, B, 0, B, _},

    {_, 1, B, 1, _},

    {_, 1, 1, 1, _},

    {_, _, _, _, _}};

  replace4 = {

    {_, 3, _, 2, _},

    {_, 1, 4, 1, _},

    {_, _, 1, _, _},

    {_, _, _, _, _},

    {_, _, _, _, _}

    };

 

  pattern5 = {

    {_, _, _, _, _},

    {0, B, 1, B, 0},

    {0, 0, B, 0, 0},

    {0, 0, 0, 0, _},

    {_, 0, 0, 0, _}};

  replace5 = {

    {_, _, _, _, _},

    {_, 2, _, 2, _},

    {_, 4, 1, 2, _},

    {_, _, 3, _, _},

    {_, _, _, _, _}

    };

 

  pattern6 = {

    {_, 0, 0, 0, _},

    {_, B, 0, 0, _},

    {_, 1, B, B, _},

    {_, 1, 1, 1, _},

    {_, _, _, _, _}};

  replace6 = {

    {_, _, _, _, _},

    {_, 2, 3, _, _},

    {_, _, 1, 4, _},

    {_, _, _, _, _},

    {_, _, _, _, _}

    };

 

  pattern7 = {

    {_, _, _, _, _},

    {0, B, 1, 1, _},

    {0, 0, B, B, _},

    {0, 0, 0, 0, _},

    {_, 0, 0, 0, _}};

  replace7 = {

    {_, _, _, _, _},

    {_, 2, _, _, _},

    {_, 2, 1, 4, _},

    {_, _, 3, _, _},

    {_, _, _, _, _}

    };

 

  pattern8 = {

    {_, 0, 0, 0, _},

    {_, B, 0, 0, 0},

    {_, 1, B, 0, 0},

    {_, 1, 1, B, 0},

    {_, _, _, _, _}};

  replace8 = {

    {_, _, _, _, _},

    {_, 2, 3, _, _},

    {_, _, 1, 4, _},

    {_, _, _, 2, _},

    {_, _, _, _, _}

    };

 

  pattern9 = {

    {_, 0, 0, 0, _},

    {_, B, 0, 0, 0},

    {_, 1, B, 0, 0},

    {_, 1, B, 0, 0},

    {_, _, _, _, _}};

  replace9 = {

    {_, _, _, _, _},

    {_, 2, 2, _, _},

    {_, _, 1, 3, _},

    {_, _, 4, _, _},

    {_, _, _, _, _}

    };

 

  pattern10 = {

    {_, _, _, _, _},

    {0, B, 1, 1, _},

    {0, 0, B, 1, _},

    {0, 0, B, 1, _},

    {_, _, _, _, _}};

  replace10 = {

    {_, _, _, _, _},

    {_, 3, _, _, _},

    {_, 4, 1, _, _},

    {_, _, 2, _, _},

    {_, _, _, _, _}

    };

 

  pattern11 = {

    {_, 0, 0, 0, _},

    {_, 0, 0, 0, _},

    {_, B, B, B, _},

    {_, 1, 1, 1, _},

    {_, _, _, _, _}};

  replace11 = {

    {_, _, _, _, _},

    {_, _, 3, _, _},

    {_, 4, 1, 2, _},

    {_, _, _, _, _},

    {_, _, _, _, _}

    };

 

  If [ i >= 3 && j >= 3 && i + 2 <= Length[w] && j + 2 <= Length[w[[Length[w]]]],

 

   (* apply patterns *)

 

   zone = Take[w, {i-2, i+2}, {j-2, j+2}] ;

 

   Switch[zone,

    (* everything below can be shrunk to a couple of lines,

       I prefer to present it like this though for pedagogical reasons *)

 

    turnLeft[pattern1, 0] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,turnLeft[zone, 0],turnLeft[replace1, 0]], 

    turnLeft[pattern1, 1] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace1, 1]],

    turnLeft[pattern1, 2] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace1, 2]],

    turnLeft[pattern1, 3] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace1, 3]],

   

    turnLeft[pattern2, 0] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,turnLeft[zone, 0],turnLeft[replace2, 0]], 

    turnLeft[pattern2, 1] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace2, 1]],

    turnLeft[pattern2, 2] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace2, 2]],

    turnLeft[pattern2, 3] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace2, 3]],

   

    turnLeft[pattern3, 0] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,turnLeft[zone, 0],turnLeft[replace3, 0]], 

    turnLeft[pattern3, 1] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace3, 1]],

    turnLeft[pattern3, 2] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace3, 2]],

    turnLeft[pattern3, 3] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace3, 3]],

   

    turnLeft[pattern4, 0] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,turnLeft[zone, 0],turnLeft[replace4, 0]], 

    turnLeft[pattern4, 1] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace4, 1]],

    turnLeft[pattern4, 2] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace4, 2]],

    turnLeft[pattern4, 3] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace4, 3]],

   

    turnLeft[pattern5, 0] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,turnLeft[zone, 0],turnLeft[replace5, 0]], 

    turnLeft[pattern5, 1] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace5, 1]],

    turnLeft[pattern5, 2] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace5, 2]],

    turnLeft[pattern5, 3] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace5, 3]],

   

    turnLeft[pattern6, 0] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,turnLeft[zone, 0],turnLeft[replace6, 0]], 

    turnLeft[pattern6, 1] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace6, 1]],

    turnLeft[pattern6, 2] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace6, 2]],

    turnLeft[pattern6, 3] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace6, 3]],

   

    turnLeft[pattern7, 0] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,turnLeft[zone, 0],turnLeft[replace7, 0]], 

    turnLeft[pattern7, 1] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace7, 1]],

    turnLeft[pattern7, 2] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace7, 2]],

    turnLeft[pattern7, 3] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace7, 3]],

   

    turnLeft[pattern8, 0] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,turnLeft[zone, 0],turnLeft[replace8, 0]], 

    turnLeft[pattern8, 1] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace8, 1]],

    turnLeft[pattern8, 2] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace8, 2]],

    turnLeft[pattern8, 3] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace8, 3]],

   

    turnLeft[pattern9, 0] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,turnLeft[zone, 0],turnLeft[replace9, 0]], 

    turnLeft[pattern9, 1] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace9, 1]],

    turnLeft[pattern9, 2] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace9, 2]],

    turnLeft[pattern9, 3] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace9, 3]],

   

    turnLeft[pattern10, 0] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,turnLeft[zone, 0],turnLeft[replace10,0]], 

    turnLeft[pattern10, 1] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace10, 1]],

    turnLeft[pattern10, 2] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace10, 2]],

    turnLeft[pattern10, 3] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace10, 3]],

   

    turnLeft[pattern11, 0] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,turnLeft[zone, 0],turnLeft[replace11,0]], 

    turnLeft[pattern11, 1] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace11, 1]],

    turnLeft[pattern11, 2] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace11, 2]],

    turnLeft[pattern11, 3] , w[[i-2;;i+2,j-2;;j+2]]=myMap[If[IntegerQ[#2],#2,#1]&,zone,turnLeft[replace11, 3]],

   

    (* if no pattern applies, no substitution happens,

       so the agent just continues motion on the border according to its momentum *)       

 

    _,

 

    If[w[[i-1, j]] == 2, {w[[i-1, j]], w[[i, j]], w[[a, b]] } = {4, 3, 2},

     If[w[[i-1, j-1]] == 2, {w[[i-1, j-1]], w[[i, j]],w[[a, b]] } = {4, 3, 2 },

      If[w[[i-1, j+1]] == 2, { w[[i-1, j+1]], w[[i, j]], w[[a, b]]} = {4, 3, 2 },

       If[w[[i, j-1]] == 2, {w[[i, j-1]], w[[i, j]], w[[a, b]] } = {4, 3, 2 },

        If[w[[i, j+1]] == 2, { w[[i, j+1]], w[[i, j]], w[[a, b]]} = {4, 3, 2 },

         If[w[[i+1, j-1]] == 2, {w[[i+1, j-1]], w[[i, j]], w[[a, b]] } = {4, 3, 2 },

          If[w[[i+1, j]] == 2, {w[[i+1, j]], w[[i, j]], w[[a, b]] } = {4, 3, 2 },

           If[w[[i+1, j+1]] == 2, {w[[i+1, j+1]], w[[i, j]], w[[a, b]] } = { 4, 3, 2}]]]]]]]]],

   If[w[[i-1, j]] == 2, {w[[i-1, j]], w[[i, j]], w[[a, b]] } = {4, 3, 2},

    If[w[[i-1, j-1]] == 2, {w[[i-1, j-1]], w[[i, j]],w[[a, b]] } = {4, 3, 2 },

     If[w[[i-1, j+1]] == 2, { w[[i-1, j+1]], w[[i, j]], w[[a, b]]} = {4, 3, 2 },

      If[w[[i, j-1]] == 2, {w[[i, j-1]], w[[i, j]], w[[a, b]] } = {4, 3, 2 },

       If[w[[i, j+1]] == 2, { w[[i, j+1]], w[[i, j]], w[[a, b]]} = {4, 3, 2 },

        If[w[[i+1, j-1]] == 2, {w[[i+1, j-1]], w[[i, j]], w[[a, b]] } = {4, 3, 2 },

         If[w[[i+1, j]] == 2, {w[[i+1, j]], w[[i, j]], w[[a, b]] } = {4, 3, 2 },

          If[w[[i+1, j+1]] == 2, {w[[i+1, j+1]], w[[i, j]], w[[a, b]] } = { 4, 3, 2}]]]]]]]]];

 

  w]

 

 

 

So this is the starting point (area contains three targets, in red):

 

 show[init[w]]

 

 

 

This is how the area looks in the first three moments: empty, initialized and after the first rewriting rule is applied.

 

 Map[show, {w, init[w], update[init[w]]}]

 

 {,,}

 

This is how the area looks after 37 steps: the pattern has grown in a (rectangular) spiral.

 

 show[Last[NestList[update, init[w],37]]]

 

 

 

This is how the area looks after 137 steps: the pattern is distorted by the targets, as they are identified.

 

 show[Last[NestList[update, init[w],137]]]

 

 

 

This is how the area looks after 1137 steps: the inside keeps growing.

 

 show[Last[NestList[update, init[w],1137]]]

 

 

 

The last picture takes about 10 seconds to be generated (maybe less, but overall I'd call that "fast enough").

 

Notice that the rules don't indicate what we should do with the targets once we identify them. Rules can be easily augmented with such information, though.

 

To see the exploration in real-time type, for example, this:

 

            ListAnimate[Map[show, NestList[update, init[w], 440]], 6]

 

It will generate all 440 steps that lead to this configuration, from the initial configuration, in an animation that shows six frames per second.

 

 show[Last[NestList[update, init[w], 440]]]

 

 

 

While this picture is created in about 6-7 seconds it takes almost a full minute for the entire animation to be prepared.

 

The exploration of the entire area is completed in about 3200 steps (1600 cells in all).

 

To see the full animation replace 440 with 3200, but be prepared to wait 3-4 minutes for the animation to be set up.

 

 show[Last[NestList[update, init[w], 3200]]]

 

 

 

Here's the area after the first 1600 steps:

 

 show[Last[NestList[update, init[w], 1600]]]

 

 

 

 

Related Work

 

In what follows I will offer a minimal set of references.

 

See page 331 in the book,  chapter 7 and related notes. Note my agent can't teleport itself.

 

See also Robert Barbour, 2D Four-Color Cellular Automaton at the 2006 NKS Conference:

 

            http://wolframscience.typepad.com/wolfram_science/2006/06/robert_made_a_p.html

 

Also Andrew Bragdon, NKS SS 2005, the link is in the blogpost referenced above.

 

I'll clean up this list a bit later.

 

 

Conclusions and Future Work

 

There are 11 rules, each with a momentum arrow in their right hand side. This gives us a total of 2,048 possible rule sets. They need to be explored starting from an empty world, a simple initial world and a random initial world (crowded or non-crowded). For each configuration of 11 rules (including the one I have chosen above) a comparison with a random walk needs to be made.

 

The rules above have been selected in the summer of 1993 after a primitive NKS search (essentially by hand) made me stop at this set of rules. Obviously, the Easter Egg problem had not been formulated at that time and there was no NKS per se (which is why I probably didn t think of looking at all 2,048 rule sets). My initial motivation was to provide a set of rules that would allow an agent to explore an area as if it were cleaning it, using a mop or a vacuum cleaner. In an empty world the search generated by this set of rules is very conservative: the inside spreads as water on the table in all directions, but don t forget this is the outcome of a single agent s actions. Once the obstacles are encountered they are isolated and avoided. They slow down a bit the  intended purpose  of the rules since (in this specification) the eggs, goals, targets are not to be moved, only detected and a map built and since the rules tend to try to re-establish the convex topology of the curve, which is of course impossible. However it must be noted that this affects the movement only temporarily.

 

I defer a full analysis of the rule set(s) to a future paper (presentation). I just want to point out that if the obstacles are removed the border comes to life and continues to extend just as water on a table would. That is a direct outcome of the constant movement on the border which might otherwise seem a bit exorbitant (that is, excessive or redundant). Adding additional agents does not change virtually anything since two (or more) agents coming near each other would perceive each other as obstacles, suppress the pattern matching and force each other  to continue movement on their respective borders  and thus, essentially, going away from (avoiding) each other.

 

All other considerations should be made in the context of the full investigation (the 211cases), soon to follow.

 

Ultimately, the restriction that the border be a simple Jordan curve should be lifted, and resulting approaches should be studied.

 

dgerman@indiana.edu

July 31, 2007