Simulation with two random walkers on a lattice with periodic boundaries

Question

I am having some difficulties implementing a Monte Carlo simulation in order to compare the results to analytical calculations. The following code simulates a case with one random walker and a stationary trap. The results from the code below match the analytical calculations. The average walk-length for a 5x5 lattice turns out to be about 31.66, which is correct.

stepTypes = {{0, 1}, {1, 0}, {0, -1}, {-1, 0}};
pos1 = RandomInteger[{0, 4}, 2];
While[pos1 != {2, 2}, (*{2,2} is the stationary trap*)
 pos1 = Mod[pos1 + RandomChoice[stepTypes], 5];
 index++
 ]
Print["Walk length is:", index];
index = 0;

But when analyzing the same case, only replacing the trap with another random walker. The results dont match at all, they tend to be higher than the analytical and the difference increases hyperbolically as the lattice size grows.

stepTypes = {{0, 1}, {1, 0}, {0, -1}, {-1, 0}};
pos1 = RandomInteger[{0, 4}, 2];
pos2 = RandomInteger[{0, 4}, 2];
While[pos1 != pos2,
  pos1 = Mod[pos1 + RandomChoice[stepTypes], 5];
  pos2 = Mod[pos2 + RandomChoice[stepTypes], 5];

  index++;
  ];
Print["Walk length is:", index];
index = 0;

By simulating the first case I was able to tell that my boundary conditions and the random number generation work correct. Not sure if the problem is in the way I synchronize the two walkers' movement? While loop tests the condition after both walkers have moved and increments the walk-length counter once both have moved as well. Any ideas of why the second case does not work? Perhaps it has to do with a subsequent random number generation?

Note: The original code runs this simulation N number of times and computes the average.

Analytics:

N     Walker/Trap     Two Walkers
---------------------------------
3     8.99            8.00
4     18.33           22.23
5     31.66           26.10
6     49.24           52.67
7     71.82           56.61

Answer 1

This is not answer, but an extremely long comment.

I find this problem very interesting, but haven't been able to solve it. In my attempts, I developed a tool to visualize the the two-walker random walk. I am posting this tool because I think it might be useful to the OP or anyone else looking this problem for exploring what's going on.

steps = {{0, 1}, {1, 0}, {0, -1}, {-1, 0}};

simulation[n_, max_] :=
  Module[{index, w1, w2, pos1, pos2},
    index = 0;
    pos1 = RandomInteger[{0, n - 1}, 2];
    pos2 = RandomInteger[{0, n - 1}, 2];
    w1 = {pos1}; w2 = {pos2};
    While[pos1 != pos2 && index <= max,
      AppendTo[w1, pos1 = Mod[pos1 + RandomChoice[steps], n]];
      AppendTo[w2, pos2 = Mod[pos2 + RandomChoice[steps], n]];
      index++];
    {w1, w2}]

path[pts : {{_, _} ...}, color_?ColorQ, r_Real] := 
  {color, 
   {Opacity[.5], Line[Subsequences[pts, {2}]]},
   {Thick, Circle[pts[[1]], r]}, (* start marker *)
   Circle[pts[[-1]], 1.6 r]}     (* end marker *)

visualize[n_, max_: 500] :=
  Module[{w1, w2, r},
    r = .016 (n - 1);
    {w1, w2} = simulation[n, max];
    Graphics[
      {{PointSize[Scaled[.018]], 
         Point @ Flatten[CoordinateBoundsArray[{{0, n - 1}, {0, n - 1}}], 
       1]},                  (* lattice points *)
      {path[w1, Red, 1.4 r], (* red walker path *)
       path[w2, Blue, r]}},  (* blue walker path *)
      PlotRangePadding -> Scaled[.05]]]

Here are two interesting paths (from a code developer's point-of-view).

visualize[9]

The above walk is interesting because the walk ended at the starting point of the blue walker and demonstrates why the marker circles are scaled the way the are.

visualize[8]

This one is interesting because it is one of the relatively rare even lattice simulations to come to a successful conclusion.

I really hope someone will come up with an answer to this question soon because I spending too much time on and not getting much out it.

Answer 2

Here is my code for a single walker:

singleWalker[] := Module[{
    stepTypes = {{0, 1}, {1, 0}, {0, -1}, {-1, 0}},
    pos1 = RandomInteger[{0, 4}, 2]
    },
Return@Rest@NestWhileList[
    Mod[# + RandomChoice[stepTypes], 5] &,
    pos1,
    # != {2, 2} &
    ];
]

Doing walks = (singleWalker[] & /@ Range[1000]); and measuring N@Mean[Length /@ walks] gives (in my case) 31.013. I'm not confident I'm measuring exactly the right length (I took Rest to count the number of steps, rather than the number of places the walker stood, which is different by 1).

You can also look at Histogram[Length /@ walks].

Here's my (edited to handle the switcheroo/synchronization case as discussed in the comments) code for two walkers:

twoWalkers[] := 
  Module[{stepTypes = {{0, 1}, {1, 0}, {0, -1}, {-1, 0}}, 
          pos1 = RandomInteger[{0, 4}, 2], pos2 = RandomInteger[{0, 4}, 2]}, 
    Return@Rest@
    NestWhileList[
        Mod[# + {RandomChoice[stepTypes], RandomChoice[stepTypes]}, 5] &,
        {pos1, pos2}, 
        Not@Or[#2[[1]] == #2[[2]], And[#1 == Reverse[#2]]] &, 2];
    ]

Then, doing walks2 = (twoWalkers[] & /@ Range[1000]); and N@Mean[Length /@ walks2] gives about 35.47 25.8.

I think the issue is that you are measuring far too few N. Monte Carlo often requires hundreds or thousands of measurements to get a good answer, and you need to convince yourself that you're in the "infinite statistics" limit. The dramatic hopping around that you get for small N suggests that you're not taking a reliable average (ie. that your ensemble is too small).

This is related to the fact that the Histograms are very long-tailed.

Answer 3

The discrepancy had to do with the way the walkers were subsequently moved. You have to either move synchronously (on separate threads perhaps) or you have to make it check for a specific case where the walkers are exactly one step away and their next step is towards each other. In other words, if they swap positions then there was a collision.

Thanks everyone.