#===========================================================
# SINGLE FACTOR MODEL
#===========================================================
rm(list=ls())
retdata <- read.csv("D:/(1) ADRIN/m-fac9003.csv")
t = dim(retdata)[1]
t
## [1] 168
market = retdata[,14]
market
## [1] -7.52 0.21 1.77 -3.34 8.55 -1.53 -1.16 -10.05 -5.73 -1.27
## [11] 5.40 1.92 3.63 6.23 1.73 -0.44 3.40 -5.25 4.02 1.52
## [21] -2.35 0.77 -4.77 10.82 -2.31 0.64 -2.52 2.48 -0.21 -2.04
## [31] 3.67 -2.66 0.67 -0.03 2.77 0.74 0.46 0.80 1.62 -2.78
## [41] 2.03 -0.18 -0.79 3.19 -1.24 1.69 -1.55 0.75 3.00 -3.28
## [51] -4.87 0.85 0.90 -3.03 2.79 3.39 -3.08 1.67 -4.39 0.76
## [61] 1.95 3.13 2.26 2.33 3.16 1.67 2.73 -0.48 3.57 -0.94
## [71] 3.66 1.32 2.85 0.29 0.38 0.93 1.87 -0.20 -5.00 1.46
## [81] 4.99 2.20 6.92 -2.56 5.71 0.18 -4.69 5.41 5.44 3.93
## [91] 7.39 -6.17 4.90 -3.86 4.03 1.14 0.60 6.62 4.58 0.50
## [101] -2.30 3.53 -1.58 -14.99 5.86 7.70 5.55 5.27 3.74 -3.60
## [111] 3.51 3.44 -2.87 5.06 -3.58 -1.02 -3.24 5.85 1.48 5.35
## [121] -5.53 -2.47 9.20 -3.55 -2.67 1.92 -2.13 5.56 -5.85 -1.00
## [131] -8.52 -0.08 3.03 -9.64 -6.79 7.36 0.21 -2.79 -1.37 -6.69
## [141] -8.39 1.63 7.36 0.62 -1.69 -2.22 3.52 -6.29 -1.05 -7.39
## [151] -8.04 0.35 -11.14 8.51 5.60 -6.13 -2.84 -1.80 0.74 8.01
## [161] 5.00 1.06 1.55 1.71 -1.27 5.42 0.64 5.00
#
retdata1 = retdata[,c(-14)]
head(retdata1)
## AA AGE CAT F FDX GM HPQ KMB MEL NYT PG
## 1 -16.40 -12.17 -4.44 -0.06 -2.28 -2.12 -6.19 -11.01 -10.77 -6.30 -8.89
## 2 4.04 4.95 8.84 6.02 10.47 8.97 -4.01 -5.20 0.34 -4.62 -0.84
## 3 0.12 13.08 0.17 2.06 10.84 1.57 5.67 3.21 -0.17 -0.66 5.41
## 4 -4.28 -11.06 0.25 -5.67 -2.44 -4.19 -5.29 -0.65 -2.20 -10.60 4.26
## 5 5.81 19.70 8.52 3.89 -16.17 10.94 8.81 8.83 11.85 11.59 16.35
## 6 -4.05 -1.44 -22.10 -5.79 -2.81 -2.70 -1.47 1.55 -7.76 -0.12 4.80
## TRB TXN
## 1 -13.04 -7.61
## 2 -0.37 4.97
## 3 2.36 2.69
## 4 -7.98 -6.85
## 5 8.82 22.88
## 6 -0.64 -5.87
retdata1 = as.matrix(retdata1)
head(retdata1)
## AA AGE CAT F FDX GM HPQ KMB MEL NYT PG
## [1,] -16.40 -12.17 -4.44 -0.06 -2.28 -2.12 -6.19 -11.01 -10.77 -6.30 -8.89
## [2,] 4.04 4.95 8.84 6.02 10.47 8.97 -4.01 -5.20 0.34 -4.62 -0.84
## [3,] 0.12 13.08 0.17 2.06 10.84 1.57 5.67 3.21 -0.17 -0.66 5.41
## [4,] -4.28 -11.06 0.25 -5.67 -2.44 -4.19 -5.29 -0.65 -2.20 -10.60 4.26
## [5,] 5.81 19.70 8.52 3.89 -16.17 10.94 8.81 8.83 11.85 11.59 16.35
## [6,] -4.05 -1.44 -22.10 -5.79 -2.81 -2.70 -1.47 1.55 -7.76 -0.12 4.80
## TRB TXN
## [1,] -13.04 -7.61
## [2,] -0.37 4.97
## [3,] 2.36 2.69
## [4,] -7.98 -6.85
## [5,] 8.82 22.88
## [6,] -0.64 -5.87
n = dim(retdata1)[2]
n
## [1] 13
#
ones = rep(1,t)
head(ones)
## [1] 1 1 1 1 1 1
X = cbind(ones, market)
head(X)
## ones market
## [1,] 1 -7.52
## [2,] 1 0.21
## [3,] 1 1.77
## [4,] 1 -3.34
## [5,] 1 8.55
## [6,] 1 -1.53
b_hat = solve(t(X)%*%X)%*%t(X)%*%retdata1
b_hat
## AA AGE CAT F FDX GM HPQ
## ones 0.549124 0.7218061 0.8393521 0.4543643 0.7995790 0.1982025 0.6835681
## market 1.291591 1.5141359 0.9406928 1.2192453 0.8051166 1.0457019 1.6279512
## KMB MEL NYT PG TRB TXN
## ones 0.5463020 0.8849263 0.4904120 0.8880914 0.6512465 1.438887
## market 0.5498052 1.1228708 0.7706495 0.4688034 0.7178808 1.796412
E_hat = retdata1 - X%*%b_hat
head(E_hat)
## AA AGE CAT F FDX GM
## [1,] -7.2363588 -1.5055042 1.7946575 8.6543606 2.9748981 5.5454755
## [2,] 3.2196419 3.9102254 7.8031024 5.3095942 9.5013465 8.5522001
## [3,] -2.7152402 9.6781734 -2.3343784 -0.5524285 8.6153645 -0.4790948
## [4,] -0.5152096 -6.7245922 2.5525617 -2.0520849 -0.5504894 -0.8955583
## [5,] -5.7822280 6.0323321 -0.3622754 -6.9889119 -23.8533263 1.8010466
## [6,] -2.6229896 0.1548218 -21.5000922 -4.3789190 -2.3777506 -1.2982786
## HPQ KMB MEL NYT PG TRB TXN
## [1,] 5.3686247 -7.4217666 -3.2109382 -0.9951281 -6.252690 -8.2927829 4.460129
## [2,] -5.0354379 -5.8617611 -0.7807291 -5.2722484 -1.826540 -1.1720014 3.153867
## [3,] 2.1049583 1.6905428 -3.0424075 -2.5144615 3.692127 0.4381045 -1.928535
## [4,] -0.5362112 0.6400475 0.6654621 -8.5164428 4.937712 -6.2335246 -2.288872
## [5,] -5.7925506 3.5828633 1.3645288 4.5105352 11.453640 2.0308727 6.081793
## [6,] 0.3371972 1.8449000 -6.9269340 0.5686817 4.629178 -0.1928888 -4.560377
diagD_hat = diag(t(E_hat)%*%E_hat)/(t-2)
#===========================================================
# R-Square
#===========================================================
retvar = apply(retdata1, 2, var)
R_2 = 1- diag(t(E_hat)%*%E_hat)/((t-1)*retvar)
res_std = sqrt(diagD_hat)
cov_factor = var(market)*t(b_hat)%*%b_hat + diag(diagD_hat)
#===========================================================
# Global Minimum Variance Portfolio Weight
#===========================================================
one.vec = rep(1,13)
a = solve(cov_factor)%*%one.vec
b = t(one.vec)%*%a
mvp.w = a / as.numeric(b)
mvp.w
## [,1]
## AA 0.03501615
## AGE -0.03373670
## CAT 0.05314427
## F 0.05576422
## FDX 0.06451069
## GM 0.12369835
## HPQ -0.03290554
## KMB 0.28022778
## MEL 0.01901912
## NYT 0.19373120
## PG 0.19019732
## TRB 0.14314200
## TXN -0.09180887
#===========================================================
# Bar Plot
#===========================================================
barplot(as.vector(mvp.w), ylim = c(-0.01, 0.4), names.arg = rownames(mvp.w), cex.names = 0.5)
# ggplot2
library(ggplot2)
library(tidyverse)
## -- Attaching packages --------------------------------------- tidyverse 1.3.0 --
## v tibble 3.0.6 v dplyr 1.0.5
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 1.4.0 v forcats 0.5.1
## v purrr 0.3.4
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
#
Stock<-rownames(mvp.w)
Weight<-as.numeric(mvp.w)
mvp.w.df<-data.frame(Stock, Weight)
#
mvp.w.df %>%
ggplot(aes(Stock, Weight)) +
geom_bar(stat = "identity", fill = "#FF6666")
#===========================================================
# TRADITIONAL WAY
#===========================================================
# Importing Data
library(readr)
retdata <- read.csv("D:/(1) ADRIN/m-fac9003.csv")
str(retdata)
## 'data.frame': 168 obs. of 14 variables:
## $ AA : num -16.4 4.04 0.12 -4.28 5.81 ...
## $ AGE : num -12.17 4.95 13.08 -11.06 19.7 ...
## $ CAT : num -4.44 8.84 0.17 0.25 8.52 ...
## $ F : num -0.06 6.02 2.06 -5.67 3.89 ...
## $ FDX : num -2.28 10.47 10.84 -2.44 -16.17 ...
## $ GM : num -2.12 8.97 1.57 -4.19 10.94 ...
## $ HPQ : num -6.19 -4.01 5.67 -5.29 8.81 ...
## $ KMB : num -11.01 -5.2 3.21 -0.65 8.83 ...
## $ MEL : num -10.77 0.34 -0.17 -2.2 11.85 ...
## $ NYT : num -6.3 -4.62 -0.66 -10.6 11.59 ...
## $ PG : num -8.89 -0.84 5.41 4.26 16.35 ...
## $ TRB : num -13.04 -0.37 2.36 -7.98 8.82 ...
## $ TXN : num -7.61 4.97 2.69 -6.85 22.88 ...
## $ SP500: num -7.52 0.21 1.77 -3.34 8.55 ...
head(retdata)
## AA AGE CAT F FDX GM HPQ KMB MEL NYT PG
## 1 -16.40 -12.17 -4.44 -0.06 -2.28 -2.12 -6.19 -11.01 -10.77 -6.30 -8.89
## 2 4.04 4.95 8.84 6.02 10.47 8.97 -4.01 -5.20 0.34 -4.62 -0.84
## 3 0.12 13.08 0.17 2.06 10.84 1.57 5.67 3.21 -0.17 -0.66 5.41
## 4 -4.28 -11.06 0.25 -5.67 -2.44 -4.19 -5.29 -0.65 -2.20 -10.60 4.26
## 5 5.81 19.70 8.52 3.89 -16.17 10.94 8.81 8.83 11.85 11.59 16.35
## 6 -4.05 -1.44 -22.10 -5.79 -2.81 -2.70 -1.47 1.55 -7.76 -0.12 4.80
## TRB TXN SP500
## 1 -13.04 -7.61 -7.52
## 2 -0.37 4.97 0.21
## 3 2.36 2.69 1.77
## 4 -7.98 -6.85 -3.34
## 5 8.82 22.88 8.55
## 6 -0.64 -5.87 -1.53
#
library(magrittr)
##
## Attaching package: 'magrittr'
## The following object is masked from 'package:purrr':
##
## set_names
## The following object is masked from 'package:tidyr':
##
## extract
# Using Pipe %>%
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: 'xts'
## The following objects are masked from 'package:dplyr':
##
## first, last
##
## Attaching package: 'PerformanceAnalytics'
## The following object is masked from 'package:graphics':
##
## legend
#
retdata1 = retdata[,c(-14)]
head(retdata1)
## AA AGE CAT F FDX GM HPQ KMB MEL NYT PG
## 1 -16.40 -12.17 -4.44 -0.06 -2.28 -2.12 -6.19 -11.01 -10.77 -6.30 -8.89
## 2 4.04 4.95 8.84 6.02 10.47 8.97 -4.01 -5.20 0.34 -4.62 -0.84
## 3 0.12 13.08 0.17 2.06 10.84 1.57 5.67 3.21 -0.17 -0.66 5.41
## 4 -4.28 -11.06 0.25 -5.67 -2.44 -4.19 -5.29 -0.65 -2.20 -10.60 4.26
## 5 5.81 19.70 8.52 3.89 -16.17 10.94 8.81 8.83 11.85 11.59 16.35
## 6 -4.05 -1.44 -22.10 -5.79 -2.81 -2.70 -1.47 1.55 -7.76 -0.12 4.80
## TRB TXN
## 1 -13.04 -7.61
## 2 -0.37 4.97
## 3 2.36 2.69
## 4 -7.98 -6.85
## 5 8.82 22.88
## 6 -0.64 -5.87
retdata1 = as.matrix(retdata1)
head(retdata1)
## AA AGE CAT F FDX GM HPQ KMB MEL NYT PG
## [1,] -16.40 -12.17 -4.44 -0.06 -2.28 -2.12 -6.19 -11.01 -10.77 -6.30 -8.89
## [2,] 4.04 4.95 8.84 6.02 10.47 8.97 -4.01 -5.20 0.34 -4.62 -0.84
## [3,] 0.12 13.08 0.17 2.06 10.84 1.57 5.67 3.21 -0.17 -0.66 5.41
## [4,] -4.28 -11.06 0.25 -5.67 -2.44 -4.19 -5.29 -0.65 -2.20 -10.60 4.26
## [5,] 5.81 19.70 8.52 3.89 -16.17 10.94 8.81 8.83 11.85 11.59 16.35
## [6,] -4.05 -1.44 -22.10 -5.79 -2.81 -2.70 -1.47 1.55 -7.76 -0.12 4.80
## TRB TXN
## [1,] -13.04 -7.61
## [2,] -0.37 4.97
## [3,] 2.36 2.69
## [4,] -7.98 -6.85
## [5,] 8.82 22.88
## [6,] -0.64 -5.87
n = dim(retdata1)[2]
n
## [1] 13
#===========================================================
# Computing Average Returns & Covariance Matrix
#===========================================================
colMeans(retdata1, na.rm = FALSE, dims = 1)
## AA AGE CAT F FDX GM HPQ KMB
## 1.0911310 1.3572024 1.2341071 0.9660119 1.1374405 0.6370238 1.3667262 0.7770238
## MEL NYT PG TRB TXN
## 1.3561310 0.8138095 1.0848214 0.9525000 2.1927381
cov(retdata1)
## AA AGE CAT F FDX GM HPQ
## AA 90.112882 28.86227 49.31388 43.464432 19.664456 34.242355 56.880794
## AGE 28.862273 103.56417 24.95295 34.282986 32.580930 23.966995 36.642005
## CAT 49.313879 24.95295 75.89675 35.835834 17.420441 27.793618 23.525911
## F 43.464432 34.28299 35.83583 95.367745 23.268495 55.690521 37.083186
## FDX 19.664456 32.58093 17.42044 23.268495 90.071428 17.307709 30.852269
## GM 34.242355 23.96700 27.79362 55.690521 17.307709 86.199395 32.721545
## HPQ 56.880794 36.64201 23.52591 37.083186 30.852269 32.721545 138.806037
## KMB 20.609411 18.17817 18.03460 15.164445 15.159650 15.595817 6.463021
## MEL 26.205913 34.73529 23.82231 30.491275 16.220166 26.580488 30.622200
## NYT 25.034114 26.87825 17.30015 27.824778 17.295445 12.620155 29.256944
## PG 3.855214 12.15925 7.74752 6.899894 5.786963 8.698149 6.705664
## TRB 24.185885 19.04334 26.56399 25.553181 22.572230 20.344904 20.424250
## TXN 60.127047 35.70638 39.86890 39.226505 26.958482 43.502386 90.425767
## KMB MEL NYT PG TRB TXN
## AA 20.609411 26.20591 25.03411 3.855214 24.18588 60.127047
## AGE 18.178174 34.73529 26.87825 12.159253 19.04334 35.706380
## CAT 18.034603 23.82231 17.30015 7.747520 26.56399 39.868898
## F 15.164445 30.49127 27.82478 6.899894 25.55318 39.226505
## FDX 15.159650 16.22017 17.29545 5.786963 22.57223 26.958482
## GM 15.595817 26.58049 12.62015 8.698149 20.34490 43.502386
## HPQ 6.463021 30.62220 29.25694 6.705664 20.42425 90.425767
## KMB 42.291513 17.67704 11.48731 14.945996 13.29204 5.740259
## MEL 17.677044 60.86372 14.49687 19.603877 18.58152 37.130870
## NYT 11.487313 14.49687 54.30490 11.902370 28.65053 22.548509
## PG 14.945996 19.60388 11.90237 45.586799 17.78819 12.677508
## TRB 13.292039 18.58152 28.65053 17.788189 61.40641 17.860944
## TXN 5.740259 37.13087 22.54851 12.677508 17.86094 191.352765
avg.return2 <- colMeans(retdata1, na.rm = FALSE, dims = 1)
sigma.mat2 <- cov(retdata1)
#===========================================================
# m-fac9003 Portfolio Weights
#===========================================================
top.mat2 = cbind(2*sigma.mat2, rep(1, 13))
bot.vec2 = c(rep(1, 13), 1)
matrix.c = rbind(top.mat2, bot.vec2)
vector.d = c(rep(1,13), 0)
matrix.w = solve(matrix.c)%*%vector.d
mfac9003.portf = matrix.w[1:13,1]
mfac9003.portf
## AA AGE CAT F FDX
## -0.0001792799 -0.0002093344 0.0021369007 -0.0005734179 0.0023267449
## GM HPQ KMB MEL NYT
## 0.0022585801 0.0008479513 0.0056646653 0.0012221019 0.0044163599
## PG TRB TXN
## 0.0065395649 0.0004136035 -0.0001961802
#===========================================================
# Global Minimum Variance Portfolio Weight
#===========================================================
one.vec2 = rep(1,13)
c = solve(sigma.mat2)%*%one.vec2
d = t(one.vec2)%*%c
mvp.traditional = c / as.numeric(d)
mvp.traditional
## [,1]
## AA -0.007267634
## AGE -0.008485981
## CAT 0.086625516
## F -0.023245172
## FDX 0.094321402
## GM 0.091558142
## HPQ 0.034374185
## KMB 0.229633761
## MEL 0.049541470
## NYT 0.179030053
## PG 0.265100370
## TRB 0.016766625
## TXN -0.007952736
#===========================================================
# Return & Standard Deviation for m-fac9003 Portfolio
#===========================================================
mfac9003min2 = as.numeric(crossprod(mfac9003.portf, avg.return2))
mfac9003min2
## [1] 0.02355876
sig2.mfac9003min2 = as.numeric(t(mfac9003.portf)%*%sigma.mat2%*%mfac9003.portf)
stadev.mfac9003min2 = sqrt(sig2.mfac9003min2)
stadev.mfac9003min2
## [1] 0.1124206
#===========================================================
# Bar Plot
#===========================================================
barplot(as.vector(mvp.traditional), ylim = c(-0.01, 0.4), names.arg = rownames(mvp.traditional), cex.names = 0.5)
# ggplot2
library(ggplot2)
library(tidyverse)
#
Stock2<-rownames(mvp.traditional)
Weight2<-as.numeric(mvp.traditional)
mvp.mfac9003<-data.frame(Stock2, Weight2)
#
mvp.mfac9003 %>%
ggplot(aes(Stock2, Weight2)) +
geom_bar(stat = "identity", fill = "#A5CBC3")
