set.seed(1)
n <- 20 # Total bets
K <- 100 # Number of possible returns
PERIODS <- 100
TRIALS <- 5
## Generate return probabilities
ps <- runif(K)
ps <- ps/sum(ps)
## Generate matrix of possible returns
rets <- runif(K*(n-1), 0.5, 1.5)
shuff <- sample(1:length(rets), size = length(rets), replace = FALSE)
rets[shuff[1:30]] <- 0 # Set 30 returns to be relatively low
rets[shuff[31:60]] <- 5 # Set 30 returns to be relatively high
rets <- matrix(rets, nrow = K, ncol = n-1)
rets <- cbind(rets, rep(1, K)) # Last column represents not betting
## Solve for Kelly optimal bets
b <- Variable(n)
obj <- Maximize(t(ps) %*% log(rets %*% b))
constraints <- list(sum(b) == 1, b >= 0)
prob <- Problem(obj, constraints)
result <- psolve(prob)
check_solver_status(prob)
bets <- value(b)
## Naive betting scheme: bet in proportion to expected return
bets_cmp <- matrix(0, nrow = n)
bets_cmp[n] <- 0.15 # Hold 15% of wealth
rets_avg <- ps %*% rets
## tidx <- order(rets_avg[-n], decreasing = TRUE)[1:9]
tidx <- 1:(n-1)
fracs <- rets_avg[tidx]/sum(rets_avg[tidx])
bets_cmp[tidx] <- fracs*(1-bets_cmp[n])
## Calculate wealth over time
wealth <- matrix(0, nrow = PERIODS, ncol = TRIALS)
wealth_cmp <- matrix(0, nrow = PERIODS, ncol = TRIALS)
for(i in seq_len(TRIALS)) {
sidx <- sample(K, size = PERIODS, replace = TRUE, prob = ps)
winnings <- rets[sidx,] %*% bets
wealth[,i] <- cumprod(winnings)
winnings_cmp <- rets[sidx,] %*% bets_cmp
wealth_cmp[,i] <- cumprod(winnings_cmp)
}Kelly Gambling
Introduction
In Kelly gambling (Kelly 1956), we are given the opportunity to bet on
Example
We solve the Kelly gambling problem for rets is the ps is the vector of return probabilities
Growth curves for five independent trials are plotted in the figures below. Red lines represent the wealth each period from the Kelly bets, while cyan lines are the result of the naive bets. Clearly, Kelly optimal bets perform better, producing greater net wealth by the final period.
df <- data.frame(seq_len(PERIODS), wealth)
names(df) <- c("x", paste0("kelly", seq_len(TRIALS)))
plot.data1 <- gather(df, key = "trial", value = "wealth",
paste0("kelly", seq_len(TRIALS)),
factor_key = TRUE)
plot.data1$Strategy <- "Kelly Optimal Bets"
df <- data.frame(seq_len(PERIODS), wealth_cmp)
names(df) <- c("x", paste0("naive", seq_len(TRIALS)))
plot.data2 <- gather(df, key = "trial", value = "wealth",
paste0("naive", seq_len(TRIALS)),
factor_key = TRUE)
plot.data2$Strategy <- "Naive Bets"
plot.data <- rbind(plot.data1, plot.data2)
ggplot(data = plot.data) +
geom_line(mapping = aes(x = x, y = wealth, group = trial, color = Strategy)) +
scale_y_log10() +
labs(x = "Time", y = "Wealth") +
theme(legend.position = "top")
Extensions
As observed in some trajectories above, wealth tends to drop by a significant amount before increasing eventually. One way to reduce this drawdown risk is to add a convex constraint as described in Busseti, Ryu, and Boyd (2016, 5.3)
where CVXR, this can be accomplished in a single line using the log_sum_exp atom. Other extensions like wealth goals, betting restrictions, and VaR/CVaR bounds are also readily incorporated.
Session Info
R version 4.5.2 (2025-10-31)
Platform: aarch64-apple-darwin20
Running under: macOS Tahoe 26.3
Matrix products: default
BLAS: /Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/lib/libRblas.0.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/lib/libRlapack.dylib; LAPACK version 3.12.1
locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
time zone: America/Los_Angeles
tzcode source: internal
attached base packages:
[1] stats graphics grDevices datasets utils methods base
other attached packages:
[1] tidyr_1.3.2 ggplot2_4.0.2 CVXR_1.8.0.9207
loaded via a namespace (and not attached):
[1] gmp_0.7-5.1 generics_0.1.4 clarabel_0.11.2 slam_0.1-55
[5] lattice_0.22-9 digest_0.6.39 magrittr_2.0.4 evaluate_1.0.5
[9] grid_4.5.2 RColorBrewer_1.1-3 fastmap_1.2.0 rprojroot_2.1.1
[13] jsonlite_2.0.0 Matrix_1.7-4 ECOSolveR_0.6.1 backports_1.5.0
[17] scs_3.2.7 purrr_1.2.1 Rmosek_11.1.1 scales_1.4.0
[21] codetools_0.2-20 cli_3.6.5 rlang_1.1.7 Rglpk_0.6-5.1
[25] withr_3.0.2 yaml_2.3.12 otel_0.2.0 tools_4.5.2
[29] osqp_1.0.0 Rcplex_0.3-8 checkmate_2.3.4 dplyr_1.2.0
[33] here_1.0.2 gurobi_13.0-1 vctrs_0.7.1 R6_2.6.1
[37] lifecycle_1.0.5 htmlwidgets_1.6.4 cccp_0.3-3 pkgconfig_2.0.3
[41] pillar_1.11.1 gtable_0.3.6 glue_1.8.0 Rcpp_1.1.1
[45] xfun_0.56 tibble_3.3.1 tidyselect_1.2.1 knitr_1.51
[49] dichromat_2.0-0.1 highs_1.12.0-3 farver_2.1.2 htmltools_0.5.9
[53] labeling_0.4.3 rmarkdown_2.30 piqp_0.6.2 compiler_4.5.2
[57] S7_0.2.1