调用包如下: 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)