title: “homework1” author: “赵祥润2220213222” date: “2024-05-06” output: html_document —
library(PerformanceAnalytics)## Warning: 程辑包'PerformanceAnalytics'是用R版本4.3.3 来建造的## 载入需要的程辑包：xts## Warning: 程辑包'xts'是用R版本4.3.2 来建造的## 载入需要的程辑包：zoo## Warning: 程辑包'zoo'是用R版本4.3.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## 载入需要的程辑包：xts
## 载入需要的程辑包：zoo
##
## 载入程辑包：'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.3.2 来建造的## 载入需要的程辑包：TTR## Warning: 程辑包'TTR'是用R版本4.3.2 来建造的## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo## 载入需要的程辑包：TTR
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library(xts)
library(dygraphs)## Warning: 程辑包'dygraphs'是用R版本4.3.3 来建造的library(tibble)## Warning: 程辑包'tibble'是用R版本4.3.2 来建造的library(tidyr) ## Warning: 程辑包'tidyr'是用R版本4.3.3 来建造的library(ggplot2) ## Warning: 程辑包'ggplot2'是用R版本4.3.2 来建造的library(highcharter) ## Warning: 程辑包'highcharter'是用R版本4.3.3 来建造的## Highcharts (www.highcharts.com) is a Highsoft software product which is## not free for commercial and Governmental uselibrary(tidyquant)## Warning: 程辑包'tidyquant'是用R版本4.3.3 来建造的## 载入需要的程辑包：lubridate## Warning: 程辑包'lubridate'是用R版本4.3.3 来建造的##
## 载入程辑包：'lubridate'## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union## 载入需要的程辑包：lubridate
##
## 载入程辑包：'lubridate'
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
library(plotly) # To create interactive charts## Warning: 程辑包'plotly'是用R版本4.3.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##
## 载入程辑包：'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.3.3 来建造的library(forcats)## Warning: 程辑包'forcats'是用R版本4.3.3 来建造的library(PerformanceAnalytics)
library(quantmod)
library(xts)
library(dygraphs)
library(tibble)
library(tidyr)
library(ggplot2)
library(highcharter)
library(tidyquant)
library(timetk)
library(forcats)
library(dplyr)## Warning: 程辑包'dplyr'是用R版本4.3.3 来建造的##
## ######################### Warning from 'xts' package ##########################
## # #
## # The dplyr lag() function breaks how base R's lag() function is supposed to #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or #
## # source() into this session won't work correctly. #
## # #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop #
## # dplyr from breaking base R's lag() function. #
## # #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning. #
## # #
## #################################################################################
## 载入程辑包：'dplyr'## The following objects are masked from 'package:xts':
##
## first, last## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(plotly)
library(forcats)
##选取投资组合对象
#THXX(同辉信息) HLGF(华岭股份) WCGD(微创光电) CGYL(辰光医疗)
##读取数据
price <-read.csv("C:/Users/赵祥润/Desktop/数据.csv")
#修改数据格式
price[,1] = as.POSIXct(price[,1])
price = xts(price[,-1], order.by=price[,1])
##绘制走势图
names(price)<-c("THXX","HLGF","WCGD","CGYL")
dygraph(price) pr_daily <- to.daily(price, indexAt = "lastof", OHLC = FALSE)
#计算回报
rt_daily <- na.omit(Return.calculate(pr_daily, method = "log"))
dygraph(rt_daily)mean_ret <- colMeans(rt_daily)
print(round(mean_ret, 4))## THXX HLGF WCGD CGYL
## -0.0043 -0.0021 -0.0024 -0.0013cov_mat <- cov(rt_daily) * 252
print(round(cov_mat,4))## THXX HLGF WCGD CGYL
## THXX 0.3079 0.0353 0.0611 0.0272
## HLGF 0.0353 0.1414 0.0222 0.0105
## WCGD 0.0611 0.0222 0.0667 0.0228
## CGYL 0.0272 0.0105 0.0228 0.0950# Calculate the random weights
tick <- c("THXX","HLGF","WCGD","CGYL")
wts <- runif(n = length(tick))
wts <- wts/sum(wts)
print(wts)## [1] 0.44306256 0.27601149 0.23797049 0.04295547# 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
# 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)
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),]
p <- min_var %>%
gather(THXX:CGYL, 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)p <- max_sr %>%
gather(THXX:CGYL, 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)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)