# Load packages
# Core
library(tidyverse)
library(tidyquant)
library(ggrepel)
library(scales)
Collect individual returns into a portfolio by assigning a weight to each stock
five stocks: “SPY”, “EFA”, “IJS”, “EEM”, “AGG”
from 2012-12-31 to 2017-12-31
symbols <- c("AAPL", "MSFT", "TSLA")
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) %>% # remove first row of each group
rename(returns = monthly.returns)
# Get unique stock symbols from asset_returns_tbl
symbols <- asset_returns_tbl %>%
distinct(symbol) %>%
pull()
# Assign custom weights
weights <- c(0.4,0.4,0.2)
# Create weights table
w_tbl <- tibble(symbol = symbols, weights = weights)
portfolio_returns_tbl <- asset_returns_tbl %>%
tq_portfolio(
assets_col = symbol,
returns_col = returns,
weights = w_tbl,
col_rename = "portfolio.returns",
rebalance_on = "months"
)
portfolio_returns_tbl %>%
ggplot(aes(x = date, y = portfolio.returns)) +
geom_point(color = "cornflowerblue") +
labs(title = "Portfolio Returns: Scatter Plot",
x = "Date", y = "Monthly Return")
portfolio_returns_tbl %>%
ggplot(aes(x = portfolio.returns)) +
geom_histogram(fill = "cornflowerblue", binwidth = 0.005) +
labs(title = "Portfolio Returns: Histogram",
x = "Monthly Return", y = "Frequency")
portfolio_returns_tbl %>%
ggplot(aes(x = portfolio.returns)) +
geom_histogram(aes(y = ..density..), fill = "cornflowerblue", binwidth = 0.01) +
geom_density(color = "darkblue", size = 1) +
labs(title = "Portfolio Returns: Histogram + Density",
x = "Monthly Return", y = "Density")
# Calculate standard deviation of portfolio returns
portfolio_sd_tbl <- portfolio_returns_tbl %>%
tq_performance(Ra = portfolio.returns, performance_fun = table.Stats) %>%
select(Stdev) %>%
mutate(tq_sd = round(Stdev * 100, 2))
# View result
portfolio_sd_tbl
## # A tibble: 1 × 2
## Stdev tq_sd
## <dbl> <dbl>
## 1 0.0531 5.31
# Calculate mean return (expected return)
mean_return <- portfolio_returns_tbl %>%
summarise(mean = mean(portfolio.returns)) %>%
pull(mean) * 100
# Create data for plotting
risk_return_tbl <- tibble(
return = mean_return,
risk = portfolio_sd_tbl$tq_sd
)
# Plot
risk_return_tbl %>%
ggplot(aes(x = risk, y = return)) +
geom_point(size = 5, color = "darkred") +
labs(title = "Expected Return vs. Risk",
x = "Risk (Standard Deviation %)",
y = "Expected Return (%)") +
xlim(0, NA) +
ylim(0, NA)
asset_risk_tbl <- asset_returns_tbl %>%
group_by(symbol) %>%
tq_performance(Ra = returns, performance_fun = table.Stats) %>%
ungroup() %>%
select(symbol, Mean = ArithmeticMean, Stdev) %>%
mutate(Mean = Mean * 100, Stdev = Stdev * 100)
# Portfolio mean and SD
portfolio_mean <- mean(portfolio_returns_tbl$portfolio.returns) * 100
portfolio_sd <- sd(portfolio_returns_tbl$portfolio.returns) * 100
# Combine
risk_return_tbl <- asset_risk_tbl %>%
add_row(symbol = "Portfolio", Mean = portfolio_mean, Stdev = portfolio_sd)
risk_return_tbl %>%
ggplot(aes(x = Stdev, y = Mean, color = symbol)) +
geom_point(size = 4) +
geom_text_repel(aes(label = symbol)) +
labs(title = "Expected Return vs Risk",
x = "Standard Deviation (%)",
y = "Mean Return (%)") +
theme_minimal()
rolling_sd_tbl <- portfolio_returns_tbl %>%
tq_mutate(
select = portfolio.returns,
mutate_fun = rollapply,
width = 24,
FUN = sd,
col_rename = "rolling_sd"
) %>%
na.omit() %>%
select(date, rolling_sd)
rolling_sd_tbl %>%
ggplot(aes(x = date, y = rolling_sd)) +
geom_line(color = "cornflowerblue") +
scale_y_continuous(labels = percent_format(accuracy = 1)) +
labs(title = "24-Month Rolling Volatility",
x = NULL,
y = NULL) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5))
In a typical month, I predict my portfolio to return between -6% and
13%.
Based on the histogram and density plot, the distribution shows slightly
right-skewed,
with most returns falling in the range of -3% to 7%.
The average monthly return is about 3.59%, and the standard deviation is
around 5.31%,
showing a medium level of risk.