Btukfyl

The Survival Probability for a walker starting at the origin is defined as the probability that the walker stays positive through n steps. Thanks to the Sparre-Andersen Theorem I know this pdf is given by

Plot[Binomial[2 n, n]*2^{-2 n}, {n, 0, 100}]

However, I want to validate this empirically.

My attempt to validate this for n=100:

FoldList[

  If[#2 < 0, 0, #1 + #2] &, 

  Prepend[Accumulate[RandomVariate[NormalDistribution[0, 1], 100]], 0]]

I wantFoldList to stop if #2 < 0 not just substitute in 0.

We can do this using an implementation of FoldWhileList.

First, implement FoldWhileList using this great answer.

FoldWhileList[f_, test_, start_, secargs_List] := 

 Module[{tag}, 

  If[# === {}, {start}, Prepend[First@#, start]] &@

   Reap[Fold[If[test[##], Sow[f[##], tag], Return[Null, Fold]] &, 

      start, secargs], _, #2 &][[2]]]

Now we simply run this using the test #2 >= 0 (note that the implementation of NestWhile breaks when test stops evaluating True - our implementation of FoldWhileList also does this, therefore we invert the test you originally used.

FoldWhileList[Plus, #2 >= 0 &, 0, 

 Prepend[Accumulate[RandomVariate[NormalDistribution[0, 1], 100]], 0]]

We can now estimate your PDF:

and overlay it over the original plot also:

Something seems odd to me about your code. You are summing twice, once with Accumulate and once with FoldList. If this is really what you want then you could use:

SeedRandom[26]

sum = Prepend[Accumulate[RandomVariate[NormalDistribution[0, 1], 100]], 0];



TakeWhile[sum, NonNegative] // Accumulate

8



{0, 1.10708, 1.23211, 2.28173, 3.30295, 4.05759, 5.26123, 6.62964}

This is equivalent to your FoldList construct up to the appropriate point:

FoldList[If[#2 < 0, 0, #1 + #2] &, sum]

{0, 1.10708, 1.23211, 2.28173, 3.30295, 4.05759, 5.26123, 6.62964, 0, ...

Perhaps you meant to only sum once. In that case TakeWhile[sum, NonNegative] is a direct solution but also sub-optimal as it does not provide early exit behavior, which I suspect is what you're actually after here. It is not clear to me if you need the cumulative sum (walk) itself or only its length; if the latter consider this:

SeedRandom[26]

dist = RandomVariate[NormalDistribution[0, 1], 100];



Module[{i = 0},

  Fold[If[# < 0, Return[i, Fold], i++; # + #2] &, 0, dist]

]

8

It seems to me that this is a problem to which Catch and Throw can be usefully applied.

SeedRandom[1];

Module[{result = {0}, s},

  Catch[

    FoldList[

      If[#2 < 0, Throw[result], result = {result, s = #1 + #2}; s] &,

      0,

      Accumulate[RandomVariate[NormalDistribution[0, 1], 100]]]] // 

  Flatten]