Gamblers ruin
In this simulation a gambler starts with $1,000 (wealth
). She places a single bet each day of the year and has decided to invest 5% (perc_invest
) of the available money each time. The probability of winning is 20% (prob_win
) and if the gambler wins she gets 5 times (win_mult
) the amount she bet (i.e., the investment).
The challenge in this simulation is that the amount invested (bet) each day depends on whether the gambler won or lost her bet yesterday. To calculate the dynamic wealth, we need to write a custom function (calc_wealth
). We can call the calc_wealth
function from the Simulation formulas
input.
The first line in the function creates a vector of length 366 where the first value is the initial investment amount. The other elements of the vector are set to NA
(i.e., a missing value) because they are, as yet, unknown. We then loop through the win
vector to calculate the available wealth and investment amount for each day.
All required settings are shown in the screenshot below:
## win: a vector indicating if a bet was won or lost
## wealth: amount of mony the gambler starts starts
## mult: the winning multiplier
calc_wealth <- function(win, wealth, mult) {
wealth = c(wealth, rep(NA, length(win)))
for (i in 1:length(win)) {
wealth[i+1] = ifelse(
win[i],
wealth[i] + mult * perc_invest * wealth[i],
wealth[i] - perc_invest * wealth[i]
)
}
return(wealth[-1]) ## dropping the initial wealth value
}
simdat <- simulater(
const = c("wealth 1000", "perc_invest 0.05", "prob_win 0.2", "win_mult 5"),
unif = "rnd 0 1",
sequ = "time 1 365",
form = c(
"win = rnd < prob_win",
"dyn_wealth = calc_wealth(win, wealth, win_mult)",
"final = last(dyn_wealth)"
),
funcs = list(calc_wealth = calc_wealth),
seed = 1234,
nr = 365
)
summary(simdat, dec = 2)
Simulation
Simulations: 365
Random seed: 1234
Sim data : simdat
Uniform : rnd 0 1
Constant : wealth 1000; perc_invest 0.05; prob_win 0.2; win_mult 5
Sequence : time 1 365
Formulas :
win = rnd < prob_win
dyn_wealth = calc_wealth(win, wealth, win_mult)
final = last(dyn_wealth)
Constants:
wealth perc_invest prob_win win_mult final
1,000.00 0.05 0.20 5.00 715.49
Variables:
variable n_obs mean sd min p25 median p75 max
dyn_wealth 365 2,887.51 3,814.92 363.47 774.60 1,160.67 3,366.18 19,154.04
rnd 365 0.50 0.28 0.00 0.27 0.49 0.74 1.00
time 365 183.00 105.51 1.00 92.00 183.00 274.00 365.00
Logicals:
TRUE (nr) TRUE (prop)
win 67 0.18
The following plot shows the rise and fall of the gambler’s wealth over the course of the year.
visualize(
simdat,
xvar = "time",
yvar = "dyn_wealth",
type = "line",
custom = FALSE
)
Of course, the above similation only shows a possible result for one year. What would be the expected annual result if the gambler continous on for 50 years and starts each year with $1,000? We can use the Model > Simulate > Repeat tab to find the answer.
repdat <- repeater(
simdat,
nr = 50,
vars = "rnd",
sum_vars = "dyn_wealth",
byvar = ".rep",
fun = "last",
seed = 1234
)
summary(repdat, dec = 2)
Repeated simulation
Simulations : 365
Repetitions : 50
Re-simulated : rnd
Group by : Repeat
Function : last
Random seed : 1234
Simulated data: simdat
Repeat data : repdat
Variables:
variable n_obs mean sd min p25 median p75 max
dyn_wealth_last 50 13,176.62 29,672.13 26.57 586.70 2,821.87 8,458.30 131,567.01
plot(repdat, custom = FALSE)
The results shown above indicate that the gambler should expect just over $13K profit per year from this gambling strategy.
LS0tCnBhZ2V0aXRsZTogTm90ZWJvb2sgcmVwb3J0Cm91dHB1dDoKICBodG1sX25vdGVib29rOgogICAgaGlnaGxpZ2h0OiB6ZW5idXJuCiAgICB0aGVtZTogdW5pdGVkCiAgICB0b2M6IHllcwogICAgY29kZV9mb2xkaW5nOiBoaWRlCi0tLQoKYGBge3Igcl9zZXR1cCwgaW5jbHVkZSA9IEZBTFNFfQojIyBpbml0aWFsIHNldHRpbmdzCmtuaXRyOjpvcHRzX2NodW5rJHNldCgKICBjb21tZW50ID0gTkEsCiAgZWNobyA9IFRSVUUsCiAgZXJyb3IgPSBUUlVFLAogIGNhY2hlID0gRkFMU0UsCiAgbWVzc2FnZSA9IEZBTFNFLAoKICBkcGkgPSA5NiwKICB3YXJuaW5nID0gRkFMU0UKKQoKIyMgd2lkdGggdG8gdXNlIHdoZW4gcHJpbnRpbmcgdGFibGVzIGV0Yy4Kb3B0aW9ucygKICB3aWR0aCA9IDI1MCwKICBzY2lwZW4gPSAxMDAsCiAgbWF4LnByaW50ID0gNTAwMCwKICBzdHJpbmdzQXNGYWN0b3JzID0gRkFMU0UKKQoKIyMgbWFrZSBhbGwgcmVxdWlyZWQgbGlicmFyaWVzIGF2YWlsYWJsZSBieSBsb2FkaW5nIHJhZGlhbnQgcGFja2FnZSBpZiBuZWVkZWQKaWYgKGlzLm51bGwoc2hpbnk6OmdldERlZmF1bHRSZWFjdGl2ZURvbWFpbigpKSkgbGlicmFyeShyYWRpYW50KQoKIyMgaW5jbHVkZSBjb2RlIHRvIGxvYWQgdGhlIGRhdGEgeW91IHJlcXVpcmUKIyMgZm9yIGludGVyYWN0aXZlIHVzZSBhdHRhY2ggdGhlIHJfZGF0YSBlbnZpcm9ubWVudAojIGF0dGFjaChyX2RhdGEpCmBgYAoKPHN0eWxlPgoudGFibGUgewogIHdpZHRoOiBhdXRvOwp9CnVsLCBvbCB7CiAgcGFkZGluZy1sZWZ0OiAxOHB4Owp9CnByZSB7CiAgb3ZlcmZsb3c6IGF1dG87CiAgd2hpdGUtc3BhY2U6IHByZTsKICB3b3JkLXdyYXA6IG5vcm1hbDsKICBiYWNrZ3JvdW5kLWNvbG9yOiAjZmZmZmZmOwp9CmNvZGUsIHByZSBjb2RlIHsKICBvdmVyZmxvdzogYXV0bzsKICB3aGl0ZS1zcGFjZTogcHJlOwogIHdvcmQtd3JhcDogbm9ybWFsOwp9Cjwvc3R5bGU+CgojIyBHYW1ibGVycyBydWluCgpJbiB0aGlzIHNpbXVsYXRpb24gYSBnYW1ibGVyIHN0YXJ0cyB3aXRoIFwkMSwwMDAgKGB3ZWFsdGhgKS4gU2hlIHBsYWNlcyBhIHNpbmdsZSBiZXQgZWFjaCBkYXkgb2YgdGhlIHllYXIgYW5kIGhhcyBkZWNpZGVkIHRvIGludmVzdCA1JSAoYHBlcmNfaW52ZXN0YCkgb2YgdGhlIGF2YWlsYWJsZSBtb25leSBlYWNoIHRpbWUuIFRoZSBwcm9iYWJpbGl0eSBvZiB3aW5uaW5nIGlzIDIwJSAoYHByb2Jfd2luYCkgYW5kIGlmIHRoZSBnYW1ibGVyIHdpbnMgc2hlIGdldHMgNSB0aW1lcyAoYHdpbl9tdWx0YCkgdGhlIGFtb3VudCBzaGUgYmV0IChpLmUuLCB0aGUgaW52ZXN0bWVudCkuCgpUaGUgY2hhbGxlbmdlIGluIHRoaXMgc2ltdWxhdGlvbiBpcyB0aGF0IHRoZSBhbW91bnQgaW52ZXN0ZWQgKGJldCkgZWFjaCBkYXkgZGVwZW5kcyBvbiB3aGV0aGVyIHRoZSBnYW1ibGVyIHdvbiBvciBsb3N0IGhlciBiZXQgeWVzdGVyZGF5LiBUbyBjYWxjdWxhdGUgdGhlIGR5bmFtaWMgd2VhbHRoLCB3ZSBuZWVkIHRvIHdyaXRlIGEgY3VzdG9tIGZ1bmN0aW9uIChgY2FsY193ZWFsdGhgKS4gV2UgY2FuIF9jYWxsXyB0aGUgYGNhbGNfd2VhbHRoYCBmdW5jdGlvbiBmcm9tIHRoZSBgU2ltdWxhdGlvbiBmb3JtdWxhc2AgaW5wdXQuCgpUaGUgZmlyc3QgbGluZSBpbiB0aGUgZnVuY3Rpb24gY3JlYXRlcyBhIHZlY3RvciBvZiBsZW5ndGggMzY2IHdoZXJlIHRoZSBmaXJzdCB2YWx1ZSBpcyB0aGUgaW5pdGlhbCBpbnZlc3RtZW50IGFtb3VudC4gVGhlIG90aGVyIGVsZW1lbnRzIG9mIHRoZSB2ZWN0b3IgYXJlIHNldCB0byBgTkFgIChpLmUuLCBhIG1pc3NpbmcgdmFsdWUpIGJlY2F1c2UgdGhleSBhcmUsIGFzIHlldCwgdW5rbm93bi4gV2UgdGhlbiBfbG9vcF8gdGhyb3VnaCB0aGUgYHdpbmAgdmVjdG9yIHRvIGNhbGN1bGF0ZSB0aGUgYXZhaWxhYmxlIHdlYWx0aCBhbmQgaW52ZXN0bWVudCBhbW91bnQgZm9yIGVhY2ggZGF5LgoKQWxsIHJlcXVpcmVkIHNldHRpbmdzIGFyZSBzaG93biBpbiB0aGUgc2NyZWVuc2hvdCBiZWxvdzoKCiFbXShodHRwczovL3Jhdy5naXRodWJ1c2VyY29udGVudC5jb20vcmFkaWFudC1yc3RhdHMvZG9jcy9naC1wYWdlcy9leGFtcGxlcy9nYW1ibGVycy1ydWluLWlucHV0LnBuZykKCgpgYGB7cn0KIyMgd2luOiBhIHZlY3RvciBpbmRpY2F0aW5nIGlmIGEgYmV0IHdhcyB3b24gb3IgbG9zdAojIyB3ZWFsdGg6IGFtb3VudCBvZiBtb255IHRoZSBnYW1ibGVyIHN0YXJ0cyBzdGFydHMKIyMgbXVsdDogdGhlIHdpbm5pbmcgbXVsdGlwbGllcgpjYWxjX3dlYWx0aCA8LSBmdW5jdGlvbih3aW4sIHdlYWx0aCwgbXVsdCkgewogIHdlYWx0aCA9IGMod2VhbHRoLCByZXAoTkEsIGxlbmd0aCh3aW4pKSkKICBmb3IgKGkgaW4gMTpsZW5ndGgod2luKSkgewogICAgd2VhbHRoW2krMV0gPSBpZmVsc2UoCiAgICAgIHdpbltpXSwgCiAgICAgIHdlYWx0aFtpXSArIG11bHQgKiBwZXJjX2ludmVzdCAqIHdlYWx0aFtpXSwgCiAgICAgIHdlYWx0aFtpXSAtIHBlcmNfaW52ZXN0ICogd2VhbHRoW2ldCiAgICApCiAgfQogIHJldHVybih3ZWFsdGhbLTFdKSAgIyMgZHJvcHBpbmcgdGhlIGluaXRpYWwgd2VhbHRoIHZhbHVlCn0KCnNpbWRhdCA8LSBzaW11bGF0ZXIoCiAgY29uc3QgPSBjKCJ3ZWFsdGggMTAwMCIsICJwZXJjX2ludmVzdCAwLjA1IiwgInByb2Jfd2luIDAuMiIsICJ3aW5fbXVsdCA1IiksIAogIHVuaWYgPSAicm5kIDAgMSIsIAogIHNlcXUgPSAidGltZSAxIDM2NSIsIAogIGZvcm0gPSBjKAogICAgIndpbiA9IHJuZCA8IHByb2Jfd2luIiwgCiAgICAiZHluX3dlYWx0aCA9IGNhbGNfd2VhbHRoKHdpbiwgd2VhbHRoLCB3aW5fbXVsdCkiLCAKICAgICJmaW5hbCA9IGxhc3QoZHluX3dlYWx0aCkiCiAgKSwgCiAgZnVuY3MgPSBsaXN0KGNhbGNfd2VhbHRoID0gY2FsY193ZWFsdGgpLCAKICBzZWVkID0gMTIzNCwgCiAgbnIgPSAzNjUKKQpzdW1tYXJ5KHNpbWRhdCwgZGVjID0gMikKcmVnaXN0ZXIoInNpbWRhdCIpCmBgYAoKVGhlIGZvbGxvd2luZyBwbG90IHNob3dzIHRoZSByaXNlIGFuZCBmYWxsIG9mIHRoZSBnYW1ibGVyJ3Mgd2VhbHRoIG92ZXIgdGhlIGNvdXJzZSBvZiB0aGUgeWVhci4KCmBgYHtyIGZpZy53aWR0aCA9IDcsIGZpZy5oZWlnaHQgPSA3LCBkcGkgPSAxNDR9CnZpc3VhbGl6ZSgKICBzaW1kYXQsIAogIHh2YXIgPSAidGltZSIsIAogIHl2YXIgPSAiZHluX3dlYWx0aCIsIAogIHR5cGUgPSAibGluZSIsIAogIGN1c3RvbSA9IEZBTFNFCikKYGBgCgpPZiBjb3Vyc2UsIHRoZSBhYm92ZSBzaW1pbGF0aW9uIG9ubHkgc2hvd3MgYSBwb3NzaWJsZSByZXN1bHQgZm9yIG9uZSB5ZWFyLiBXaGF0IHdvdWxkIGJlIHRoZSBleHBlY3RlZCBhbm51YWwgcmVzdWx0IGlmIHRoZSBnYW1ibGVyIGNvbnRpbm91cyBvbiBmb3IgNTAgeWVhcnMgYW5kIHN0YXJ0cyBlYWNoIHllYXIgd2l0aCAkMSwwMDA/IFdlIGNhbiB1c2UgdGhlIF9Nb2RlbCA+IFNpbXVsYXRlID4gUmVwZWF0XyB0YWIgdG8gZmluZCB0aGUgYW5zd2VyLgoKYGBge3IgZmlnLndpZHRoID0gNywgZmlnLmhlaWdodCA9IDMuMjMsIGRwaSA9IDE0NH0KcmVwZGF0IDwtIHJlcGVhdGVyKAogIHNpbWRhdCwgCiAgbnIgPSA1MCwgCiAgdmFycyA9ICJybmQiLCAKICBzdW1fdmFycyA9ICJkeW5fd2VhbHRoIiwgCiAgYnl2YXIgPSAiLnJlcCIsIAogIGZ1biA9ICJsYXN0IiwgCiAgc2VlZCA9IDEyMzQKKQpzdW1tYXJ5KHJlcGRhdCwgZGVjID0gMikKcGxvdChyZXBkYXQsIGN1c3RvbSA9IEZBTFNFKQpyZWdpc3RlcigicmVwZGF0IikKYGBgCgpUaGUgcmVzdWx0cyBzaG93biBhYm92ZSBpbmRpY2F0ZSB0aGF0IHRoZSBnYW1ibGVyIHNob3VsZCBleHBlY3QganVzdCBvdmVyIFwkMTNLIHByb2ZpdCBwZXIgeWVhciBmcm9tIHRoaXMgZ2FtYmxpbmcgc3RyYXRlZ3kuCgoK