# Load packages
# Core
library(tidyverse)
library(tidyquant)
# Source function
source("../00_scripts/simulate_accumulation.R")
Revise the code below.
symbols <- c("MCD", "WEN", "YUM", "DPZ", "SBUX")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = "2017-12-31")
asset_returns_tbl <- prices %>%
group_by(symbol) %>%
tq_transmute(select = adjusted,
mutate_fun = periodReturn,
period = "monthly",
type = "log") %>%
slice(-1) %>%
ungroup() %>%
set_names(c("asset", "date", "returns"))
Revise the code for weights.
# symbols
symbols <- asset_returns_tbl %>% distinct(asset) %>% pull()
symbols
## [1] "DPZ" "MCD" "SBUX" "WEN" "YUM"
# weights
weights <- c(0.2, 0.2, 0.2, 0.2, 0.2)
weights
## [1] 0.2 0.2 0.2 0.2 0.2
w_tbl <- tibble(symbols, weights)
w_tbl
## # A tibble: 5 × 2
## symbols weights
## <chr> <dbl>
## 1 DPZ 0.2
## 2 MCD 0.2
## 3 SBUX 0.2
## 4 WEN 0.2
## 5 YUM 0.2
portfolio_returns_tbl <- asset_returns_tbl %>%
tq_portfolio(assets_col = asset,
returns_col = returns,
weights = w_tbl,
rebalance_on = "months",
col_rename = "returns")
portfolio_returns_tbl
## # A tibble: 60 × 2
## date returns
## <date> <dbl>
## 1 2013-01-31 0.0524
## 2 2013-02-28 0.0273
## 3 2013-03-28 0.0496
## 4 2013-04-30 0.0226
## 5 2013-05-31 0.0218
## 6 2013-06-28 0.00976
## 7 2013-07-31 0.0804
## 8 2013-08-30 -0.00594
## 9 2013-09-30 0.0690
## 10 2013-10-31 0.00341
## # … with 50 more rows
# Get mean portfolio return
mean_port_return <- mean(portfolio_returns_tbl$returns)
mean_port_return
## [1] 0.01729703
# Get standard deviation of portfolio returns
stddev_port_return <- sd(portfolio_returns_tbl$returns)
stddev_port_return
## [1] 0.03310936
# Construct a normal distribution
simulated_monthly_returns <- rnorm(120, mean_port_return, stddev_port_return)
simulated_monthly_returns
## [1] -0.002054919 0.003503206 0.035080682 -0.009339060 -0.021068770
## [6] 0.069289584 -0.009836409 0.077285506 0.019569396 -0.028633994
## [11] -0.002816699 0.100621746 0.017445893 -0.012784095 0.055151736
## [16] -0.011127272 0.035067284 0.052345659 0.070728656 0.027154194
## [21] 0.017178623 0.016610608 0.033521007 0.034731957 0.057903993
## [26] 0.068069886 0.012432264 0.048736684 0.037405462 0.014637838
## [31] 0.044795538 0.007383843 0.034595881 0.020395126 0.008248870
## [36] 0.007075510 -0.029546628 0.056911134 -0.015296087 0.032603012
## [41] -0.022144436 0.017495920 -0.017607662 0.006491410 0.007004654
## [46] -0.012094298 0.018298107 0.004319749 0.050139592 0.016891437
## [51] 0.011129820 0.054918026 -0.027863807 0.004684482 0.023106184
## [56] 0.081234597 -0.056342306 0.051790063 0.046520610 0.046124239
## [61] 0.021050691 0.014065725 0.018573828 0.023378967 0.045876265
## [66] -0.024682609 0.003362796 0.025922045 0.012566752 -0.023439132
## [71] 0.071335631 -0.012998867 0.032375095 -0.033555212 0.013433053
## [76] 0.086033965 0.064655212 0.027588663 0.036893374 0.086103658
## [81] 0.060968026 0.026113086 0.086307149 0.061887220 0.028019470
## [86] 0.055842586 -0.017977131 -0.015167445 -0.056407558 0.022185547
## [91] 0.010850677 -0.001849208 0.049304819 0.092015354 0.021882839
## [96] 0.050912282 0.020579944 0.042959565 0.032030109 -0.011989191
## [101] 0.096456754 -0.048551140 -0.006108746 0.004420298 -0.001786697
## [106] -0.003239754 0.032459480 0.031622534 0.051604778 0.002923855
## [111] 0.068190437 0.026794685 0.098544966 0.028212769 0.064062753
## [116] 0.114107319 0.013149084 0.110912248 -0.029489782 0.046236840
# Add a dollar
simulated_returns_add_1 <- tibble(returns = c(1, 1 + simulated_monthly_returns))
simulated_returns_add_1
## # A tibble: 121 × 1
## returns
## <dbl>
## 1 1
## 2 0.998
## 3 1.00
## 4 1.04
## 5 0.991
## 6 0.979
## 7 1.07
## 8 0.990
## 9 1.08
## 10 1.02
## # … with 111 more rows
# Calculate the cumulative growth of a dollar
simulated_growth <- simulated_returns_add_1 %>%
mutate(growth = accumulate(returns, function(x, y) x*y)) %>%
select(growth)
simulated_growth
## # A tibble: 121 × 1
## growth
## <dbl>
## 1 1
## 2 0.998
## 3 1.00
## 4 1.04
## 5 1.03
## 6 1.01
## 7 1.07
## 8 1.06
## 9 1.15
## 10 1.17
## # … with 111 more rows
# Check the compound annual growth rate
cagr <- ((simulated_growth$growth[nrow(simulated_growth)]^(1/10)) - 1) * 100
cagr
## [1] 33.85928
simulate_accumulation <- function(initial_value, N, mean_return, sd_return ) {
# Add a dollar
simulated_returns_add_1 <- tibble(returns = c(initial_value, 1 + rnorm(N, mean_return, sd_return)))
# Calculate the cumulative growth of a dollar
simulated_growth <- simulated_returns_add_1 %>%
mutate(growth = accumulate(returns, function(x, y) x*y)) %>%
select(growth)
return(simulated_growth)
}
simulate_accumulation(initial_value = 100, N = 240, mean_return = 0.005, sd_return = 0.01) %>%
tail()
## # A tibble: 6 × 1
## growth
## <dbl>
## 1 343.
## 2 348.
## 3 349.
## 4 355.
## 5 354.
## 6 357.
# Create a vector of 1s as a starting point
sims <- 51
starts <- rep(100, sims) %>%
set_names(paste0("sim", 1:sims))
starts
## sim1 sim2 sim3 sim4 sim5 sim6 sim7 sim8 sim9 sim10 sim11 sim12 sim13
## 100 100 100 100 100 100 100 100 100 100 100 100 100
## sim14 sim15 sim16 sim17 sim18 sim19 sim20 sim21 sim22 sim23 sim24 sim25 sim26
## 100 100 100 100 100 100 100 100 100 100 100 100 100
## sim27 sim28 sim29 sim30 sim31 sim32 sim33 sim34 sim35 sim36 sim37 sim38 sim39
## 100 100 100 100 100 100 100 100 100 100 100 100 100
## sim40 sim41 sim42 sim43 sim44 sim45 sim46 sim47 sim48 sim49 sim50 sim51
## 100 100 100 100 100 100 100 100 100 100 100 100
# Simulate
# for reproducible research
set.seed(1234)
monte_carlo_sim_51 <- starts %>%
# Simulate
map_dfc(.x = .,
.f = ~simulate_accumulation(initial_value = .x,
N = 240,
mean_return = mean_port_return,
sd_return = stddev_port_return)) %>%
# Add column month
mutate(month = 1:nrow(.)) %>%
select(month, everything()) %>%
# Rearrange column names
set_names(c("month", names(starts))) %>%
# Transform to long form
pivot_longer(cols = -month, names_to = "sim", values_to = "growth")
monte_carlo_sim_51
## # A tibble: 12,291 × 3
## month sim growth
## <int> <chr> <dbl>
## 1 1 sim1 100
## 2 1 sim2 100
## 3 1 sim3 100
## 4 1 sim4 100
## 5 1 sim5 100
## 6 1 sim6 100
## 7 1 sim7 100
## 8 1 sim8 100
## 9 1 sim9 100
## 10 1 sim10 100
## # … with 12,281 more rows
# Find quantiles
monte_carlo_sim_51 %>%
group_by(sim) %>%
summarise(growth = last(growth)) %>%
ungroup() %>%
pull(growth) %>%
quantile(probs = c(0, 0.25, 0.5, 0.75,1)) %>%
round(2)
## 0% 25% 50% 75% 100%
## 1880.92 4408.93 6122.76 8456.31 13406.73
monte_carlo_sim_51 %>%
ggplot(aes(x = month, y = growth, color = sim)) +
geom_line() +
theme(legend.position = "none") +
theme(plot.title = element_text(hjust = 0.5)) +
labs(title = "Simulating growth of $100 over 240 months")
Line plot with max, median, and min
# Step 1 Summarize data into maximum, median, and minimum of last value
sim_summary <- monte_carlo_sim_51 %>%
group_by(sim) %>%
summarise(growth = last(growth)) %>%
ungroup() %>%
summarise(max = max(growth),
median = median(growth),
min = min(growth))
sim_summary
## # A tibble: 1 × 3
## max median min
## <dbl> <dbl> <dbl>
## 1 13407. 6123. 1881.
# Step 2 Plot
monte_carlo_sim_51 %>%
# Filter for max, median, and min sim
group_by(sim) %>%
filter(last(growth) == sim_summary$max |
last(growth) ==sim_summary$median |
last(growth) ==sim_summary$min) %>%
ungroup() %>%
# Plot
ggplot(aes(x = month, y = growth, color = sim)) +
geom_line() +
theme(legend.position = "none") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(plot.subtitle = element_text(hjust = 0.5)) +
labs(title = "Simulating growth of $100 over 240 months",
subtitle = "Maximum, Median, and Minimum Simulation")
Based on the Monte Carlo simulation results, how much should you expect from your $100 investment after 20 years? What is the best-case scenario? What is the worst-case scenario? What are limitations of this simulation analysis?
Based on the simulation, a return of about $6,122.76 can be expected on average. The best case scenario would be a 100% return of $13,406.74 while the worst case scenario would be a return of $1,880. The limitations of this analysis are that future estimates are based on past historical values. This does not take into account unforseeable events and risks that could impact prices. Another limitation is that the model is based off of the assumption of a normal distribution of returns. In reality, the data could be skewed and there could be a higher propensity for returns on either the low or high end of the data set.