1D Random Walk variant

Question

I am making a notebook that is a variation to the traditional 1d random walk problem. The normal 1D random walk can be simulated easily by

Map[Accumulate, {RandomChoice[{-1, 1}, {100}]}] // Flatten

{1, 2, 3, 4, 5, 4, 3, 4, 5, 6, 5, 6, 7, 6, 7, 6, 5, 6, 7, 8, 7, 8, 9, 8, 7, 8, 9, 8, 7, 6, 5, 4, 3, 2, 1, 2, 1, 2, 3, 4, 5, 4, 3, 4, 5, 6, 7, 8, 7, 6, 5, 4, 3, 2, 1, 2, 1, 0, 1, 0, -1, 0, -1, 0, -1, 0, 1, 0, -1, -2, -1, -2, -3, -2, -1, 0, -1, -2, -1, 0, 1, 0, 1, 0, -1, 0, -1, -2, -1, -2, -1, 0, -1, 0, 1, 0, 1, 0, 1, 2}

As shown, this returns a list of positions along the x-axis for each of the 100 steps.

However, instead of choosing a set number of steps, I would like to discontinue the walk when a certain points is reached. This, of course, would make the length of the list of locations vary between each run as it will take a different number of steps to reach x = 10, for instance. How can I do this (without a For loop)?

Answer 1

As ssch alluded to in a comment this can be easily done with NestWhileList:

NestWhileList[# + RandomChoice[{-1, 1}] &, 0, # < 10 &]

This is hardly the only way to proceed however. You could for example Sow and Reap values from within a recursion:

f[x_] /; x < 10 := f @ Sow[x + RandomChoice[{-1, 1}]];

Reap[f[0]][[2, 1]]

This actually converts to iteration, and is therefore limited by $IterationLimit rather than $RecursionLimit. You can raise $IterationLimit to increase the maximum number of steps.

You could use replacement rules and ReplaceRepeated:

{0} //. {h___, x_} /; x < 10 :> {h, x, x + RandomChoice[{-1, 1}]}

---

Rojo posted an answer that uses a couple of advanced techniques to cleverly optimize this problem. One would do well to take a close look at it; one of the techniques is very nice and new to me and I'm not new at this game.

Nevertheless, reasonably fast performance can be had with a significantly simpler block-based method. This is about a third slower than his method in my tests but the code is probably easier to understand and quite a bit shorter. The block size (here 1*^4) can be adjusted according to your average run length.

f[target_Integer] :=
  Block[{new, pos, $RecursionLimit = 1*^9},
    new = # + Accumulate @ RandomChoice[{-1, 1}, 1*^4];
    pos = Position[new, target, 1, 1];
    If[pos === {},
      Sow @ new; #0 @ Last @ new,
      Sow @ Take[new, pos[[1, 1]] ]
    ]
  ] &

SeedRandom[7]
Join @@ Reap[ f[500][0] ][[2, 1]] // Length // Timing

{1.233, 19262470}

By comparison:

SeedRandom[7]
walker[500] // Length // Timing

{0.921, 19257825}

(The length is slightly different as not every number from the PRNG is used.)

---

Update: Rojo improved his answer and now:

SeedRandom[7]

walker[502] // Length // Timing

{0.281, 19446001}

I had to use 502 to get a similar length because the PRNG was again used a little differently.

Answer 2

If the current position is, say, 2, and the maximum value we allow is, say, 14, we can walk 12 steps with our eyes closed. This attempts to take advantage of that.

newList gives the list of new values given the maximum and the starting value.

newList = Compile[{{max, _Integer}, {start, _Integer}},
   Module[{aux},
    aux = RandomChoice[{-1, 1}, max - start];
    aux[[1]] = start;
    Accumulate[aux]
   ]];

Those with v8 or higher can try adding RuntimeOptions -> "Speed" or CompilationTarget->"C"

buildWalkerBag is the recursive function. It uses bags. It could have been done with linked lists, or sowing and reaping in the end (I tried this at first but it was a little bit slower than the bags)

SetAttributes[buildWalkerBag, HoldFirst];

(bwb : buildWalkerBag[bag_, max_])[next_] /; next =!= max := 
  With[{aux = newList[max, next]}, 
      Internal`StuffBag[bag, aux, 1];
      bwb[Last@aux + RandomChoice[{-1, 1}]] /; True];

buildWalkerBag[bag_, max_][_] := Internal`StuffBag[bag, max]

walker[max_] := Block[{$IterationLimit = Infinity, b = Internal`Bag[]},
      buildWalkerBag[b, max][0];
      Internal`BagPart[b, All]
    ]

USAGE

walker[i_Integer?Positive] where i is the maximum position

Answer 3

This is a slight generalization of Mr.Wizard's NestList solution. I offer it as an answer because it a bit too long for a comment. The zero step has been eliminated and the test function has been changed to allow non-positive limits.

limitedRandomWalk[limit_Integer] :=
   NestWhileList[# + RandomChoice[{-1, 1}] &, 0, # != limit &]

SeedRandom[3]

limitedRandomWalk[-10]

{0, -1, 0, 1, 2, 3, 2, 3, 2, 3, 2, 1, 0, -1, -2, -1, -2, -1, -2, -3, -4, -5, -6, -7, -8, -7, -8, -9, -8, -7, -6, -5, -6, -5, -6, -5, -6, -5, -4, -3, -4, -3, -4, -5, -4, -5, -6, -7, -6, -5, -4, -3, -4, -5, -6, -7, -8, -9, -10}

limitedRandomWalk[10]

{0, 1, 0, -1, -2, -1, 0, 1, 0, -1, 0, 1, 2, 3, 4, 3, 4, 5, 4, 3, 2, 1, 0, 1, 2, 1, 2, 1, 2, 1, 0, 1, 2, 3, 2, 3, 4, 3, 4, 5, 4, 5, 6, 7, 6, 7, 8, 7, 8, 7, 8, 9, 8, 7, 6, 7, 8, 7, 8, 7, 8, 9, 8, 9, 10}

 limitedRandomWalk[0]

{0}