DATA

#Define the symbols we want to take 
symbols <- c("SPY", "QQQ", "EEM", "IWM", "EFA", "TLT", "IYR", "GLD")

#Create a portfolio variable named portfolioPrices with undefined value
portfolioPrices <- NULL

#Extract data from yahoo finance and feed the data in portfolioPrices
for (symbol in symbols){
  portfolioPrices <- cbind(portfolioPrices,
                           getSymbols.yahoo(symbol, from  = '2018-01-01', to = '2022-12-31', auto.assign = FALSE)[, 6])
}

#rename the data according to symbols
colnames(portfolioPrices) <- symbols
#Change data from daily to weekly
prices_weekly <- to.weekly(portfolioPrices, indexAt = "last", OHLC = FALSE)

#Change data from daily to monthly
prices_monthly <- to.monthly(portfolioPrices, indexAt = "last", OHLC = FALSE)

#Calculate daily return
asset_returns_day_xts <- na.omit(Return.calculate(portfolioPrices))

#Calculate weekly retun
asset_returns_wk_xts <- na.omit(Return.calculate(prices_weekly))

#Calculate monthly return
asset_returns_mon_xts <- na.omit(Return.calculate(prices_monthly))

head(asset_returns_day_xts)
##                     SPY           QQQ          EEM           IWM           EFA
## 2018-01-03  0.006325273  9.716766e-03  0.009581402  0.0010398241  0.0048003988
## 2018-01-04  0.004214646  1.749540e-03  0.004951427  0.0026612984  0.0109595857
## 2018-01-05  0.006664274  1.004307e-02  0.008622480  0.0020715514  0.0055594899
## 2018-01-08  0.001828810  3.890712e-03  0.000000000  0.0015506098 -0.0002763004
## 2018-01-09  0.002263371  6.150099e-05 -0.001628333 -0.0013544725  0.0011058732
## 2018-01-10 -0.001529853 -2.337672e-03 -0.006320156  0.0001289817 -0.0019333535
##                      TLT          IYR           GLD
## 2018-01-03  0.0047808494 -0.001612659 -0.0026368504
## 2018-01-04 -0.0001579994 -0.015658225  0.0051273786
## 2018-01-05 -0.0028560018  0.001010036 -0.0010361649
## 2018-01-08 -0.0006363493  0.005675368 -0.0001596128
## 2018-01-09 -0.0133724542 -0.011537594 -0.0046284751
## 2018-01-10 -0.0012100966 -0.012179500  0.0024051585
head(asset_returns_wk_xts)
##                     SPY         QQQ          EEM          IWM          EFA
## 2018-01-12  0.016458072  0.01587214  0.007734559  0.021771671  0.015895050
## 2018-01-19  0.008959618  0.01124657  0.018784049  0.002781799  0.008571218
## 2018-01-26  0.022003244  0.02759433  0.032514000  0.006305049  0.015108794
## 2018-02-02 -0.038837006 -0.03697416 -0.058179781 -0.036152665 -0.035880296
## 2018-02-09 -0.050644693 -0.05169783 -0.053618996 -0.045894926 -0.054583238
## 2018-02-16  0.044397794  0.05675839  0.067212780  0.044763993  0.041259696
##                     TLT          IYR          GLD
## 2018-01-12 -0.009466238 -0.029385746  0.013005643
## 2018-01-19 -0.011724976  0.006496791 -0.004253315
## 2018-01-26  0.004306736  0.016911750  0.013051805
## 2018-02-02 -0.030431383 -0.029325626 -0.013117887
## 2018-02-09 -0.013714564 -0.041590639 -0.012817492
## 2018-02-16  0.006528729  0.024290652  0.025567064
head(asset_returns_mon_xts)
##                     SPY         QQQ          EEM          IWM          EFA
## 2018-02-28 -0.036360846 -0.01292810 -0.058984954 -0.038436938 -0.048347869
## 2018-03-29 -0.027410207 -0.04078836  0.005414521  0.012175270 -0.008396242
## 2018-04-30  0.005168179  0.00505834 -0.028169096  0.009813641  0.015212459
## 2018-05-31  0.024309240  0.05672928 -0.026214955  0.061635707 -0.018942686
## 2018-06-29  0.005750860  0.01145062 -0.045456687  0.006143769 -0.015840835
## 2018-07-31  0.037046175  0.02796394  0.035310431  0.016490402  0.028520013
##                     TLT          IYR          GLD
## 2018-02-28 -0.030414707 -0.066572865 -0.020759902
## 2018-03-29  0.028596981  0.037718868  0.006320007
## 2018-04-30 -0.020881499  0.002252384 -0.009539745
## 2018-05-31  0.020043985  0.033712624 -0.011959209
## 2018-06-29  0.006457875  0.040594716 -0.036149448
## 2018-07-31 -0.014368740  0.008314390 -0.022418910

Question1 The global minimum variance portfolio in terms of weekly asset returns

#Find the covariance matrix 
cov_w <- cov(asset_returns_wk_xts)

#Create the 8x1 matrix with value = 1
one <- rep(1,8)
one_81 <- matrix(one,ncol=1) #8x1

#According to the formula to calculate GMVP, we denote a_w as the numerator and b_w as the denominator
a_w <- inv(cov_w)%*%one_81 # 8x8 x 8x1 = 8x1
b_w <- t(one_81)%*%inv(cov_w)%*%one_81 # 1x8 x 8x8 x 8x1 = 1x1

#Calculate GMVP
mvp_w <- a_w/as.vector(b_w)

#Format the table
colnames(mvp_w) <- "Weight"
mvp_w <- data.frame(mvp_w) %>% 
         kbl(format = "html", caption = "GMVP (weekly return)") %>%
         row_spec(row = 0, bold = TRUE, color = "black", background = "#FF9999") %>%
         kable_styling(bootstrap_options = "striped", full_width = F, position = "center")
mvp_w
GMVP (weekly return)
Weight
SPY 0.9920217
QQQ -0.4595039
EEM 0.1668411
IWM -0.0741901
EFA -0.1213652
TLT 0.4855628
IYR -0.2326821
GLD 0.2433156 
#Find the covariance matrix 
cov_m <- cov(asset_returns_mon_xts)

#According to the formula to calculate GMVP, we denote a_w as the numerator and b_w as the denominator
a_m <- inv(cov_m)%*%one_81 # 8x8 x 8x1 = 8x1
b_m <- t(one_81)%*%inv(cov_m)%*%one_81 # 1x8 x 8x8 x 8x1 = 1x1

#Calculate GMVP
mvp_m <- a_m/as.vector(b_m)

#Format the table
colnames(mvp_m) <- "Weight"
mvp_m <- data.frame(mvp_m) %>% 
         kbl(format = "html", caption = "GMVP (monthly return)") %>%
         row_spec(row = 0, bold = TRUE, color = "black", background ="#FF9999") %>%
         kable_styling(bootstrap_options = "striped", full_width = F, position = "center")
mvp_m
GMVP (monthly return)
Weight
SPY 1.1924447
QQQ -0.7673211
EEM 0.0189746
IWM 0.1903908
EFA -0.1510369
TLT 0.5703820
IYR -0.3098996
GLD 0.2560654

Question2 Portfolio with annual return equal 0.045 with weekly data

#Calculate the mean return according to symbol
mean_w <-colMeans(asset_returns_wk_xts) #1x8 

#We use Lagrangian function to solve the problem. Finally, we have the function A*x=b0, with x is the portfolio weight, A and b0 is denoted as:
A_w <-rbind(2*cov_w,mean_w,t(one_81)) 
A_w <- cbind(A_w, rbind(t(tail(A_w, 2)), matrix(0, 2, 2))) #8x8 
b0_w <- c(rep(0, ncol(asset_returns_wk_xts)), 0.045/52, 1) #1x8
#0.045/52 is the weekly return

#Calculate the portfolio weight
x_w <- solve(A_w,b0_w)
port_w <- as.matrix(x_w[1:8])

#Format the table
colnames(port_w) <- "Weight"
port_w <- data.frame(port_w) %>% 
         kbl(format = "html", caption = "Portfolio with minimum risk and annual return at 4.5% (weekly return)") %>%
         row_spec(row = 0, bold = TRUE, color = "black", background = "#FF9999") %>%
         kable_styling(bootstrap_options = "striped", full_width = F, position = "center")
port_w
Portfolio with minimum risk and annual return at 4.5% (weekly return)
Weight
SPY 1.0759032
QQQ -0.4015925
EEM 0.0884017
IWM -0.0962362
EFA -0.1668217
TLT 0.4265158
IYR -0.2435871
GLD 0.3174168

Find Annual return equal 0.045 with monthly data

#Calculate the mean return according to symbol
mean_m <-colMeans(asset_returns_mon_xts) #1x8 

#We use Lagrangian function to solve the problem. Finally, we have the function A*x=b0, with x is the portfolio weight, A and b0 is denoted as:
A_m <-rbind(2*cov_m,mean_m,t(one_81))
A_m <- cbind(A_m, rbind(t(tail(A_m, 2)), matrix(0, 2, 2))) #8x8 
b0_m <- c(rep(0, ncol(asset_returns_mon_xts)), 0.045/12, 1) #1x8 
#0.045/12 is the monthly return

#Calculate the portfolio weight
x_m <- solve(A_m,b0_m)
port_m <- as.matrix(x_m[1:8])

#Format the table
colnames(port_m) <- "Weight"
port_m <- data.frame(port_m) %>% 
         kbl(format = "html", caption = "Portfolio with minimum risk and annual return at 4.5% (monthly return)") %>%
         row_spec(row = 0, bold = TRUE, color = "black", background = "#FF9999") %>%
         kable_styling(bootstrap_options = "striped", full_width = F, position = "center")
port_m
Portfolio with minimum risk and annual return at 4.5% (monthly return)
Weight
SPY 1.3335636
QQQ -0.7064488
EEM -0.0449025
IWM 0.1495403
EFA -0.2471782
TLT 0.4885663
IYR -0.3156004
GLD 0.3424595

Question3 Find Tangency Portfolio with weekly data

#The tangency portfolio is the portfolio that has largest sharpe ratio, by using Lagrangian function we have the formula following:
nume_t_w <- inv(cov_w)%*%mean_w # 8x8 x 8x1 = 8x1
deno_t_w <- t(one_81)%*%nume_t_w # 1x8 x 8x1

#Calculate the tangency portfolio
tangency_w <- nume_t_w/as.vector(deno_t_w)

#Format the table
colnames(tangency_w) <- "Weight"
tangency_w <- data.frame(tangency_w) %>% 
         kbl(format = "html", caption = "Tangency Portfolio with weekly data") %>%
         row_spec(row = 0, bold = TRUE, color = "black", background = "#FF9999") %>%
         kable_styling(bootstrap_options = "striped", full_width = F, position = "center")
tangency_w
Tangency Portfolio with weekly data
Weight
SPY 2.8905966
QQQ 0.8512640
EEM -1.6085584
IWM -0.5731829
EFA -1.1502298
TLT -0.8509067
IYR -0.4795051
GLD 1.9205223

Find Tangency Portfolio with monthly data

#The tangency portfolio is the portfolio that has largest sharpe ratio, by using Lagrangian function we have the formula following:
nume_t_m <- inv(cov_m)%*%mean_m # 8x8 x 8x1 = 8x1
deno_t_m <- t(one_81)%*%nume_t_m # 1x8 x 8x1

#Calculate the tangency portfolio
tangency_m <- nume_t_m/as.vector(deno_t_m)

#Format the table
colnames(tangency_m) <- "Weight"
tangency_m <- data.frame(tangency_m) %>% 
         kbl(format = "html", caption = "Tangency Portfolio with weekly data") %>%
         row_spec(row = 0, bold = TRUE, color = "black", background = "#FF9999") %>%
         kable_styling(bootstrap_options = "striped", full_width = F, position = "center")
tangency_m
Tangency Portfolio with weekly data
Weight
SPY 4.2186811
QQQ 0.5380599
EEM -1.3508424
IWM -0.6856308
EFA -2.2127461
TLT -1.1841224
IYR -0.4321495
GLD 2.1087502

Question4 Find covariance matrix

berndt <- read_excel("berndt.xlsx")
ber_port <- berndt %>% select(, -MARKET, -RKFREE)
ber_market <- berndt %>% select(MARKET, RKFREE) %>% mutate(Market = MARKET - RKFREE) 
ber_market <- ber_market%>% select(Market)
#According to the formula in the class, we define Y= BX while Y is the portfolio_return matrix (120x15 - 15 assets in 120 months), B is the matrix that consists of a in the first column and B in the second column:
one_120 <- rep(1,120)
X <- as.matrix(cbind(one_120, ber_market)) # 120x2
Y <- as.matrix(ber_port) # 120x15

#We calculate the b_hat:
b_hat = solve(t(X)%*%X)%*%t(X) %*% Y #2x15 : first row- alpha, second row - beta

#The e_hat is equal the difference between actual return and return derived from the formula:
E_hat = Y - X %*% b_hat #120x15
head(E_hat,6) 
##           CITCRP         CONED      CONTIL      DATGEN         DEC       DELTA
## [1,] -0.08906182 -0.0924325479 -0.08644938 -0.03294113 -0.07166573 -0.01200381
## [2,] -0.02947098 -0.0213220221  0.03962148 -0.10233449 -0.08098502 -0.04367536
## [3,]  0.02222799  0.0001459493 -0.02322229  0.01692842 -0.04144488  0.04005781
## [4,]  0.08137923 -0.0280423719  0.14407347  0.11922277  0.10229784  0.11357564
## [5,] -0.04312626 -0.0373788404  0.02232575 -0.01165793 -0.02788962 -0.06925976
## [6,] -0.00126376  0.0159743906 -0.05395791 -0.02491578 -0.03617703  0.01394154
##            GENMIL       GERBER         IBM        MOBIL       PANAM
## [1,] -0.100413553 -0.028965238 -0.01280576 -0.021675972  0.06312884
## [2,]  0.001973487  0.144900665 -0.05166925 -0.031704502 -0.07498803
## [3,] -0.049582534 -0.075756917 -0.08963000  0.006102306  0.15303258
## [4,]  0.015865982 -0.044052752  0.09732727  0.024616945  0.04828272
## [5,]  0.031860393 -0.004401685 -0.05238371 -0.066068798  0.03852208
## [6,] -0.007140637  0.014969963 -0.01116196 -0.055338490  0.01944396
##              PSNH       TANDY      TEXACO         WEYER
## [1,]  0.008151819 -0.04037246 -0.03121181 -0.0790751380
## [2,] -0.020345243 -0.02681935 -0.02066688 -0.1429243732
## [3,]  0.022349580  0.05968252 -0.01983395  0.0436777086
## [4,] -0.014444627 -0.02327918 -0.04296475  0.0927777034
## [5,]  0.011764204  0.09376762 -0.07426696 -0.0853085904
## [6,]  0.037351739 -0.03333676 -0.03363874 -0.0002054953
# Excluding constant term and keep only beta in b_hat
b_hat = as.matrix(b_hat[-1,])

#Calculate the covariance of ei and put them in diagonal matrix
diagD_hat = diag(t(E_hat) %*% E_hat)/(120-2) 
diag(diagD_hat) 
##              [,1]        [,2]       [,3]       [,4]        [,5]        [,6]
##  [1,] 0.004526617 0.000000000 0.00000000 0.00000000 0.000000000 0.000000000
##  [2,] 0.000000000 0.002511069 0.00000000 0.00000000 0.000000000 0.000000000
##  [3,] 0.000000000 0.000000000 0.02039461 0.00000000 0.000000000 0.000000000
##  [4,] 0.000000000 0.000000000 0.00000000 0.01140139 0.000000000 0.000000000
##  [5,] 0.000000000 0.000000000 0.00000000 0.00000000 0.006537662 0.000000000
##  [6,] 0.000000000 0.000000000 0.00000000 0.00000000 0.000000000 0.008161795
##  [7,] 0.000000000 0.000000000 0.00000000 0.00000000 0.000000000 0.000000000
##  [8,] 0.000000000 0.000000000 0.00000000 0.00000000 0.000000000 0.000000000
##  [9,] 0.000000000 0.000000000 0.00000000 0.00000000 0.000000000 0.000000000
## [10,] 0.000000000 0.000000000 0.00000000 0.00000000 0.000000000 0.000000000
## [11,] 0.000000000 0.000000000 0.00000000 0.00000000 0.000000000 0.000000000
## [12,] 0.000000000 0.000000000 0.00000000 0.00000000 0.000000000 0.000000000
## [13,] 0.000000000 0.000000000 0.00000000 0.00000000 0.000000000 0.000000000
## [14,] 0.000000000 0.000000000 0.00000000 0.00000000 0.000000000 0.000000000
## [15,] 0.000000000 0.000000000 0.00000000 0.00000000 0.000000000 0.000000000
##             [,7]        [,8]        [,9]       [,10]      [,11]      [,12]
##  [1,] 0.00000000 0.000000000 0.000000000 0.000000000 0.00000000 0.00000000
##  [2,] 0.00000000 0.000000000 0.000000000 0.000000000 0.00000000 0.00000000
##  [3,] 0.00000000 0.000000000 0.000000000 0.000000000 0.00000000 0.00000000
##  [4,] 0.00000000 0.000000000 0.000000000 0.000000000 0.00000000 0.00000000
##  [5,] 0.00000000 0.000000000 0.000000000 0.000000000 0.00000000 0.00000000
##  [6,] 0.00000000 0.000000000 0.000000000 0.000000000 0.00000000 0.00000000
##  [7,] 0.00393017 0.000000000 0.000000000 0.000000000 0.00000000 0.00000000
##  [8,] 0.00000000 0.005930261 0.000000000 0.000000000 0.00000000 0.00000000
##  [9,] 0.00000000 0.000000000 0.002540858 0.000000000 0.00000000 0.00000000
## [10,] 0.00000000 0.000000000 0.000000000 0.004107716 0.00000000 0.00000000
## [11,] 0.00000000 0.000000000 0.000000000 0.000000000 0.01498815 0.00000000
## [12,] 0.00000000 0.000000000 0.000000000 0.000000000 0.00000000 0.01187757
## [13,] 0.00000000 0.000000000 0.000000000 0.000000000 0.00000000 0.00000000
## [14,] 0.00000000 0.000000000 0.000000000 0.000000000 0.00000000 0.00000000
## [15,] 0.00000000 0.000000000 0.000000000 0.000000000 0.00000000 0.00000000
##            [,13]      [,14]       [,15]
##  [1,] 0.00000000 0.00000000 0.000000000
##  [2,] 0.00000000 0.00000000 0.000000000
##  [3,] 0.00000000 0.00000000 0.000000000
##  [4,] 0.00000000 0.00000000 0.000000000
##  [5,] 0.00000000 0.00000000 0.000000000
##  [6,] 0.00000000 0.00000000 0.000000000
##  [7,] 0.00000000 0.00000000 0.000000000
##  [8,] 0.00000000 0.00000000 0.000000000
##  [9,] 0.00000000 0.00000000 0.000000000
## [10,] 0.00000000 0.00000000 0.000000000
## [11,] 0.00000000 0.00000000 0.000000000
## [12,] 0.00000000 0.00000000 0.000000000
## [13,] 0.01121942 0.00000000 0.000000000
## [14,] 0.00000000 0.00464578 0.000000000
## [15,] 0.00000000 0.00000000 0.004133323
# Covariance matrix by single factor model 
cov_sfm <- as.numeric(var(ber_market))*b_hat%*%t(b_hat) + diag(diagD_hat)  #15x15

The Global Minimum Variance Portfolio

#Create the 15x1 matrix with value = 1
one_15 <- rep(1,15)
one_15_1 <- matrix(one_15,ncol=1)

#According to the formula to calculate GMVP, we denote a_sfm as the numerator and b_sfm as the denominator
a_sfm <- inv(cov_sfm)%*%one_15_1 # 15x15 x 15x1 = 15x1
b_sfm <- t(one_15_1)%*%inv(cov_sfm)%*%one_15_1 # 1x1 5x 15x15 x 15x1 = 1x1

#Calculate the GMVP
mvp_sfm <- a_sfm/as.vector(b_sfm)

#Format the table
colnames(mvp_sfm) <- "Weight"
mvp_sfm <- data.frame(mvp_sfm) %>% 
         kbl(format = "html", caption = "GMVP from single index model") %>%
         row_spec(row = 0, bold = TRUE, color = "black", background = "#FF9999") %>%
         kable_styling(bootstrap_options = "striped", full_width = F, position = "center")
mvp_sfm
GMVP from single index model
Weight
CITCRP 0.0443133
CONED 0.3755073
CONTIL 0.0057706
DATGEN -0.0236873
DEC -0.0050185
DELTA 0.0526752
GENMIL 0.1816517
GERBER 0.0428599
IBM 0.1859635
MOBIL 0.0338142
PANAM 0.0075571
PSNH 0.0662851
TANDY -0.0262830
TEXACO 0.0581522
WEYER 0.0004386