##调用包
library(PerformanceAnalytics)
## Loading required package: xts
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
##
## Attaching package: 'PerformanceAnalytics'
## The following object is masked from 'package:graphics':
##
## legend
library(quantmod)
## Loading required package: TTR
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library(xts)
library(dygraphs)
library(tibble)
library(tidyr)
library(ggplot2)
library(highcharter)
## Highcharts (www.highcharts.com) is a Highsoft software product which is
## not free for commercial and Governmental use
library(tidyquant)
## ── Conflicts ────────────────────────────────────────── tidyquant_conflicts() ──
## ✖ zoo::as.Date() masks base::as.Date()
## ✖ zoo::as.Date.numeric() masks base::as.Date.numeric()
## ✖ PerformanceAnalytics::legend() masks graphics::legend()
## ✖ quantmod::summary() masks base::summary()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(plotly) # To create interactive charts
##
## Attaching package: '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
##
## Attaching package: 'timetk'
## The following object is masked from 'package:tidyquant':
##
## FANG
library(forcats)
library(scales)
##选取投资组合对象
#BNB(诺思兰德) CLA(乐创技术) HATG(海能技术) QHX(齐鲁华信)
##读取数据
price <-read.csv("C:/R/data_presentation.csv")
print(head(price))
## time JD ACH BIDU CEA
## 1 2020/1/2 35.96 8.94 129.49 28.12
## 2 2020/1/3 36.78 8.96 134.58 27.47
## 3 2020/1/6 37.46 8.76 132.78 26.40
## 4 2020/1/7 38.08 8.76 138.19 26.51
## 5 2020/1/8 38.02 8.50 136.74 26.28
## 6 2020/1/9 38.84 8.40 141.00 26.87
#修改数据格式
price[,1] = as.POSIXct(price[,1])
price = xts(price[,-1], order.by=price[,1])
##绘制走势图
names(price)<-c("BNB","CLA","HATG","QHX")
dygraph(price)
print(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)
## BNB CLA HATG QHX
## 2020-01-02 35.96 8.94 129.49 28.12
## 2020-01-03 36.78 8.96 134.58 27.47
## 2020-01-06 37.46 8.76 132.78 26.40
## 2020-01-07 38.08 8.76 138.19 26.51
## 2020-01-08 38.02 8.50 136.74 26.28
## 2020-01-09 38.84 8.40 141.00 26.87
pr_daily <- to.daily(price, indexAt = "lastof", OHLC = FALSE)
head(pr_daily)
## BNB CLA HATG QHX
## 2020-01-31 35.96 8.94 129.49 28.12
## 2020-01-31 36.78 8.96 134.58 27.47
## 2020-01-31 37.46 8.76 132.78 26.40
## 2020-01-31 38.08 8.76 138.19 26.51
## 2020-01-31 38.02 8.50 136.74 26.28
## 2020-01-31 38.84 8.40 141.00 26.87
#计算回报
rt_daily <- na.omit(Return.calculate(pr_daily, method = "log"))
head(rt_daily)
## BNB CLA HATG QHX
## 2020-01-31 0.022547010 0.002234638 0.03855516 -0.023386567
## 2020-01-31 0.018319478 -0.022574322 -0.01346519 -0.039730490
## 2020-01-31 0.016415513 0.000000000 0.03993593 0.004158010
## 2020-01-31 -0.001576873 -0.030129741 -0.01054824 -0.008713827
## 2020-01-31 0.021338306 -0.011834458 0.03067858 0.022202229
## 2020-01-31 0.014061334 0.002378122 0.01142386 0.032585713
dygraph(rt_daily)
print(dygraph(rt_daily))
mean_ret <- colMeans(rt_daily)
print(round(mean_ret, 4))
## BNB CLA HATG QHX
## 9e-04 9e-04 1e-04 -9e-04
cov_mat <- cov(rt_daily) * 252
print(round(cov_mat,4))
## BNB CLA HATG QHX
## BNB 0.3320 0.1067 0.2232 0.0706
## CLA 0.1067 0.3459 0.0992 0.0755
## HATG 0.2232 0.0992 0.3389 0.0815
## QHX 0.0706 0.0755 0.0815 0.1479
tick <- c("BNB","CLA","HATG","QHX")
wts <- runif(n = length(tick))
wts <- wts/sum(wts)
print(wts)
## [1] 0.04256838 0.26786277 0.52524857 0.16432028
port_returns <- (sum(wts * mean_ret) + 1)^252 - 1
port_risk <- sqrt(t(wts) %*% (cov_mat %*% wts))
sharpe_ratio <- port_returns/port_risk
num_port <- 1000
# 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)
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
}
# Storing the values in the table
portfolio_values <- tibble(Return = port_returns,
Risk = port_risk,
SharpeRatio = sharpe_ratio)
# Converting matrix to a tibble and changing column names
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)
# Combing all the values together
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_sr <- portfolio_values[which.max(portfolio_values$SharpeRatio),]
p1 <- min_var %>%
select(-Risk,-Return,-SharpeRatio) %>%
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 = percent)
ggplotly(p1)
p2 <- max_sr %>%
select(-Risk,-Return,-SharpeRatio) %>%
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 = percent)
ggplotly(p2)
p3 <- portfolio_values %>%
ggplot(aes(x = Risk, y = Return, color = SharpeRatio)) +
geom_point() +
theme_classic() +
scale_y_continuous(labels = percent) +
scale_x_continuous(labels = 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(p3)