>[!abstract]
>A modern version of the [[Wheat-and-chessboard problem|wheat-and-chessboard problem]] which asks the following question: would you rather receive $1 million today, or a penny that doubles consecutively every day for 30 days?
## Visualizing the penny-doubling riddle in R
The option of \$1 million upfront is intuitively appealing, especially as the money can be invested to generate interest right away. Generalizing, the money $M$ obtained on day $n$ from doubling pennies can be expressed as follows: $M = 0.01 \times 2^{n-1}$Let’s model this penny doubling and show the results in a table:
``` r
# Parameters
start_amount <- 0.01 # $0.01 on day 1
n_days <- 30 # Total period in days
# Core math
day <- 1:n_days
value <- start_amount * 2^(day - 1) # Amount received on each day
# Create data frame of results
df <- data.frame(day, value)
# Key reference points
million_line <- 1e6
breakeven_day <- which(value >= million_line)[1]
# How much more penny doubling is by day 30 relative to the $1M option
multiplier <- round(max(df$value)/million_line, 1)
# Show results
knitr::kable(df, format = "pipe")
```
| day | value |
|----:|-----------:|
| 1 | 0.01 |
| 2 | 0.02 |
| 3 | 0.04 |
| 4 | 0.08 |
| 5 | 0.16 |
| 6 | 0.32 |
| 7 | 0.64 |
| 8 | 1.28 |
| 9 | 2.56 |
| 10 | 5.12 |
| 11 | 10.24 |
| 12 | 20.48 |
| 13 | 40.96 |
| 14 | 81.92 |
| 15 | 163.84 |
| 16 | 327.68 |
| 17 | 655.36 |
| 18 | 1310.72 |
| 19 | 2621.44 |
| 20 | 5242.88 |
| 21 | 10485.76 |
| 22 | 20971.52 |
| 23 | 41943.04 |
| 24 | 83886.08 |
| 25 | 167772.16 |
| 26 | 335544.32 |
| 27 | 671088.64 |
| 28 | 1342177.28 |
| 29 | 2684354.56 |
| 30 | 5368709.12 |
Some observations:
- The penny doubling option has surpassed the million dollars reference point on day 28.
- It is 5.4 times more lucrative to opt for the penny doubling option.
- For the $1M option to be more advantageous, one would have to find an investment vehicle that returned more than 540% in a month (6480% APY).
Let’s now visualize this on a linear scale and a logarithmic scale.
``` r
# Set the theme for plots
dark_theme <- theme_minimal(base_size = 12) +
theme(
plot.background = element_rect(fill = "black", color = NA),
panel.background = element_rect(fill = "black", color = NA),
panel.grid.major = element_line(color = "grey30"),
panel.grid.minor = element_line(color = "grey20"),
axis.text = element_text(color = "white"),
axis.title = element_text(color = "white"),
plot.title = element_text(color = "white", face = "bold"),
plot.subtitle = element_text(color = "white"),
legend.text = element_text(color = "white"),
legend.title = element_text(color = "white"),
legend.background = element_rect(fill = "black", color = NA),
legend.key = element_rect(fill = "black", color = NA)
)
# Linear-scale plot
p_linear <- ggplot(df, aes(x = day, y = value)) +
geom_line(linewidth = 1, color = "white") +
geom_point(data = subset(df, day %in% c(1, 10, 20, 30)), size = 2, color = "white") +
geom_hline(yintercept = million_line, linewidth = 0.5, color = "white") +
annotate("text", x = 2, y = million_line, vjust = -0.7, label = "$1M reference", size = 3, color = "white") +
scale_y_continuous(labels = scales::dollar_format()) +
scale_x_continuous(breaks = seq(0, 30, 5)) +
labs(
title = "Penny doubling: Linear Scale",
x = "Day",
y = "Amount (USD)",
linetype = ""
) +
dark_theme
# Log-scale plot
p_log <- ggplot(df, aes(x = day, y = value)) +
geom_line(linewidth = 1, color = "white") +
geom_point(size = 1.5, color = "white") +
geom_hline(yintercept = million_line, linewidth = 0.5, color = "white") +
annotate("text", x = 2, y = million_line, vjust = -0.7, label = "$1M reference", size = 3) +
scale_y_log10(labels = scales::dollar_format()) +
scale_x_continuous(breaks = seq(0, 30, 5)) +
labs(
title = "Penny doubling: Log10 Scale",
x = "Day",
y = "Amount (USD)",
linetype = ""
) +
dark_theme
# Print linear scale plot
print(p_linear)
```
![[penny-doubling+riddle-1.png]]
The linear plot reveals how late into the month the penny doubling option surpasses the \$1M reference point. This illustrates the subtle nature of exponential growth, which starts deceptively slow until it hits an inflection point and then takes off.
``` r
# Print logarithmic scale plot
print(p_log)
```
![[penny-doubling+riddle-2.png]]
>[!related]
>- **North** (upstream): —
>- **West** (similar): [[Exponential growth bias]], [[Wheat-and-chessboard problem]]
>- **East** (different): —
>- **South** (downstream): —