20
$\begingroup$

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)?

|improve this question
$\endgroup$
18
$\begingroup$

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.

|improve this answer
$\endgroup$
  • $\begingroup$ Also, watchout, the OP doesn't seem to want a 0 step as an option $\endgroup$ – Rojo Jan 22 '13 at 2:48
  • $\begingroup$ @Mr.Wizard, do you know why Join @@ Reap[f[500][0]][[2, 1]] // Length would work fine but x = Join @@ Reap[f[500][0]][[2, 1]]; causes my kernel to crash (v9) with no message? (Using SeedRandom[7].) If I change $RecursionLimit=Infinity then my x= line works fine. I'm just trying to understand why it does not work with the first $RecursionLimit if Length does. $\endgroup$ – mfvonh Mar 13 '13 at 16:53
  • $\begingroup$ @mfvonh That sounds very strange. The identical code doesn't crash when you add Length? I cannot see how that is anything but a bug. Does Length[ x = Join @@ Reap[f[500][0]][[2, 1]] ]; crash? $\endgroup$ – Mr.Wizard♦ Mar 13 '13 at 22:49
  • $\begingroup$ @Mr.Wizard A little embarrassing--I didn't reset my random seed. It looks like the next walk on seed 7 (after running the first) does not reach the target within a manageable number of steps, at least on my machine, and the kernel just quits. $\endgroup$ – mfvonh Mar 14 '13 at 0:20
  • $\begingroup$ @mfvonh Yes, that can/will happen when the maximum stack depth is exceeded. (We all make mistakes like that, most especially me.) Come to think of it $RecursionLimit = 1*^9 is meaningless I believe as that must be greater than the maximum stack depth. I think a revision to this answer is in order. $\endgroup$ – Mr.Wizard♦ Mar 14 '13 at 0:42
14
$\begingroup$

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

|improve this answer
$\endgroup$
  • $\begingroup$ Nicely done. +1 $\endgroup$ – Mr.Wizard♦ Jan 22 '13 at 11:19
  • $\begingroup$ I'm not seeing the need for /; True is that left over from something? $\endgroup$ – Mr.Wizard♦ Jan 22 '13 at 11:27
  • 2
    $\begingroup$ @Mr.Wizard, it's there to make all that's before bwb[Last@aux + RandomChoice[{-1, 1}]] a condition, so it returns that last part and is tail recursive $\endgroup$ – Rojo Jan 22 '13 at 11:32
  • $\begingroup$ @Mr.Wizard I usually do this in a different and more explicit way (using RuleCondition), but I thought more appropriate to use documented stuff for posts unless there's is a real advantage, right? $\endgroup$ – Rojo Jan 22 '13 at 11:33
  • 2
    $\begingroup$ @BeauGeste I see that you Accepted my answer. Thank you, but I think Rojo's answer is clearly superior if performance is a concern. I'm still not sure of the details of your problem myself. For example you say you want t1, t2, t3 interleaved; cannot this be done with Riffle afterward? $\endgroup$ – Mr.Wizard♦ Jan 22 '13 at 18:29
7
$\begingroup$

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}

|improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.