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
register("simdat")

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)

register("repdat")

The results shown above indicate that the gambler should expect just over $13K profit per year from this gambling strategy.

LS0tCnBhZ2V0aXRsZTogTm90ZWJvb2sgcmVwb3J0Cm91dHB1dDoKICBodG1sX25vdGVib29rOgogICAgaGlnaGxpZ2h0OiB6ZW5idXJuCiAgICB0aGVtZTogdW5pdGVkCiAgICB0b2M6IHllcwogICAgY29kZV9mb2xkaW5nOiBoaWRlCi0tLQoKYGBge3Igcl9zZXR1cCwgaW5jbHVkZSA9IEZBTFNFfQojIyBpbml0aWFsIHNldHRpbmdzCmtuaXRyOjpvcHRzX2NodW5rJHNldCgKICBjb21tZW50ID0gTkEsCiAgZWNobyA9IFRSVUUsCiAgZXJyb3IgPSBUUlVFLAogIGNhY2hlID0gRkFMU0UsCiAgbWVzc2FnZSA9IEZBTFNFLAoKICBkcGkgPSA5NiwKICB3YXJuaW5nID0gRkFMU0UKKQoKIyMgd2lkdGggdG8gdXNlIHdoZW4gcHJpbnRpbmcgdGFibGVzIGV0Yy4Kb3B0aW9ucygKICB3aWR0aCA9IDI1MCwKICBzY2lwZW4gPSAxMDAsCiAgbWF4LnByaW50ID0gNTAwMCwKICBzdHJpbmdzQXNGYWN0b3JzID0gRkFMU0UKKQoKIyMgbWFrZSBhbGwgcmVxdWlyZWQgbGlicmFyaWVzIGF2YWlsYWJsZSBieSBsb2FkaW5nIHJhZGlhbnQgcGFja2FnZSBpZiBuZWVkZWQKaWYgKGlzLm51bGwoc2hpbnk6OmdldERlZmF1bHRSZWFjdGl2ZURvbWFpbigpKSkgbGlicmFyeShyYWRpYW50KQoKIyMgaW5jbHVkZSBjb2RlIHRvIGxvYWQgdGhlIGRhdGEgeW91IHJlcXVpcmUKIyMgZm9yIGludGVyYWN0aXZlIHVzZSBhdHRhY2ggdGhlIHJfZGF0YSBlbnZpcm9ubWVudAojIGF0dGFjaChyX2RhdGEpCmBgYAoKPHN0eWxlPgoudGFibGUgewogIHdpZHRoOiBhdXRvOwp9CnVsLCBvbCB7CiAgcGFkZGluZy1sZWZ0OiAxOHB4Owp9CnByZSB7CiAgb3ZlcmZsb3c6IGF1dG87CiAgd2hpdGUtc3BhY2U6IHByZTsKICB3b3JkLXdyYXA6IG5vcm1hbDsKICBiYWNrZ3JvdW5kLWNvbG9yOiAjZmZmZmZmOwp9CmNvZGUsIHByZSBjb2RlIHsKICBvdmVyZmxvdzogYXV0bzsKICB3aGl0ZS1zcGFjZTogcHJlOwogIHdvcmQtd3JhcDogbm9ybWFsOwp9Cjwvc3R5bGU+CgojIyBHYW1ibGVycyBydWluCgpJbiB0aGlzIHNpbXVsYXRpb24gYSBnYW1ibGVyIHN0YXJ0cyB3aXRoIFwkMSwwMDAgKGB3ZWFsdGhgKS4gU2hlIHBsYWNlcyBhIHNpbmdsZSBiZXQgZWFjaCBkYXkgb2YgdGhlIHllYXIgYW5kIGhhcyBkZWNpZGVkIHRvIGludmVzdCA1JSAoYHBlcmNfaW52ZXN0YCkgb2YgdGhlIGF2YWlsYWJsZSBtb25leSBlYWNoIHRpbWUuIFRoZSBwcm9iYWJpbGl0eSBvZiB3aW5uaW5nIGlzIDIwJSAoYHByb2Jfd2luYCkgYW5kIGlmIHRoZSBnYW1ibGVyIHdpbnMgc2hlIGdldHMgNSB0aW1lcyAoYHdpbl9tdWx0YCkgdGhlIGFtb3VudCBzaGUgYmV0IChpLmUuLCB0aGUgaW52ZXN0bWVudCkuCgpUaGUgY2hhbGxlbmdlIGluIHRoaXMgc2ltdWxhdGlvbiBpcyB0aGF0IHRoZSBhbW91bnQgaW52ZXN0ZWQgKGJldCkgZWFjaCBkYXkgZGVwZW5kcyBvbiB3aGV0aGVyIHRoZSBnYW1ibGVyIHdvbiBvciBsb3N0IGhlciBiZXQgeWVzdGVyZGF5LiBUbyBjYWxjdWxhdGUgdGhlIGR5bmFtaWMgd2VhbHRoLCB3ZSBuZWVkIHRvIHdyaXRlIGEgY3VzdG9tIGZ1bmN0aW9uIChgY2FsY193ZWFsdGhgKS4gV2UgY2FuIF9jYWxsXyB0aGUgYGNhbGNfd2VhbHRoYCBmdW5jdGlvbiBmcm9tIHRoZSBgU2ltdWxhdGlvbiBmb3JtdWxhc2AgaW5wdXQuCgpUaGUgZmlyc3QgbGluZSBpbiB0aGUgZnVuY3Rpb24gY3JlYXRlcyBhIHZlY3RvciBvZiBsZW5ndGggMzY2IHdoZXJlIHRoZSBmaXJzdCB2YWx1ZSBpcyB0aGUgaW5pdGlhbCBpbnZlc3RtZW50IGFtb3VudC4gVGhlIG90aGVyIGVsZW1lbnRzIG9mIHRoZSB2ZWN0b3IgYXJlIHNldCB0byBgTkFgIChpLmUuLCBhIG1pc3NpbmcgdmFsdWUpIGJlY2F1c2UgdGhleSBhcmUsIGFzIHlldCwgdW5rbm93bi4gV2UgdGhlbiBfbG9vcF8gdGhyb3VnaCB0aGUgYHdpbmAgdmVjdG9yIHRvIGNhbGN1bGF0ZSB0aGUgYXZhaWxhYmxlIHdlYWx0aCBhbmQgaW52ZXN0bWVudCBhbW91bnQgZm9yIGVhY2ggZGF5LgoKQWxsIHJlcXVpcmVkIHNldHRpbmdzIGFyZSBzaG93biBpbiB0aGUgc2NyZWVuc2hvdCBiZWxvdzoKCiFbXShodHRwczovL3Jhdy5naXRodWJ1c2VyY29udGVudC5jb20vcmFkaWFudC1yc3RhdHMvZG9jcy9naC1wYWdlcy9leGFtcGxlcy9nYW1ibGVycy1ydWluLWlucHV0LnBuZykKCgpgYGB7cn0KIyMgd2luOiBhIHZlY3RvciBpbmRpY2F0aW5nIGlmIGEgYmV0IHdhcyB3b24gb3IgbG9zdAojIyB3ZWFsdGg6IGFtb3VudCBvZiBtb255IHRoZSBnYW1ibGVyIHN0YXJ0cyBzdGFydHMKIyMgbXVsdDogdGhlIHdpbm5pbmcgbXVsdGlwbGllcgpjYWxjX3dlYWx0aCA8LSBmdW5jdGlvbih3aW4sIHdlYWx0aCwgbXVsdCkgewogIHdlYWx0aCA9IGMod2VhbHRoLCByZXAoTkEsIGxlbmd0aCh3aW4pKSkKICBmb3IgKGkgaW4gMTpsZW5ndGgod2luKSkgewogICAgd2VhbHRoW2krMV0gPSBpZmVsc2UoCiAgICAgIHdpbltpXSwgCiAgICAgIHdlYWx0aFtpXSArIG11bHQgKiBwZXJjX2ludmVzdCAqIHdlYWx0aFtpXSwgCiAgICAgIHdlYWx0aFtpXSAtIHBlcmNfaW52ZXN0ICogd2VhbHRoW2ldCiAgICApCiAgfQogIHJldHVybih3ZWFsdGhbLTFdKSAgIyMgZHJvcHBpbmcgdGhlIGluaXRpYWwgd2VhbHRoIHZhbHVlCn0KCnNpbWRhdCA8LSBzaW11bGF0ZXIoCiAgY29uc3QgPSBjKCJ3ZWFsdGggMTAwMCIsICJwZXJjX2ludmVzdCAwLjA1IiwgInByb2Jfd2luIDAuMiIsICJ3aW5fbXVsdCA1IiksIAogIHVuaWYgPSAicm5kIDAgMSIsIAogIHNlcXUgPSAidGltZSAxIDM2NSIsIAogIGZvcm0gPSBjKAogICAgIndpbiA9IHJuZCA8IHByb2Jfd2luIiwgCiAgICAiZHluX3dlYWx0aCA9IGNhbGNfd2VhbHRoKHdpbiwgd2VhbHRoLCB3aW5fbXVsdCkiLCAKICAgICJmaW5hbCA9IGxhc3QoZHluX3dlYWx0aCkiCiAgKSwgCiAgZnVuY3MgPSBsaXN0KGNhbGNfd2VhbHRoID0gY2FsY193ZWFsdGgpLCAKICBzZWVkID0gMTIzNCwgCiAgbnIgPSAzNjUKKQpzdW1tYXJ5KHNpbWRhdCwgZGVjID0gMikKcmVnaXN0ZXIoInNpbWRhdCIpCmBgYAoKVGhlIGZvbGxvd2luZyBwbG90IHNob3dzIHRoZSByaXNlIGFuZCBmYWxsIG9mIHRoZSBnYW1ibGVyJ3Mgd2VhbHRoIG92ZXIgdGhlIGNvdXJzZSBvZiB0aGUgeWVhci4KCmBgYHtyIGZpZy53aWR0aCA9IDcsIGZpZy5oZWlnaHQgPSA3LCBkcGkgPSAxNDR9CnZpc3VhbGl6ZSgKICBzaW1kYXQsIAogIHh2YXIgPSAidGltZSIsIAogIHl2YXIgPSAiZHluX3dlYWx0aCIsIAogIHR5cGUgPSAibGluZSIsIAogIGN1c3RvbSA9IEZBTFNFCikKYGBgCgpPZiBjb3Vyc2UsIHRoZSBhYm92ZSBzaW1pbGF0aW9uIG9ubHkgc2hvd3MgYSBwb3NzaWJsZSByZXN1bHQgZm9yIG9uZSB5ZWFyLiBXaGF0IHdvdWxkIGJlIHRoZSBleHBlY3RlZCBhbm51YWwgcmVzdWx0IGlmIHRoZSBnYW1ibGVyIGNvbnRpbm91cyBvbiBmb3IgNTAgeWVhcnMgYW5kIHN0YXJ0cyBlYWNoIHllYXIgd2l0aCAkMSwwMDA/IFdlIGNhbiB1c2UgdGhlIF9Nb2RlbCA+IFNpbXVsYXRlID4gUmVwZWF0XyB0YWIgdG8gZmluZCB0aGUgYW5zd2VyLgoKYGBge3IgZmlnLndpZHRoID0gNywgZmlnLmhlaWdodCA9IDMuMjMsIGRwaSA9IDE0NH0KcmVwZGF0IDwtIHJlcGVhdGVyKAogIHNpbWRhdCwgCiAgbnIgPSA1MCwgCiAgdmFycyA9ICJybmQiLCAKICBzdW1fdmFycyA9ICJkeW5fd2VhbHRoIiwgCiAgYnl2YXIgPSAiLnJlcCIsIAogIGZ1biA9ICJsYXN0IiwgCiAgc2VlZCA9IDEyMzQKKQpzdW1tYXJ5KHJlcGRhdCwgZGVjID0gMikKcGxvdChyZXBkYXQsIGN1c3RvbSA9IEZBTFNFKQpyZWdpc3RlcigicmVwZGF0IikKYGBgCgpUaGUgcmVzdWx0cyBzaG93biBhYm92ZSBpbmRpY2F0ZSB0aGF0IHRoZSBnYW1ibGVyIHNob3VsZCBleHBlY3QganVzdCBvdmVyIFwkMTNLIHByb2ZpdCBwZXIgeWVhciBmcm9tIHRoaXMgZ2FtYmxpbmcgc3RyYXRlZ3kuCgoK