QMBG

df_print: paged pdf_document: df_print: paged word_document: default subtitle: Department of Maritime Finance, Daliam Maritime University, Portfolio Optimization Management —

Downloading data

First lets load our packages

library(PerformanceAnalytics)

## Warning: 程辑包'PerformanceAnalytics'是用R版本4.2.3 来建造的

## 载入需要的程辑包：xts

## Warning: 程辑包'xts'是用R版本4.2.3 来建造的

## 载入需要的程辑包：zoo

## Warning: 程辑包'zoo'是用R版本4.2.3 来建造的

## 
## 载入程辑包：'zoo'

## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

## 
## 载入程辑包：'PerformanceAnalytics'

## The following object is masked from 'package:graphics':
## 
##     legend

library(quantmod)

## Warning: 程辑包'quantmod'是用R版本4.2.3 来建造的

## 载入需要的程辑包：TTR

## Warning: 程辑包'TTR'是用R版本4.2.3 来建造的

## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

library(xts) 
library(dygraphs)

## Warning: 程辑包'dygraphs'是用R版本4.2.3 来建造的

library(tibble)

## Warning: 程辑包'tibble'是用R版本4.2.3 来建造的

library(tidyr)

## Warning: 程辑包'tidyr'是用R版本4.2.3 来建造的

library(ggplot2)

## Warning: 程辑包'ggplot2'是用R版本4.2.3 来建造的

library(highcharter)

## Warning: 程辑包'highcharter'是用R版本4.2.3 来建造的

library(tidyquant)

## Warning: 程辑包'tidyquant'是用R版本4.2.3 来建造的

## 载入需要的程辑包：lubridate

## Warning: 程辑包'lubridate'是用R版本4.2.3 来建造的

## 
## 载入程辑包：'lubridate'

## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union

library(plotly) # To create interactive charts

## Warning: 程辑包'plotly'是用R版本4.2.3 来建造的

## 
## 载入程辑包：'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

library(timetk) # To manipulate the data series

## Warning: 程辑包'timetk'是用R版本4.2.3 来建造的

library(forcats)

## Warning: 程辑包'forcats'是用R版本4.2.3 来建造的

library(tidyverse)

## Warning: 程辑包'tidyverse'是用R版本4.2.3 来建造的

## Warning: 程辑包'readr'是用R版本4.2.3 来建造的

## Warning: 程辑包'purrr'是用R版本4.2.3 来建造的

## Warning: 程辑包'dplyr'是用R版本4.2.3 来建造的

## Warning: 程辑包'stringr'是用R版本4.2.3 来建造的

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr   1.1.3     ✔ readr   2.1.5
## ✔ purrr   1.0.2     ✔ stringr 1.5.0

## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks plotly::filter(), stats::filter()
## ✖ dplyr::first()  masks xts::first()
## ✖ dplyr::lag()    masks stats::lag()
## ✖ dplyr::last()   masks xts::last()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

Next lets select a few stocks to build our portfolios.

We will choose the following 5 stocks NSLD(诺思兰德) THXX(同辉信息) JXGF(佳先股份) WCGD(微创光电) LDYL(鹿得医疗) WHDZ(威贺电子) LJSY(流金岁月)

Read the price data.

##选取投资组合对象
#NSLD(诺思兰德) THXX(同辉信息)  JXGF(佳先股份)  WCGD(微创光电) LDYL(鹿得医疗) WHDZ(威贺电子) LJSY(流金岁月)
##读取数据
price <-read.csv("D:/TZZH/qm2.csv")
# 修改数据格式
price[, 1] <- as.POSIXct(price[, 1], format = "%Y/%m/%d")
price <- na.omit(price)
price <- xts(price[,-1], order.by = price[, 1])

# 设置列名
names(price) <- c("NSLD", "THXX", "JXGF", "WCGD", "LDYL","WHDZ","LJSY")

# 绘制价格走势图
dygraph(price)

Next we will calculate the daily returns for these stocks. We will use the logarithmic returns.

# 计算回报率
rt_daily <- Return.calculate(price, method = "log")
rt_daily <- na.omit(rt_daily)

# 绘制回报率走势图
dygraph(rt_daily)

Next let’s calculate the mean daily returns for each asset. Calculate the covariance matrix for all these stocks. We will annualize it by multiplying by 252.

mean_ret <- colMeans(rt_daily)
print(round(mean_ret, 4))

##    NSLD    THXX    JXGF    WCGD    LDYL    WHDZ    LJSY 
##  0.0004  0.0005 -0.0004 -0.0033 -0.0021  0.0002 -0.0010

cov_mat <- cov(rt_daily) * 252
print(round(cov_mat,4))

##        NSLD   THXX   JXGF   WCGD    LDYL    WHDZ   LJSY
## NSLD 0.5984 0.1666 0.0898 0.0653  0.0859  0.0604 0.0951
## THXX 0.1666 0.5706 0.1642 0.1207  0.1210  0.0254 0.1591
## JXGF 0.0898 0.1642 0.5046 0.0658  0.0970  0.0280 0.0839
## WCGD 0.0653 0.1207 0.0658 0.5272  0.0924  0.0463 0.0832
## LDYL 0.0859 0.1210 0.0970 0.0924  0.5305 -0.0124 0.1265
## WHDZ 0.0604 0.0254 0.0280 0.0463 -0.0124  0.4354 0.0266
## LJSY 0.0951 0.1591 0.0839 0.0832  0.1265  0.0266 0.3589

To calculate the portfolio returns and risk (standard deviation) we will us need

Mean assets returns
Portfolio weights
Covariance matrix of all assets
Random weights

# Calculate the random weights
tick <- c("NSLD","THXX","JXGF","WCGD","LDYL","WHDZ","LJSY")
wts <- runif(n = length(tick))
wts <- wts/sum(wts)
print(wts)

## [1] 0.07702833 0.24950589 0.13692924 0.04726756 0.03869562 0.34247074 0.10810261

# Calculate the portfolio returns
port_returns <- (sum(wts * mean_ret) + 1)^252 - 1
port_risk <- sqrt(t(wts) %*% (cov_mat %*% wts))
sharpe_ratio <- port_returns/port_risk

We have everything we need to perform our optimization. All we need now is to run this code on 10000 random portfolios. For that we will use a for loop.

Before we do that, we need to create empty vectors and matrix for storing our values.

# Creating a matrix to store the weights
num_port <- 10000

# Creating a matrix to store the weights

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

# Creating an empty vector to store
# Portfolio returns

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

# Creating an empty vector to store
# Portfolio Standard deviation

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

# Creating an empty vector to store
# Portfolio Sharpe Ratio

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

Next lets run the for loop 5000 times.

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

All the heavy lifting has been done and now we can create a data table to store all the values together.

# Store all results in a tibble
portfolio_values <- tibble(Return = port_returns,
                           Risk = port_risk,
                           SharpeRatio = sharpe_ratio)

# Convert weights matrix to a tibble and set column names
all_wts <- as_tibble(all_wts, .name_repair = "unique")

## New names:
## • `` -> `...1`
## • `` -> `...2`
## • `` -> `...3`
## • `` -> `...4`
## • `` -> `...5`
## • `` -> `...6`
## • `` -> `...7`

colnames(all_wts) <- tick

# Combine all results into one data frame
portfolio_values <- bind_cols(all_wts, portfolio_values)

# Print the final portfolio values table
print(portfolio_values)

## # A tibble: 10,000 × 10
##       NSLD   THXX    JXGF   WCGD    LDYL   WHDZ   LJSY Return  Risk SharpeRatio
##      <dbl>  <dbl>   <dbl>  <dbl>   <dbl>  <dbl>  <dbl>  <dbl> <dbl>       <dbl>
##  1 0.0208  0.197  0.0510  0.247  0.164   0.277  0.0430 -0.235 0.397      -0.591
##  2 0.00343 0.228  0.00878 0.246  0.0748  0.263  0.176  -0.219 0.404      -0.542
##  3 0.135   0.0119 0.260   0.0992 0.0615  0.361  0.0714 -0.118 0.391      -0.302
##  4 0.189   0.0508 0.147   0.271  0.0272  0.246  0.0695 -0.209 0.393      -0.532
##  5 0.158   0.135  0.00696 0.295  0.00196 0.220  0.184  -0.221 0.406      -0.545
##  6 0.187   0.137  0.0376  0.259  0.167   0.0670 0.145  -0.264 0.411      -0.642
##  7 0.306   0.119  0.114   0.195  0.0346  0.206  0.0263 -0.133 0.415      -0.320
##  8 0.0377  0.154  0.154   0.150  0.139   0.174  0.190  -0.207 0.379      -0.546
##  9 0.00940 0.180  0.441   0.168  0.00465 0.0209 0.176  -0.188 0.467      -0.402
## 10 0.0822  0.200  0.0646  0.0752 0.193   0.182  0.202  -0.166 0.389      -0.426
## # ℹ 9,990 more rows

We have the weights in each asset with the risk and returns along with the Sharpe ratio of each portfolio.

Next lets look at the portfolios that matter the most.

The minimum variance portfolio
The tangency portfolio (the portfolio 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. First with the minimum variance portfolio.

p <- min_var %>%
  gather(NSLD:LJSY, 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)

Next lets look at the tangency portfolio or the the portfolio with the highest sharpe ratio.

p <- max_sr %>%
  gather(NSLD:LJSY, 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)

Finally lets 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') 
  

ggplotly(p)

QMBG

Lai wenbiao

2024-06-17

Downloading data