Crypto Portfolio Optimization

Download & load the relevant packages

library(tidyverse) #to download the data
library(tidyquant) #to download the data
library(plotly) #to create interactive charts
library(timetk) #to manipulate the data series
library(forcats) #to manipulate categorical variables

Choose crypto coins & tokens

I will choose 10 personal preferences:

1. Bitcoin
2. Ethereum
3. USD Coin
4. Solana
5. Polkadot
6. Avalanche
7. Polygon
8. Chainlink
9. Algorand
10. Monero

Download the price data

We will capture the time range from 03 JANUARY 2009 to 01 JULY 2022, for Bitcoin, Ethereum, USD Coin, Solana, Polkadot, Avalanche, Polygon, Chainlink, Algorand, and Monero. The tq_get() function draws the crypto coins & token USD valuations from Yahoo Finance.

tick <- c('BTC-USD', 'ETH-USD', 'USDC-USD', 'SOL-USD', 'DOT-USD', 
          'AVAX-USD', 'MATIC-USD', 'LINK-USD', 'ALGO-USD', 'XMR-USD')

price_data <- tq_get(tick,
                     from = '2009-01-03',
                     to = '2022-07-01',
                     get = 'stock.prices')

knitr::kable(head(price_data))

Calculate the daily returns for these stocks, using the logarithmic (continuous) returns

log_ret_tidy <- price_data %>%
  group_by(symbol) %>%
  tq_transmute(select = adjusted,
               mutate_fun = periodReturn,
               period = 'daily',
               col_rename = 'ret',
               type = 'log')

Survey the first few rows

knitr::kable(head(log_ret_tidy))

Use the spread() function to convert the tidy format to a wide format, and convert it into a time series object using the xts() function

log_ret_xts <- log_ret_tidy %>%
  spread(symbol, value = ret) %>%
  tk_xts()

knitr::kable(head(log_ret_xts))

Replace “NA” values with “0”

There are NA (or alternatively null) values present due to the lack of value captured at those time-date groups (i.e. the coin or token was not in existence at the time)

log_ret_xts[is.na(log_ret_xts)] <- 0
knitr::kable(head(log_ret_xts))

To calculate portfolio returns, risk (standard deviation), and the Sharpe Ratio, the required factors are:

• Mean asset (daily) returns
• Covariance matrix of all assets
• Random weights
  
  

Calculate the mean daily returns for each asset

mean_ret <- colMeans(log_ret_xts)
knitr::kable(round(mean_ret, 5))

Calculate the covariance matrix for all crypto coins & tokens, and annualize by multiplying by 252

cov_mat <- cov(log_ret_xts) * 252
knitr::kable(round(cov_mat,4))

Calculate and check the random weights²

wts <- runif(n = length(tick))
wts <- wts/sum(wts)
knitr::kable(wts)

Calculate and check the portfolio returns

port_returns <- (sum(wts * mean_ret) + 1)^252 - 1
knitr::kable(port_returns)

Calculate and check the portfolio risk

port_risk <- sqrt(t(wts) %*% (cov_mat %*% wts))
knitr::kable(port_risk)

Calculate and check the Sharpe Ratio³

sharpe_ratio <- port_returns/port_risk
knitr::kable(sharpe_ratio)

Optimize by utilizing 5000 random portfolios and requiring a for loop

num_port <- 5000

Create a matrix to store the weights

all_wts <- matrix(nrow = num_port,
                  ncol = length(tick))

Create an empty vector to store the Portfolio returns

port_returns <- vector('numeric', length = num_port)

Create an empty vector to store the Portfolio Standard deviation

port_risk <- vector('numeric', length = num_port)

Create an empty vector to store the Portfolio Sharpe Ratio

sharpe_ratio <- vector('numeric', length = num_port)

Run the for loop 5000 times and be sure to use the set.seed() function for reproducibility

set.seed(1)
for (i in seq_along(port_returns)) {
  
  wts <- runif(length(tick))
  wts <- wts/sum(wts)
  
  #store the weights in the matrix
  all_wts[i,] <- wts
  
  #portfolio returns
  port_ret <- sum(wts * mean_ret)
  port_ret <- ((port_ret + 1)^252) - 1
  
  #store the Portfolio Returns values
  port_returns[i] <- port_ret
  
  
  #create and store portfolio risk
  port_sd <- sqrt(t(wts) %*% (cov_mat  %*% wts))
  port_risk[i] <- port_sd
  
  #create and store Portfolio Sharpe Ratios
  #assume a 0% Risk free rate
  sr <- port_ret/port_sd
  sharpe_ratio[i] <- sr
  
}

Create a data table to store all of the values together

portfolio_values <- tibble(Return = port_returns,
                           Risk = port_risk,
                           SharpeRatio = sharpe_ratio)

Coerce the time series objects to tibble objects, then change the column names

all_wts <- tk_tbl(all_wts)
colnames(all_wts) <- colnames(log_ret_xts)

Combine all of the values together

portfolio_values <- tk_tbl(cbind(all_wts, portfolio_values))

#inspect the first few values
knitr::kable(head(portfolio_values))

Look at the portfolios that matter the most

• Minimum variance portfolio: maximized returns with minimized risk
• Tangency portfolio: the allocation with highest Sharpe Ratio

min_var <- portfolio_values[which.min(portfolio_values$Risk),]
max_sr <- portfolio_values[which.max(portfolio_values$SharpeRatio),]

Plot the weights of each portfolio

Minimum variance portfolio

p <- min_var %>%
  gather(`ALGO-USD`:`XMR-USD`, key = Asset,
         value = Weights) %>%
  mutate(Asset = as.factor(Asset)) %>%
  ggplot(aes(x = fct_reorder(Asset,Weights), y = Weights, fill = Asset)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  labs(x = 'Assets', y = 'Weights', title = "Minimum Variance Portfolio Weights") +
  scale_y_continuous(labels = scales::percent) 

ggplotly(p, height = 550, width = 1000)

Tangency portfolio

p <- max_sr %>%
  gather(`ALGO-USD`:`XMR-USD`, key = Asset,
         value = Weights) %>%
  mutate(Asset = as.factor(Asset)) %>%
  ggplot(aes(x = fct_reorder(Asset,Weights), y = Weights, fill = Asset)) +
  geom_bar(stat = 'identity') +
  theme_minimal() +
  labs(x = 'Assets', y = 'Weights', title = "Tangency Portfolio Weights") +
  scale_y_continuous(labels = scales::percent) 

ggplotly(p, height = 550, width = 1000)

Plot all the random portfolios and visualize the efficient frontier

p <- portfolio_values %>%
  ggplot(aes(x = Risk, y = Return, color = SharpeRatio)) +
  geom_point() +
  theme_classic() +
  scale_y_continuous(labels = scales::percent) +
  scale_x_continuous(labels = scales::percent) +
  labs(x = 'Annualized Risk',
       y = 'Annualized Returns',
       title = "Portfolio Optimization & Efficient Frontier") +
  geom_point(aes(x = Risk,
                 y = Return), data = min_var, color = 'red') +
  geom_point(aes(x = Risk,
                 y = Return), data = max_sr, color = 'red') +
  annotate('text', x = 0.32, y = 0.26, label = "Tangency Portfolio") +
  annotate('text', x = 0.21, y = 0.13, label = "Minimum variance portfolio") +
  annotate(geom = 'segment', x = 0.00, xend = 0.00,  y = 0.00, 
           yend = 0.00, color = 'red', arrow = arrow(type = "open")) +
  annotate(geom = 'segment', x = 0.00, xend = 0.00,  y = 0.00, 
           yend = 0.00, color = 'red', arrow = arrow(type = "open"))


ggplotly(p, height = 500, width = 800)