R Markdown HM1

调用包如下: PerformanceAnalytics、quantmod、xts、dygraphs、tibble、tidyr、ggplot2、highcharter、tidyquant、plotly(创建交互式图标)、timetk(操纵数据序表)、forcats、rmarkdown

## 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
## 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
## Warning: 程辑包'dygraphs'是用R版本4.2.3 来建造的
## Warning: 程辑包'tibble'是用R版本4.2.3 来建造的
## Warning: 程辑包'tidyr'是用R版本4.2.3 来建造的
## Warning: 程辑包'ggplot2'是用R版本4.2.3 来建造的
## Warning: 程辑包'highcharter'是用R版本4.2.3 来建造的
## 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
## 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
## Warning: 程辑包'timetk'是用R版本4.2.3 来建造的
## Warning: 程辑包'forcats'是用R版本4.2.3 来建造的
## Warning: 程辑包'rmarkdown'是用R版本4.2.3 来建造的

选取投资组合对象:1:诺思兰德2:同辉信息3:华岭股份5:辰光医疗,在原数据的基础上删除其他列,读取选取的四支数据。

price <-read.csv("C:/Users/Microsoft/Desktop/!!!/投资组合管理R/HM1data UTF-8.csv")
#修改数据格式
price[, 1] <- gsub("/", "-", price[, 1])
price[,1] = as.POSIXct(price[,1], format = "%Y-%m-%d")
price = xts(price[,-1], order.by=price[,1])

绘制四只股票的走势图

names(price)<-c("诺思兰德","同辉信息","华岭股份","辰光医疗")
dygraph(price)
plot(price)

获取月汇报形成图表

#过滤数据
#pr_monthly <- to.monthly(price, indexAt = "lastof", OHLC = FALSE) 
#head(pr_monthly)
#计算回报
#rt_monthly <- na.omit(Return.calculate(pr_monthly, method = "log")) 
head(price)
##            诺思兰德 同辉信息 华岭股份 辰光医疗
## 2022-01-04    25.47    10.03    20.26     8.86
## 2022-01-05    24.16     9.60    19.47     8.88
## 2022-01-06    24.53     8.50    19.49     8.91
## 2022-01-07    23.19     8.29    19.35     8.67
## 2022-01-10    22.30     8.76    19.61     8.70
## 2022-01-11    20.50     8.30    20.00     8.61
pr_daily <- to.daily(price, indexAt = "lastof", OHLC = FALSE) 
head(pr_daily)
##            诺思兰德 同辉信息 华岭股份 辰光医疗
## 2022-01-31    25.47    10.03    20.26     8.86
## 2022-01-31    24.16     9.60    19.47     8.88
## 2022-01-31    24.53     8.50    19.49     8.91
## 2022-01-31    23.19     8.29    19.35     8.67
## 2022-01-31    22.30     8.76    19.61     8.70
## 2022-01-31    20.50     8.30    20.00     8.61
#计算回报,对数收益率
rt_daily <- na.omit(Return.calculate(pr_daily, method = "log")) 

head(rt_daily)
##               诺思兰德    同辉信息     华岭股份     辰光医疗
## 2022-01-31 -0.05280292 -0.04381750 -0.039773679  0.002254792
## 2022-01-31  0.01519849 -0.12169693  0.001026694  0.003372684
## 2022-01-31 -0.05617571 -0.02501619 -0.007209094 -0.027305451
## 2022-01-31 -0.03913447  0.05514594  0.013347221  0.003454235
## 2022-01-31 -0.08416179 -0.05394039  0.019692633 -0.010398707
## 2022-01-31  0.02600050  0.04706751  0.012422520  0.021827403
dygraph(rt_daily)
mean_ret <- colMeans(rt_daily)
print(round(mean_ret, 4))
## 诺思兰德 同辉信息 华岭股份 辰光医疗 
##  -0.0023  -0.0043  -0.0021  -0.0013
cov_mat <- cov(rt_daily) * 252
print(round(cov_mat,4)) 
##          诺思兰德 同辉信息 华岭股份 辰光医疗
## 诺思兰德   0.2788   0.1010   0.0290   0.0114
## 同辉信息   0.1010   0.3079   0.0353   0.0272
## 华岭股份   0.0290   0.0353   0.1414   0.0105
## 辰光医疗   0.0114   0.0272   0.0105   0.0950

随机生成每只股票权重,标准化权重,打印出随机生成的权重

tick <- c("诺思兰德","同辉信息","华岭股份","辰光医疗")
wts <- runif(n = length(tick))
wts <- wts/sum(wts)
print(wts)
## [1] 0.01475869 0.38894228 0.31329300 0.28300603

计算年收益率

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

计算年风险

port_risk <- sqrt(t(wts) %*% (cov_mat %*% wts))

计算夏普比率

sharpe_ratio <- port_returns/port_risk

随机生成2000个投资组合并计算他们各自的年化收益率,标准差和夏普比率

num_port <- 2000
# 创建一个权重矩阵
all_wts <- matrix(nrow = num_port,
                  ncol = length(tick))

# 分别创建三个向量用来储存每个投资组合的年化回报率,标准差,夏普比率
port_returns <- vector('numeric', length = num_port)
port_risk <- vector('numeric', length = num_port)
sharpe_ratio <- vector('numeric', length = num_port)

#生成1000个投资组合并计算
for (i in seq_along(port_returns)) {
  
  wts <- runif(length(tick))
  wts <- wts/sum(wts)
  
  # 储存随机生成的权重
  all_wts[i,] <- wts
  
  # 计算并储存投资组合回报率
  port_ret <- sum(wts * mean_ret)
  port_ret <- ((port_ret + 1)^252) - 1
  port_returns[i] <- port_ret
  
  # 计算并储存投资组合标准差
  port_sd <- sqrt(t(wts) %*% (cov_mat  %*% wts))
  port_risk[i] <- port_sd
  
  # 计算并储存投资组合夏普比率(假设无风险利率为0)
  sr <- port_ret/port_sd
  sharpe_ratio[i] <- sr
}

# 生成数据储存为表格
portfolio_values <- tibble(Return = port_returns,
                           Risk = port_risk,
                           SharpeRatio = sharpe_ratio)

# 将矩阵转换为点阵并更改列名
all_wts <- tk_tbl(all_wts)
## Warning in tk_tbl.data.frame(as.data.frame(data), preserve_index, rename_index,
## : Warning: No index to preserve. Object otherwise converted to tibble
## successfully.
colnames(all_wts) <- colnames(pr_daily)

# 用生成数据查找最小风险和最大夏普比率的投资组合
portfolio_values <- tk_tbl(cbind(all_wts, portfolio_values))
## Warning in tk_tbl.data.frame(cbind(all_wts, portfolio_values)): Warning: No
## index to preserve. Object otherwise converted to tibble successfully.
min_var <- portfolio_values[which.min(portfolio_values$Risk),]
max_rt <- portfolio_values[which.max(portfolio_values$Return),]
max_sr <- portfolio_values[which.max(portfolio_values$SharpeRatio),]
portfolio_values <- tibble(Return = port_returns,  
                           Risk = port_risk,  
                           SharpeRatio = sharpe_ratio)  
  
max_sr_index <- which.max(portfolio_values$SharpeRatio)  
# 提取最大化夏普比率投资组合的权重  

1.Minimum risk weights and corresponding histogram. 画出最小方差投资组合的权重图。

p <- min_var %>%
  gather(诺思兰德:辰光医疗, 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)

2.Max return weights and corresponding histogram. 提取最大化回报的投资组合权重

p <- max_rt %>%
  gather(诺思兰德:辰光医疗, 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 = "Maximum Return Portfolio Weights") +
  scale_y_continuous(labels = scales::percent) 

ggplotly(p)

3.Max Sharpe Ratio weights and corresponding histogram. 画出最大夏普比率的权重图

p <- max_sr %>%
  gather(诺思兰德:辰光医疗, 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)

4.Portfolio Optimization & Efficient Frontier Plot. X axis is Risk and Y axis is Return. Please also mark minimum risk, max return and max Sharp Ratio points. 画出投资组合的有效边界图,并标出最小方差投资组合和最大夏普比率投资组合在图中的位置。

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 = 3.2, y = 550, label = "Tangency Portfolio") +
#annotate('text', x = 1.3, y = 40, label = "Min Var portfolio") #+
#annotate(geom = 'segment', x = 0.2, xend = 0.185,  y = 0.03, 
#         yend = 0.11, color = 'red', arrow = arrow(type = "open")) +
#annotate(geom = 'segment', x = 0.285, xend = 0.26,  y = 0.34, 
#         yend = 0.31, color = 'red', arrow = arrow(type = "open"))
ggplotly(p)