HW4sem2

R Markdown

This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.

When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:

summary(cars)

##      speed           dist       
##  Min.   : 4.0   Min.   :  2.00  
##  1st Qu.:12.0   1st Qu.: 26.00  
##  Median :15.0   Median : 36.00  
##  Mean   :15.4   Mean   : 42.98  
##  3rd Qu.:19.0   3rd Qu.: 56.00  
##  Max.   :25.0   Max.   :120.00

Including Plots

You can also embed plots, for example:

library(tidyverse)

## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──

## ✓ ggplot2 3.3.5     ✓ purrr   0.3.4
## ✓ tibble  3.1.6     ✓ dplyr   1.0.8
## ✓ tidyr   1.2.0     ✓ stringr 1.4.0
## ✓ readr   2.1.2     ✓ forcats 0.5.1

## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()

library(tidyquant)

## Loading required package: lubridate

## 
## Attaching package: 'lubridate'

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

## Loading required package: 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: 'xts'

## The following objects are masked from 'package:dplyr':
## 
##     first, last

## 
## Attaching package: 'PerformanceAnalytics'

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

## Loading required package: quantmod

## Loading required package: TTR

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

## ══ Need to Learn tidyquant? ════════════════════════════════════════════════════
## Business Science offers a 1-hour course - Learning Lab #9: Performance Analysis & Portfolio Optimization with tidyquant!
## </> Learn more at: https://university.business-science.io/p/learning-labs-pro </>

library(plotly)

## 
## 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)
m.barra.9003 <- read.csv("/cloud/project/m-barra-9003.txt", sep="")
glimpse(m.barra.9003)

## Rows: 168
## Columns: 10
## $ AGE  <dbl> -12.17, 4.95, 13.08, -11.06, 19.70, -1.44, -6.52, -8.77, -27.47, …
## $ C    <dbl> -8.69, 2.23, 1.67, 3.90, 13.11, 3.95, -5.84, -14.19, -27.07, -11.…
## $ MWD  <dbl> -8.37, 2.31, 0.16, 2.20, 12.28, 1.82, -16.96, -7.44, -12.81, -1.8…
## $ MER  <dbl> -13.97, -0.64, -3.99, -4.10, 13.21, -5.41, 5.48, -13.85, -9.76, -…
## $ DELL <dbl> -16.55, 34.49, 21.34, 10.83, 28.77, 14.13, -7.57, -0.62, -26.15, …
## $ HPQ  <dbl> -6.19, -4.01, 5.67, -5.29, 8.81, -1.47, -9.37, -19.75, -4.26, -22…
## $ IBM  <dbl> 4.14, 5.90, 1.51, 2.06, 10.56, -2.73, -5.74, -8.17, 3.80, -1.54, …
## $ AA   <dbl> -16.40, 4.04, 0.12, -4.28, 5.81, -4.05, 9.09, -7.99, -3.33, -15.1…
## $ CAT  <dbl> -4.44, 8.84, 0.17, 0.25, 8.52, -22.10, -7.19, -12.64, -2.36, -3.4…
## $ PG   <dbl> -8.89, -0.84, 5.41, 4.26, 16.35, 4.80, -0.55, -11.86, -5.97, 7.98…

cov_mat<-cov(m.barra.9003)
wts <- runif(n=length(m.barra.9003))
print(wts)

##  [1] 0.60915960 0.04239989 0.90341240 0.26467511 0.31802960 0.68805389
##  [7] 0.41849592 0.21580318 0.80073195 0.59177873

print(sum(wts))

## [1] 4.85254

wts<-wts/sum(wts) #caculate the random weights
print(wts)

##  [1] 0.125534168 0.008737669 0.186173087 0.054543620 0.065538787 0.141792514
##  [7] 0.086242647 0.044472209 0.165012942 0.121952358

sum(wts)

## [1] 1

mean_ret<-colMeans(m.barra.9003)
print(mean_ret)

##      AGE        C      MWD      MER     DELL      HPQ      IBM       AA 
## 1.357202 2.078274 1.867560 2.077976 4.819762 1.366726 1.055060 1.091131 
##      CAT       PG 
## 1.234107 1.084821

port_returns<-sum(wts*mean_ret) # caculate the porfolio returns
print(port_returns)

## [1] 1.634693

port_risk <- sqrt(t(wts)%*%(cov_mat %*% wts)) #caculate porfolio risk
print(port_risk)

##          [,1]
## [1,] 6.695475

sharpe_ratio<-port_returns/port_risk #caculate the sharpe ratio
print(sharpe_ratio)

##          [,1]
## [1,] 0.244149

num_port<-5000
all_wts <- matrix(nrow = num_port,
                  ncol = length(m.barra.9003))
port_returns <- vector('numeric', length = num_port)
port_risk <- vector('numeric', length = num_port)
sharpe_ratio <- vector('numeric', length = num_port)
for (i in seq_along(port_returns)) {
  
  wts <- runif(length(m.barra.9003))
  wts <- wts/sum(wts)
all_wts[i,] <- wts
port_ret <- sum(wts * mean_ret)
port_returns[i] <- port_ret
port_sd <- sqrt(t(wts) %*% (cov_mat  %*% wts))
  port_risk[i] <- port_sd
  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(m.barra.9003)
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.

head(portfolio_values)

## # A tibble: 6 × 13
##      AGE      C    MWD    MER    DELL    HPQ    IBM     AA     CAT     PG Return
##    <dbl>  <dbl>  <dbl>  <dbl>   <dbl>  <dbl>  <dbl>  <dbl>   <dbl>  <dbl>  <dbl>
## 1 0.0508 0.0305 0.159  0.150  0.0695  0.153  0.144  0.119  0.00728 0.118    1.70
## 2 0.0437 0.118  0.155  0.0649 0.00174 0.0782 0.182  0.110  0.166   0.0804   1.45
## 3 0.0964 0.0305 0.0973 0.0925 0.149   0.131  0.0979 0.159  0.0575  0.0887   1.91
## 4 0.0893 0.152  0.0763 0.154  0.0299  0.155  0.112  0.0954 0.0562  0.0796   1.63
## 5 0.230  0.128  0.0862 0.0304 0.0521  0.0927 0.0324 0.171  0.147   0.0301   1.61
## 6 0.0905 0.0566 0.119  0.117  0.131   0.0866 0.0298 0.0308 0.131   0.207    1.91
## # … with 2 more variables: Risk <dbl>, SharpeRatio <dbl>

min_var <- portfolio_values[which.min(portfolio_values$Risk),]
print(min_var)

## # A tibble: 1 × 13
##      AGE     C     MWD    MER  DELL    HPQ    IBM     AA   CAT    PG Return
##    <dbl> <dbl>   <dbl>  <dbl> <dbl>  <dbl>  <dbl>  <dbl> <dbl> <dbl>  <dbl>
## 1 0.0421 0.100 0.00673 0.0369 0.104 0.0332 0.0763 0.0236 0.258 0.320   1.67
## # … with 2 more variables: Risk <dbl>, SharpeRatio <dbl>

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

Note that the echo = FALSE parameter was added to the code chunk to prevent printing of the R code that generated the plot.