Since this question is a follow-up, this answer will, for the most part, depend on my answer there.
Before getting down to the details of the answer, I would like to comment on a few issues with the code in this question.
With
does not 'do' recursive definitions
Namely, one issue is that With
does not support the kind of sequential assignments used as a first argument. What that means is that evaluating something like
With[{x = 3, y = x^2},
3 y + 1
]
does not return 28
as it would have been probably expected, but 3 x^2 + 1
(assuming of course that x
is a symbol that does not evaluate to anything else eg some numeric value, during the course of evaluation).
As it is the case that another answer to this question links to a really useful post about the different scope constructs in Mathematica, I'd like to provide a link to an answer that actually implements a recursive version of With
in the sense expounded above.
Since this is a slightly more involved avenue to travel down to, I would like to propose a way to solve the problem in the question without having to actually implement such exotic solutions (exotic in the sense that the answer can be derived with simpler means not in the sense that the linked answer is useless or irrelevant, far from it).
Set
and SetDelayed
have different effects
Another issue with the code in the question is related to the final two attempts at recursive definitions in With
. The assignment made to simulationData
uses Set
not SetDelayed
. This means that once the assignment is made, the value of simulationData
does not change in subsequent evaluations. This is not a problem per se but it creates a problem for the flow of the simulation because when the runs
are calculated (outside the first argument of With
this time) they will not contain different random sequences but the same random sequence that was evaluated the first time With
was evaluated. I don't think this is the intended behavior of the code segment.
Minor conceptual and practical issues
Related to simulationData
is a conceptual issue; the way NestList
iterates the nested results, upon success it returns just the prize of the investment while upon failure it returns a figure that is conceptually (probably) expected to be the result from continuously investing (either a positive number or zero) but in actual fact that is not the case. Upon success, the result that gets passed to the next iteration of NestList
is simply the increment in available funds instead of the sum of the available funds augmented by any possible gains from investing; therefore simulationData
does not record 'wealth' (stock) but 'income' (flow), so to speak.
Finally, the assignment to finalBankrolls
is redundant; it is possible to obtain the same effect when needed with less effort. This wouldn't have been a serious problem with the code, had the problem with the recursive definitions not been an issue to begin with.
Proposed solution
The proposed solution extends my answer in the previous question in such a way as to obtain the required statistics ie. frequencyOfBust
and frequencyOfOutsizedReturn
.
There are minor changes needed inside the code of simulation
and the addition of a function that performs the desired calculations.
The first line in the Module
of simulation
should read
{distribution, repetitions, observations} = {args};
This line is prepended in order to make the arguments of randomSequence
available in the rest of the code.
label
(just before legend
) should now read
label = Row[Riffle[Thread[header -> {args}], ", "]]
The last line of simulation
should be modified to
Join[{Legended[ListLinePlot[series, Apply[Sequence][opts]], Placed[legend, Below]]},
collectStats[series, capital, repetitions, observations]]
where collectStats
is the new function that will perform the required calculations.
Following is the implementation of collectStats
:
collectStats[randomMatrix_, args___] := Module[{capital, repetitions, observations, folder, combined,
bustFreq, xtrmRets, onBust, opts, label},
(* retrieve relevant args *)
{capital, repetitions, observations} = {args};
(* frequency of bust and 'extreme' returns *)
folder = With[{sum = #1 + #2}, If[sum >= 0, sum, -Infinity]] &;
combined = With[{diff = #, maxDiff = Max[#]},
{Fold[folder, capital, diff], {maxDiff, Count[#, maxDiff]}}
] & /@ Differences[randomMatrix, {0, 1}];
(* bustFreq is a list with elements -Infinity or some positive figure *)
(* xtrmRets is a list with elements {some figure, its frequency} *)
{bustFreq, xtrmRets} = combined // Transpose;
(* NumericQ[Infinity] -> False allows us to distinguish between normal occasions and busts *)
onBust = If[NumericQ[#1], #2, {Null, 0.}] &;
{
label = StringTemplate["Absolute frequency of busts in `1` samples"];
opts = {ChartLabels -> (Style[#, FontSize -> Large] & /@ {"normal", "bust"}),
PlotLabel -> label[repetitions], ImageSize -> Medium, ChartStyle -> 96};
Framed@PieChart[{#[True], #[False]},
Apply[Sequence][opts]] &@(Length /@ GroupBy[bustFreq, NumericQ]),
label = StringTemplate["Absolute frequency of max returns in `1` observations\n(in normal situations)"];
opts = {ChartLabels -> Range[repetitions], Frame -> True, ImageSize -> Medium,
PlotLabel -> label[observations], ChartStyle -> 24};
BarChart[#2, Apply[Sequence][opts]] & @@ Transpose[Map[Apply[onBust], combined]],
Iconize[combined, "data"]
}
]
Evaluating
simulation[randomSequence[UniformDistribution[], 15, 10^3],
10^4, 5 10^3, 10^3, 0.915] // Most /* (Riffle[#, Null] &) /* Row
returns

Length[finalBankrolls]
being 0. $\endgroup$