Investment Porfolio Analysis – Statistical Models in Finance Project
Rui Yan
5/10/2019
http://www.stat.ucla.edu/~nchristo/statistics_c183_c283/
In this project, I selected 30 stocks plus the market S&P500 from http://finance.yahoo.com. These stocks are from 5 industries classified by https://finance.yahoo.com/industries. I econstructed my portfolios using monthly data from 01-Jan-2011 to 01-Jan-2016 (5 years). For the testing period use monthly data from 01-Jan-2016 to 01-Apr-2019. Data are available for all the stocks for the entire period, 01-Jan-2011 to 01-Apr-2019.
Keywords: single index model, blume’s technique, vasicek’s technique, constant correlation model, multi-index model. optimal portfolio selection, multigroup model, modern porfolio theory, value at risk, time plots, monte carlo simulation of a stock’s path.
# Select 30 stocks and the market S&P500 and store them into my dataset
tickers <- c('VZ', 'T', 'CHL', 'CMCSA', 'AMT',
'JNJ', 'AMGN', 'CVS', 'PFE', 'UNH',
'HSBC', 'JPM', 'V', 'WFC', 'BAC',
'BA', 'UNP', 'HON', 'UPS', 'CAT', 'UTX', 'ADP',
'AAPL', 'MSFT', 'GOOGL', 'ADBE', 'NVDA', 'CRM', 'CSCO', 'INTC',
"^GSPC")
industries <- c(rep("Communication Services", 5),
rep("Healthcare", 5),
rep("Financial Services", 5),
rep("Industrials", 7),
rep("Technology", 8),
"Market")
selected_stocks <- as.data.frame(cbind(tickers, industries))Project 1
Use http://shiny.stat.ucla.edu:3838/c183c283/ Enter the tickers as follows: ^GSPC, AAPL, IBM,….
Download the adjusted close prices for 30 stocks plus the S&P500 in a csv file. Import the data in R and convert the adjusted close prices into returns. (Use the first 5-year data only!)
Compute the means of the 31 assets, the standard deviations, and the variance covariance matrix.
Plot the 31 assets on the space expected return against standard deviation.
Assume equal allocation portfolio using the 30 stocks. Compute the mean and standard deviation of this portfolio and add it on the plot of question (c).
Add on the plot the minimum risk portfolio.
- Trace out the efficient frontier using two different methods:
- Hyperbola.
- Find two portfolios on the efficient frontier first. (CAL).
- Use appropriate value of Rf to find the point of tangency. Draw the tangent line
# Project1-ab ----------------------------------------------------------------------- #
# a. Use http://shiny.stat.ucla.edu:3838/c183c283/ to access the adjusted close prices for
# 30 stocks plus the S&P500. Download the data into a csv file called "stockData.csv".
# b. Read csv file:
a <- read.csv("stockData.csv", sep=",", header=TRUE)
# Convert adjusted close prices into returns:
r <- (a[-1,3:ncol(a)]-a[-nrow(a),3:ncol(a)])/a[-nrow(a),3:ncol(a)]
# Project1-c ------------------------------------------------------------------------ #
# Compute the means, standard deviations, and var-cov matrix of the 31 assets:
means <- apply(r,2,mean)
sd <- apply(r,2,sd)
cov.matrix <- cor(r)
means## VZ T CHL CMCSA AMT
## 0.0093319755 0.0090724501 0.0070208966 0.0201420527 0.0130576224
## JNJ AMGN CVS PFE UNH
## 0.0126456752 0.0216534480 0.0203756841 0.0137628158 0.0204791719
## HSBC JPM V WFC BAC
## 0.0005064216 0.0116508613 0.0290866888 0.0117501864 0.0087573901
## BA UNP HON UPS CAT
## 0.0159869669 0.0128489817 0.0136326664 0.0083634770 -0.0007086269
## UTX ADP AAPL MSFT GOOGL
## 0.0061011959 0.0151309247 0.0215790672 0.0160867764 0.0184805650
## ADBE NVDA IBM CSCO INTC
## 0.0198690188 0.0098760853 0.0001921808 0.0088835079 0.0128861754
## X.GSPC
## 0.0084473474sd## VZ T CHL CMCSA AMT JNJ
## 0.04274620 0.03768540 0.05423058 0.05595188 0.04542071 0.03833770
## AMGN CVS PFE UNH HSBC JPM
## 0.05881357 0.04739146 0.04399932 0.04870634 0.06460092 0.07507889
## V WFC BAC BA UNP HON
## 0.04840750 0.04002083 0.09831284 0.05567965 0.05371292 0.04814253
## UPS CAT UTX ADP AAPL MSFT
## 0.04289694 0.07923216 0.05131197 0.04060298 0.06966311 0.06317520
## GOOGL ADBE NVDA IBM CSCO INTC
## 0.06885569 0.06483222 0.08219029 0.04431197 0.07282718 0.06334474
## X.GSPC
## 0.03401031cov.matrix## VZ T CHL CMCSA AMT
## VZ 1.000000000 0.645546175 0.169401792 0.2088391 0.46910947
## T 0.645546175 1.000000000 0.002001128 0.2549289 0.23085594
## CHL 0.169401792 0.002001128 1.000000000 0.1587540 0.39387873
## CMCSA 0.208839142 0.254928875 0.158753993 1.0000000 0.38073085
## AMT 0.469109470 0.230855935 0.393878727 0.3807308 1.00000000
## JNJ 0.332538629 0.326189394 0.109707712 0.4309770 0.32897188
## AMGN 0.327798582 0.188884606 0.277433402 0.3346466 0.43119151
## CVS 0.298123497 0.267342797 0.105292452 0.2837475 0.25631995
## PFE 0.423200493 0.395200370 0.099349322 0.4784220 0.28666496
## UNH 0.009099424 -0.033379374 0.058129364 0.2196591 -0.11478293
## HSBC 0.059900543 0.111834706 0.395404372 0.5657579 0.26785420
## JPM -0.030641217 0.095455371 0.129318129 0.5365433 0.09712220
## V 0.255010264 0.125029719 0.226024264 0.4711949 0.32675974
## WFC 0.126646319 0.250645547 0.066006186 0.5327815 0.14540969
## BAC -0.129906261 -0.047777963 0.046482137 0.5590676 0.06527955
## BA 0.254408170 0.170633562 0.244024500 0.3752547 0.36309352
## UNP 0.042806637 0.103862530 0.216468094 0.5164266 0.24941818
## HON 0.096339558 0.148271622 0.002133946 0.5854019 0.19879215
## UPS 0.235958835 0.276142709 0.072740247 0.5761039 0.30207493
## CAT -0.044240600 0.131291400 0.133243372 0.5075624 0.25889217
## UTX -0.085036333 0.082189784 0.019341765 0.6024663 0.08559134
## ADP 0.304877898 0.255341847 0.247343371 0.5579234 0.38371936
## AAPL 0.038809567 0.163848105 0.326004932 0.3206549 0.21995975
## MSFT 0.197238400 0.170955617 0.261658533 0.3694767 0.31416440
## GOOGL 0.195486021 0.048038013 0.011539966 0.2591961 0.17606843
## ADBE 0.152233994 0.135822445 0.068709476 0.5890686 0.29061009
## NVDA 0.020726595 -0.003021479 0.105888982 0.2328813 0.26315938
## IBM -0.060361043 0.203946802 0.121102592 0.2758801 -0.07357591
## CSCO -0.086822653 -0.036445341 0.097513525 0.3368803 0.11510986
## INTC 0.092903200 0.163215803 0.079279369 0.3512962 0.34923456
## X.GSPC 0.207937365 0.281077948 0.214318892 0.7126709 0.37516112
## JNJ AMGN CVS PFE UNH HSBC
## VZ 0.3325386 0.327798582 0.2981235 0.42320049 0.009099424 0.05990054
## T 0.3261894 0.188884606 0.2673428 0.39520037 -0.033379374 0.11183471
## CHL 0.1097077 0.277433402 0.1052925 0.09934932 0.058129364 0.39540437
## CMCSA 0.4309770 0.334646620 0.2837475 0.47842199 0.219659065 0.56575786
## AMT 0.3289719 0.431191510 0.2563200 0.28666496 -0.114782932 0.26785420
## JNJ 1.0000000 0.427333992 0.4157276 0.58973311 0.318241597 0.36354363
## AMGN 0.4273340 1.000000000 0.4399219 0.51622989 0.181440255 0.20390230
## CVS 0.4157276 0.439921861 1.0000000 0.53967809 0.565466012 0.28139478
## PFE 0.5897331 0.516229889 0.5396781 1.00000000 0.329590415 0.25427709
## UNH 0.3182416 0.181440255 0.5654660 0.32959042 1.000000000 0.18671201
## HSBC 0.3635436 0.203902295 0.2813948 0.25427709 0.186712007 1.00000000
## JPM 0.3721853 0.198536282 0.3314591 0.45624496 0.362896275 0.60060566
## V 0.2594370 0.465270013 0.4858612 0.41965833 0.254068350 0.32338064
## WFC 0.4028417 0.305866062 0.4511292 0.46824771 0.360576729 0.40470069
## BAC 0.2619450 0.221889275 0.2895891 0.28925890 0.379018771 0.54802987
## BA 0.4689724 0.334010651 0.4546751 0.50703506 0.285479820 0.33759527
## UNP 0.3605890 0.356567660 0.4388037 0.41564479 0.305957573 0.46107529
## HON 0.3668465 0.379706964 0.4655856 0.61693155 0.343568570 0.43120377
## UPS 0.4783983 0.262775136 0.4443351 0.50084981 0.259138006 0.45334798
## CAT 0.1870896 0.127813412 0.2364866 0.31715856 0.172170098 0.53240236
## UTX 0.4173604 0.191746758 0.3751024 0.40717457 0.492086446 0.49105173
## ADP 0.5262285 0.467029093 0.4874007 0.57250886 0.406642945 0.50586792
## AAPL 0.1136842 0.165438892 0.2574776 0.08652603 0.257344926 0.24256640
## MSFT 0.2844833 0.230946791 0.1458719 0.13536337 0.089883420 0.49038706
## GOOGL 0.1113260 0.213226740 0.2588945 0.31181804 -0.091706060 0.21013404
## ADBE 0.3690432 0.288281013 0.3901913 0.47273978 0.343244376 0.49759033
## NVDA 0.2683029 0.108725711 0.2234789 0.14866998 0.159404020 0.32212712
## IBM 0.2482791 -0.007689268 0.1899852 0.24278482 0.087473532 0.41040299
## CSCO 0.1907146 0.141099701 0.2908254 0.17067665 0.222022120 0.47148823
## INTC 0.3715532 0.085915090 0.1236783 0.11537454 0.130873637 0.34445128
## X.GSPC 0.5783989 0.431409422 0.5928764 0.65653486 0.420635548 0.66724454
## JPM V WFC BAC BA UNP
## VZ -0.03064122 0.2550103 0.12664632 -0.12990626 0.2544082 0.04280664
## T 0.09545537 0.1250297 0.25064555 -0.04777796 0.1706336 0.10386253
## CHL 0.12931813 0.2260243 0.06600619 0.04648214 0.2440245 0.21646809
## CMCSA 0.53654328 0.4711949 0.53278154 0.55906756 0.3752547 0.51642659
## AMT 0.09712220 0.3267597 0.14540969 0.06527955 0.3630935 0.24941818
## JNJ 0.37218535 0.2594370 0.40284172 0.26194502 0.4689724 0.36058895
## AMGN 0.19853628 0.4652700 0.30586606 0.22188927 0.3340107 0.35656766
## CVS 0.33145914 0.4858612 0.45112916 0.28958911 0.4546751 0.43880365
## PFE 0.45624496 0.4196583 0.46824771 0.28925890 0.5070351 0.41564479
## UNH 0.36289627 0.2540683 0.36057673 0.37901877 0.2854798 0.30595757
## HSBC 0.60060566 0.3233806 0.40470069 0.54802987 0.3375953 0.46107529
## JPM 1.00000000 0.3658593 0.76356367 0.79430814 0.2844574 0.42267232
## V 0.36585926 1.0000000 0.38136598 0.22532987 0.4763833 0.34449879
## WFC 0.76356367 0.3813660 1.00000000 0.70651849 0.3553491 0.45364025
## BAC 0.79430814 0.2253299 0.70651849 1.00000000 0.1925421 0.36930450
## BA 0.28445743 0.4763833 0.35534914 0.19254207 1.0000000 0.45380358
## UNP 0.42267232 0.3444988 0.45364025 0.36930450 0.4538036 1.00000000
## HON 0.60371572 0.4809066 0.59776229 0.50920477 0.5417210 0.56249266
## UPS 0.54495492 0.5663619 0.57505140 0.42424853 0.4894831 0.56271832
## CAT 0.54087866 0.2701333 0.43101844 0.43956111 0.2352335 0.50889714
## UTX 0.52579908 0.3451347 0.48675614 0.48473751 0.4797187 0.51970605
## ADP 0.51638796 0.4816313 0.41466054 0.33813358 0.5654300 0.63933026
## AAPL 0.27494427 0.1963007 0.40075960 0.26808117 0.2404186 0.12030987
## MSFT 0.49621850 0.2674087 0.48068248 0.44066825 0.1997126 0.31582459
## GOOGL 0.31229916 0.3728947 0.40162625 0.18960210 0.2805062 0.14479965
## ADBE 0.55610645 0.4127313 0.51563473 0.54235800 0.4559196 0.45268143
## NVDA 0.32676906 0.1839510 0.24758272 0.30002949 0.2941791 0.25080280
## IBM 0.42402157 0.1302976 0.34711621 0.22988348 0.1031239 0.22270148
## CSCO 0.52796837 0.3234083 0.48532588 0.40761030 0.3099588 0.36277402
## INTC 0.29009213 0.2029876 0.31398666 0.16195487 0.2752345 0.33663937
## X.GSPC 0.74071243 0.5653665 0.72200198 0.58840909 0.6057122 0.62694340
## HON UPS CAT UTX ADP AAPL
## VZ 0.096339558 0.23595884 -0.0442406 -0.08503633 0.3048779 0.03880957
## T 0.148271622 0.27614271 0.1312914 0.08218978 0.2553418 0.16384811
## CHL 0.002133946 0.07274025 0.1332434 0.01934176 0.2473434 0.32600493
## CMCSA 0.585401853 0.57610393 0.5075624 0.60246634 0.5579234 0.32065488
## AMT 0.198792149 0.30207493 0.2588922 0.08559134 0.3837194 0.21995975
## JNJ 0.366846453 0.47839827 0.1870896 0.41736045 0.5262285 0.11368419
## AMGN 0.379706964 0.26277514 0.1278134 0.19174676 0.4670291 0.16543889
## CVS 0.465585562 0.44433509 0.2364866 0.37510244 0.4874007 0.25747761
## PFE 0.616931552 0.50084981 0.3171586 0.40717457 0.5725089 0.08652603
## UNH 0.343568570 0.25913801 0.1721701 0.49208645 0.4066429 0.25734493
## HSBC 0.431203773 0.45334798 0.5324024 0.49105173 0.5058679 0.24256640
## JPM 0.603715719 0.54495492 0.5408787 0.52579908 0.5163880 0.27494427
## V 0.480906587 0.56636188 0.2701333 0.34513473 0.4816313 0.19630068
## WFC 0.597762286 0.57505140 0.4310184 0.48675614 0.4146605 0.40075960
## BAC 0.509204771 0.42424853 0.4395611 0.48473751 0.3381336 0.26808117
## BA 0.541721019 0.48948309 0.2352335 0.47971866 0.5654300 0.24041863
## UNP 0.562492664 0.56271832 0.5088971 0.51970605 0.6393303 0.12030987
## HON 1.000000000 0.57858581 0.7014991 0.69921181 0.5783183 0.10460283
## UPS 0.578585811 1.00000000 0.4580509 0.44246860 0.6099180 0.18182824
## CAT 0.701499120 0.45805085 1.0000000 0.59423124 0.4142765 0.22583302
## UTX 0.699211808 0.44246860 0.5942312 1.00000000 0.5421548 0.28068866
## ADP 0.578318286 0.60991796 0.4142765 0.54215484 1.0000000 0.37919502
## AAPL 0.104602828 0.18182824 0.2258330 0.28068866 0.3791950 1.00000000
## MSFT 0.218974466 0.43831837 0.4310054 0.23405023 0.3958363 0.27899426
## GOOGL 0.306264720 0.21588867 0.1350756 0.09775086 0.2536729 0.22734583
## ADBE 0.611212241 0.55580786 0.4752331 0.56067677 0.5212705 0.20644694
## NVDA 0.374686201 0.35294341 0.3795266 0.38224585 0.4532064 0.19501321
## IBM 0.284192386 0.19767429 0.2872677 0.32689203 0.1273972 0.24239458
## CSCO 0.421531318 0.37698166 0.4055787 0.52070115 0.4193335 0.30888845
## INTC 0.353974807 0.42020446 0.3678301 0.34801355 0.4434749 0.25829144
## X.GSPC 0.804610977 0.70746515 0.6923883 0.74587329 0.7632183 0.45407979
## MSFT GOOGL ADBE NVDA IBM
## VZ 0.19723840 0.19548602 0.15223399 0.020726595 -0.060361043
## T 0.17095562 0.04803801 0.13582245 -0.003021479 0.203946802
## CHL 0.26165853 0.01153997 0.06870948 0.105888982 0.121102592
## CMCSA 0.36947672 0.25919605 0.58906862 0.232881315 0.275880090
## AMT 0.31416440 0.17606843 0.29061009 0.263159380 -0.073575914
## JNJ 0.28448331 0.11132601 0.36904324 0.268302938 0.248279062
## AMGN 0.23094679 0.21322674 0.28828101 0.108725711 -0.007689268
## CVS 0.14587189 0.25889449 0.39019129 0.223478891 0.189985157
## PFE 0.13536337 0.31181804 0.47273978 0.148669979 0.242784825
## UNH 0.08988342 -0.09170606 0.34324438 0.159404020 0.087473532
## HSBC 0.49038706 0.21013404 0.49759033 0.322127118 0.410402995
## JPM 0.49621850 0.31229916 0.55610645 0.326769058 0.424021571
## V 0.26740869 0.37289472 0.41273133 0.183951011 0.130297635
## WFC 0.48068248 0.40162625 0.51563473 0.247582723 0.347116212
## BAC 0.44066825 0.18960210 0.54235800 0.300029494 0.229883479
## BA 0.19971262 0.28050625 0.45591963 0.294179110 0.103123862
## UNP 0.31582459 0.14479965 0.45268143 0.250802799 0.222701480
## HON 0.21897447 0.30626472 0.61121224 0.374686201 0.284192386
## UPS 0.43831837 0.21588867 0.55580786 0.352943407 0.197674288
## CAT 0.43100542 0.13507562 0.47523315 0.379526646 0.287267688
## UTX 0.23405023 0.09775086 0.56067677 0.382245847 0.326892034
## ADP 0.39583632 0.25367286 0.52127049 0.453206444 0.127397208
## AAPL 0.27899426 0.22734583 0.20644694 0.195013208 0.242394581
## MSFT 1.00000000 0.27100011 0.32437059 0.376678561 0.270539798
## GOOGL 0.27100011 1.00000000 0.23048561 0.161460578 0.150821866
## ADBE 0.32437059 0.23048561 1.00000000 0.566422075 0.193146641
## NVDA 0.37667856 0.16146058 0.56642207 1.000000000 0.076263049
## IBM 0.27053980 0.15082187 0.19314664 0.076263049 1.000000000
## CSCO 0.44232395 0.32107162 0.39322516 0.493366408 0.398227297
## INTC 0.53050849 0.09138480 0.45240733 0.429724011 0.380275635
## X.GSPC 0.50848850 0.44412218 0.69196459 0.491321981 0.422539369
## CSCO INTC X.GSPC
## VZ -0.08682265 0.09290320 0.2079374
## T -0.03644534 0.16321580 0.2810779
## CHL 0.09751353 0.07927937 0.2143189
## CMCSA 0.33688033 0.35129618 0.7126709
## AMT 0.11510986 0.34923456 0.3751611
## JNJ 0.19071459 0.37155316 0.5783989
## AMGN 0.14109970 0.08591509 0.4314094
## CVS 0.29082544 0.12367828 0.5928764
## PFE 0.17067665 0.11537454 0.6565349
## UNH 0.22202212 0.13087364 0.4206355
## HSBC 0.47148823 0.34445128 0.6672445
## JPM 0.52796837 0.29009213 0.7407124
## V 0.32340830 0.20298763 0.5653665
## WFC 0.48532588 0.31398666 0.7220020
## BAC 0.40761030 0.16195487 0.5884091
## BA 0.30995877 0.27523446 0.6057122
## UNP 0.36277402 0.33663937 0.6269434
## HON 0.42153132 0.35397481 0.8046110
## UPS 0.37698166 0.42020446 0.7074652
## CAT 0.40557866 0.36783009 0.6923883
## UTX 0.52070115 0.34801355 0.7458733
## ADP 0.41933347 0.44347490 0.7632183
## AAPL 0.30888845 0.25829144 0.4540798
## MSFT 0.44232395 0.53050849 0.5084885
## GOOGL 0.32107162 0.09138480 0.4441222
## ADBE 0.39322516 0.45240733 0.6919646
## NVDA 0.49336641 0.42972401 0.4913220
## IBM 0.39822730 0.38027563 0.4225394
## CSCO 1.00000000 0.44311164 0.5747744
## INTC 0.44311164 1.00000000 0.4858023
## X.GSPC 0.57477444 0.48580229 1.0000000# Project1-d ------------------------------------------------------------------------ #
# Plot the 31 assets on the space expected return against standard deviation:
plot(sd, means, main="Expected Return vs. Standard Deviation",
xlab="Standard Deviation", ylab="Expected Return",
xlim=c(0.00, 0.11), ylim=c(0,0.030), pch=18, col="blue")
text(sd, means, colnames(a)[3:ncol(a)], cex=0.5, pos=4, col="red")
# Project1-e ------------------------------------------------------------------------ #
# e. Compute equal allocation portfolio using the 30 stocks:
means <- apply(r[-31],2,mean)
sd <- apply(r[-31],2,sd)
cov.matrix <- cov(r[-31])
# Compute the mean and standard deviation of this portfolio:
x_equal <- rep(1/30,30)
Rbar_equal <- t(x_equal)%*%means
sd_equal <- t(x_equal)%*%cov.matrix%*%x_equal
# Add it to above plot:
points(sd_equal, Rbar_equal, pch=18, col="blue")
text(sd_equal, Rbar_equal, "equal allocation portfolio", cex=0.5, pos=4, col="red")
# Project1-f ------------------------------------------------------------------------ #
# Add on the plot the minimum risk portfolio:
ones <- rep(1,30)
x_min <- (solve(cov.matrix)%*%ones) / as.vector((t(ones)%*%solve(cov.matrix)%*%ones))
Rbar_min <- t(x_min)%*%means
sd_min <- t(x_min)%*%cov.matrix%*%x_min
points(sd_min, Rbar_min , pch=18, col="blue")
text(sd_min, Rbar_min, "minimum risk portfolio", cex=0.5, pos=4, col="red")
# Project1-g ------------------------------------------------------------------------ #
# Trace out the efficient frontier using two different methods:
# Method 1. Hyperbola:
# Compute A:
A <- as.numeric(t(ones)%*%solve(cov.matrix)%*%means)
# Compute B:
B <- as.numeric(t(means)%*%solve(cov.matrix)%*%means)
# Compute C:
C <- as.numeric(t(ones)%*%solve(cov.matrix)%*%ones)
# Compute D:
D <- as.numeric(B*C - A^2)
# Efficient frontier:
minvar <- 1/C
sdeff <- seq((minvar)^0.5, 1, by = 0.0001)
y1 <- (A + sqrt(D*(C*sdeff^2 - 1)))*(1/C)
y2 <- (A - sqrt(D*(C*sdeff^2 - 1)))*(1/C)
points(sdeff, y1, type = "l")
points(sdeff, y2, type = "l")
# Method 2. Find two portfolios on the efficient frontier first (CAL):
# Choose two risk free rates:
Rf1 <- 0.005
Rf2 <- 0.01
# Construct the vectors RA and RB:
RA <- means-Rf1
RB <- means-Rf2
# Find the composition of the two portfolios A, B:
zA <- solve(cov.matrix) %*% RA
xA <- zA/sum(zA)
zB <- solve(cov.matrix) %*% RB
xB <- zB/sum(zB)
# Compute the expected return and variance of portfolios A and B.
# Also compute the covariance between portfolio A an B:
RA_bar <- as.numeric(t(xA) %*% means)
RB_bar <- as.numeric(t(xB) %*% means)
var_A <- as.numeric(t(xA) %*% cov.matrix %*% xA)
var_B <- as.numeric(t(xB) %*% cov.matrix %*% xB)
cov_AB <- as.numeric(t(xA) %*% cov.matrix %*% xB)
sd_A <- var_A^.5
sd_B <- var_B^.5
# Find now the portfolio possibilities by mixing the two portfolios A and B
xa <- seq(-3, 5, 0.001)
xb <- 1-xa
# Compute the expected return and standard deviation for each combination of xa, xb:
sigma_p <- (xa^2*var_A + xb^2*var_B+ 2*xa*xb*cov_AB)^.5
rp_bar <- xa*RA_bar + xb*RB_bar
# Plot:
points(sigma_p, rp_bar, col='red', type = "l")
# Project1-h ------------------------------------------------------------------------ #
# Use appropriate value of Rf to find the point of tangency. Draw the tangent line.
# Create the vector R:
Rf <- -1
R <- means-Rf
# Compute the vector Z:
z <- solve(cov.matrix) %*% R
# Compute the vector X:
x <- z/sum(z)
# Compute the expected return of portfolio G:
R_Gbar <- t(x) %*% means
# Compute the variance and standard deviation of portfolio G:
var_G <- t(x) %*% cov.matrix %*% x
sd_G <- var_G^0.5
# Compute the slope:
slope <- (R_Gbar-Rf)/(sd_G)
# We have already two points on the line: (0, 0.002) and (sd_G, R_Gbar)
lines(c(0,sd_G, 1.3*sd_G),c(-1,R_Gbar,-1+slope*(1.3*sd_G)))
# Identify portfolio G:
points(sd_G, R_Gbar, cex=2, col="blue", pch=19)
text(sd_G, R_Gbar, "G", cex=0.8, col='white')
R_Gbar; sd_G## [,1]
## [1,] 0.008243002## [,1]
## [1,] 0.01701701Project 2
Assuming the single index model holds:
Compute estimates for \(\alpha_i\), \(\beta_i\), \({\sigma^2_{\epsilon}}_i\), i = 1, 2, … , 30 by regressing each stock’s return on the S&P500.
Construct the 30 x 30 variance covariance matrix based on the single index model.
Adjust the betas using Blume’s and Vasicek’s techniques. For the Blume technique use the two periods: 01-Jan-2011 to 01-Jan-2016 and 01-Jan-2016 to 01-Apr-2019. For the Vasicek technique use only period 01-Jan-2011 to 01-Jan-2016.
# Read the data
a <- read.csv("stockData.csv", sep=",", header=TRUE)
# Convert adjusted close prices into returns:
r <- (a[-1,3:ncol(a)]-a[-nrow(a),3:ncol(a)])/a[-nrow(a),3:ncol(a)]
# Project2-a ----------------------------------------------------------------------- #
# Compute estimates for alpha, beta, mse by regressing each stock's return on the S&P500
# Read the data in matrix form:
b <- as.matrix(r)
# Initialize the vectors and matrices:
x <- rep(0, 180)
xx <- matrix(x, ncol=6, nrow=30)
stock <- rep(0,30)
alpha <- rep(0,30)
beta <- rep(0,30)
mse <- rep(0,30)
Rbar <- rep(0,30)
Ratio <- rep(0,30)
col1 <- rep(0,30)
col2 <- rep(0,30)
col3 <- rep(0,30)
col4 <- rep(0,30)
col5 <- rep(0,30)
# Risk free rate:
Rf <- 0.001
# Perform regression of each stock on the index and record alpha, beta and mse:
for(i in 1:30) {
alpha[i] <- lm(data=r, formula=r[,i] ~ r[,31])$coefficients[1]
beta[i] <- lm(data=r, formula=r[,i] ~ r[,31])$coefficients[2]
Rbar[i] <- alpha[i] + beta[i] * mean(b[,31])
mse[i] <- sum(lm(data=r, formula=r[,i] ~ r[,31])$residuals^2) / (nrow(b)-2)
Ratio[i] <- (Rbar[i] - Rf) / beta[i]
stock[i] <- i
}
# So far we have this table:
xx <- (cbind(stock, alpha, beta, Rbar, mse, Ratio))
head(xx)## stock alpha beta Rbar mse Ratio
## [1,] 1 0.007124276 0.2613482 0.009331975 0.0017789023 0.03188075
## [2,] 2 0.006441517 0.3114508 0.009072450 0.0013309350 0.02591887
## [3,] 3 0.004134111 0.3417387 0.007020897 0.0028550956 0.01761842
## [4,] 4 0.010237988 1.1724467 0.020142053 0.0015676030 0.01632659
## [5,] 5 0.008825273 0.5010271 0.013057622 0.0018037760 0.02406581
## [6,] 6 0.007138064 0.6519930 0.012645675 0.0009952306 0.01786166# Project2-b ----------------------------------------------------------------------- #
# Construct the 30*30 variance covariance matrix based on the single index model
cov.matrix <- matrix(0, 30, nrow=30)
variance_Rm <- as.numeric(var(r[31]))
for(i in 1:30) {
for(j in 1:30) {
if(i != j) {
cov.matrix[i,j] = beta[i]*beta[j]*variance_Rm
}
if(i == j) {
cov.matrix[i,j] = beta[i]^2*variance_Rm + mse[i]
}
}
}
cov.matrix## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.0018579084 0.0000941521 0.0001033082 0.0003544326 0.0001514613
## [2,] 0.0000941521 0.0014431368 0.0001231132 0.0004223803 0.0001804977
## [3,] 0.0001033082 0.0001231132 0.0029901813 0.0004634558 0.0001980507
## [4,] 0.0003544326 0.0004223803 0.0004634558 0.0031576404 0.0006794780
## [5,] 0.0001514613 0.0001804977 0.0001980507 0.0006794780 0.0020941404
## [6,] 0.0001970986 0.0002348840 0.0002577260 0.0008842136 0.0003778551
## [7,] 0.0002255263 0.0002687615 0.0002948980 0.0010117445 0.0004323534
## [8,] 0.0002497436 0.0002976214 0.0003265645 0.0011203867 0.0004787800
## [9,] 0.0002567638 0.0003059875 0.0003357441 0.0011518804 0.0004922384
## [10,] 0.0001821049 0.0002170158 0.0002381202 0.0008169494 0.0003491108
## [11,] 0.0003831367 0.0004565871 0.0005009892 0.0017188080 0.0007345062
## [12,] 0.0004943079 0.0005890707 0.0006463566 0.0022175385 0.0009476310
## [13,] 0.0002432611 0.0002898963 0.0003180881 0.0010913055 0.0004663526
## [14,] 0.0002568352 0.0003060726 0.0003358375 0.0011522009 0.0004923753
## [15,] 0.0005141853 0.0006127588 0.0006723483 0.0023067115 0.0009857377
## [16,] 0.0002997733 0.0003572422 0.0003919833 0.0013448273 0.0005746912
## [17,] 0.0002993209 0.0003567032 0.0003913918 0.0013427981 0.0005738241
## [18,] 0.0003443063 0.0004103126 0.0004502146 0.0015446090 0.0006600649
## [19,] 0.0002697500 0.0003214632 0.0003527248 0.0012101383 0.0005171340
## [20,] 0.0004876197 0.0005811003 0.0006376111 0.0021875343 0.0009348091
## [21,] 0.0003401840 0.0004054000 0.0004448243 0.0015261157 0.0006521621
## [22,] 0.0002754461 0.0003282514 0.0003601731 0.0012356922 0.0005280540
## [23,] 0.0002811675 0.0003350695 0.0003676543 0.0012613589 0.0005390223
## [24,] 0.0002855340 0.0003402732 0.0003733640 0.0012809479 0.0005473934
## [25,] 0.0002718143 0.0003239233 0.0003554242 0.0012193994 0.0005210916
## [26,] 0.0003987538 0.0004751981 0.0005214101 0.0017888686 0.0007644455
## [27,] 0.0003589358 0.0004277467 0.0004693441 0.0016102392 0.0006881109
## [28,] 0.0001664249 0.0001983299 0.0002176171 0.0007466068 0.0003190509
## [29,] 0.0003720669 0.0004433951 0.0004865143 0.0016691472 0.0007132844
## [30,] 0.0002735270 0.0003259643 0.0003576637 0.0012270826 0.0005243749
## [,6] [,7] [,8] [,9] [,10]
## [1,] 0.0001970986 0.0002255263 0.0002497436 0.0002567638 0.0001821049
## [2,] 0.0002348840 0.0002687615 0.0002976214 0.0003059875 0.0002170158
## [3,] 0.0002577260 0.0002948980 0.0003265645 0.0003357441 0.0002381202
## [4,] 0.0008842136 0.0010117445 0.0011203867 0.0011518804 0.0008169494
## [5,] 0.0003778551 0.0004323534 0.0004787800 0.0004922384 0.0003491108
## [6,] 0.0014869383 0.0005626272 0.0006230426 0.0006405562 0.0004543024
## [7,] 0.0005626272 0.0035084268 0.0007129046 0.0007329442 0.0005198268
## [8,] 0.0006230426 0.0007129046 0.0022715028 0.0008116485 0.0005756464
## [9,] 0.0006405562 0.0007329442 0.0008116485 0.0019552641 0.0005918276
## [10,] 0.0004543024 0.0005198268 0.0005756464 0.0005918276 0.0024065634
## [11,] 0.0009558224 0.0010936815 0.0012111222 0.0012451665 0.0008831108
## [12,] 0.0012331645 0.0014110249 0.0015625422 0.0016064649 0.0011393548
## [13,] 0.0006068707 0.0006944002 0.0007689656 0.0007905811 0.0005607047
## [14,] 0.0006407344 0.0007331481 0.0008118743 0.0008346959 0.0005919923
## [15,] 0.0012827532 0.0014677659 0.0016253761 0.0016710650 0.0011851712
## [16,] 0.0007478532 0.0008557167 0.0009476044 0.0009742414 0.0006909623
## [17,] 0.0007467248 0.0008544256 0.0009461747 0.0009727714 0.0006899197
## [18,] 0.0008589510 0.0009828383 0.0010883764 0.0011189704 0.0007936086
## [19,] 0.0006729532 0.0007700138 0.0008526987 0.0008766678 0.0006217601
## [20,] 0.0012164792 0.0013919331 0.0015414003 0.0015847287 0.0011239389
## [21,] 0.0008486669 0.0009710710 0.0010753455 0.0011055732 0.0007841069
## [22,] 0.0006871636 0.0007862738 0.0008707047 0.0008951800 0.0006348895
## [23,] 0.0007014368 0.0008026056 0.0008887902 0.0009137739 0.0006480769
## [24,] 0.0007123301 0.0008150701 0.0009025932 0.0009279648 0.0006581415
## [25,] 0.0006781032 0.0007759066 0.0008592243 0.0008833769 0.0006265183
## [26,] 0.0009947828 0.0011382613 0.0012604889 0.0012959209 0.0009191074
## [27,] 0.0008954477 0.0010245989 0.0011346214 0.0011665153 0.0008273290
## [28,] 0.0004151851 0.0004750676 0.0005260809 0.0005408689 0.0003836010
## [29,] 0.0009282062 0.0010620822 0.0011761297 0.0012091904 0.0008575954
## [30,] 0.0006823758 0.0007807955 0.0008646381 0.0008889429 0.0006304659
## [,11] [,12] [,13] [,14] [,15]
## [1,] 0.0003831367 0.0004943079 0.0002432611 0.0002568352 0.0005141853
## [2,] 0.0004565871 0.0005890707 0.0002898963 0.0003060726 0.0006127588
## [3,] 0.0005009892 0.0006463566 0.0003180881 0.0003358375 0.0006723483
## [4,] 0.0017188080 0.0022175385 0.0010913055 0.0011522009 0.0023067115
## [5,] 0.0007345062 0.0009476310 0.0004663526 0.0004923753 0.0009857377
## [6,] 0.0009558224 0.0012331645 0.0006068707 0.0006407344 0.0012827532
## [7,] 0.0010936815 0.0014110249 0.0006944002 0.0007331481 0.0014677659
## [8,] 0.0012111222 0.0015625422 0.0007689656 0.0008118743 0.0016253761
## [9,] 0.0012451665 0.0016064649 0.0007905811 0.0008346959 0.0016710650
## [10,] 0.0008831108 0.0011393548 0.0005607047 0.0005919923 0.0011851712
## [11,] 0.0042138971 0.0023971279 0.0011796859 0.0012455129 0.0024935226
## [12,] 0.0023971279 0.0056814748 0.0015219843 0.0016069118 0.0032170448
## [13,] 0.0011796859 0.0015219843 0.0023712554 0.0007908010 0.0015831872
## [14,] 0.0012455129 0.0016069118 0.0007908010 0.0016151187 0.0016715299
## [15,] 0.0024935226 0.0032170448 0.0015831872 0.0016715299 0.0097762739
## [16,] 0.0014537393 0.0018755573 0.0009230081 0.0009745124 0.0019509783
## [17,] 0.0014515459 0.0018727274 0.0009216154 0.0009730420 0.0019480346
## [18,] 0.0016697005 0.0021541819 0.0010601262 0.0011192817 0.0022408072
## [19,] 0.0013081424 0.0016877139 0.0008305657 0.0008769117 0.0017555813
## [20,] 0.0023646937 0.0030508348 0.0015013912 0.0015851696 0.0031735168
## [21,] 0.0016497095 0.0021283904 0.0010474335 0.0011058808 0.0022139784
## [22,] 0.0013357658 0.0017233525 0.0008481044 0.0008954290 0.0017926530
## [23,] 0.0013635112 0.0017591486 0.0008657205 0.0009140281 0.0018298885
## [24,] 0.0013846866 0.0017864682 0.0008791651 0.0009282230 0.0018583067
## [25,] 0.0013181535 0.0017006298 0.0008369220 0.0008836226 0.0017690165
## [26,] 0.0019337417 0.0024948376 0.0012277712 0.0012962814 0.0025951614
## [27,] 0.0017406459 0.0022457129 0.0011051708 0.0011668398 0.0023360188
## [28,] 0.0008070714 0.0010412518 0.0005124257 0.0005410193 0.0010831232
## [29,] 0.0018043246 0.0023278686 0.0011456017 0.0012095268 0.0024214782
## [30,] 0.0013264590 0.0017113453 0.0008421953 0.0008891902 0.0017801629
## [,16] [,17] [,18] [,19] [,20]
## [1,] 0.0002997733 0.0002993209 0.0003443063 0.0002697500 0.0004876197
## [2,] 0.0003572422 0.0003567032 0.0004103126 0.0003214632 0.0005811003
## [3,] 0.0003919833 0.0003913918 0.0004502146 0.0003527248 0.0006376111
## [4,] 0.0013448273 0.0013427981 0.0015446090 0.0012101383 0.0021875343
## [5,] 0.0005746912 0.0005738241 0.0006600649 0.0005171340 0.0009348091
## [6,] 0.0007478532 0.0007467248 0.0008589510 0.0006729532 0.0012164792
## [7,] 0.0008557167 0.0008544256 0.0009828383 0.0007700138 0.0013919331
## [8,] 0.0009476044 0.0009461747 0.0010883764 0.0008526987 0.0015414003
## [9,] 0.0009742414 0.0009727714 0.0011189704 0.0008766678 0.0015847287
## [10,] 0.0006909623 0.0006899197 0.0007936086 0.0006217601 0.0011239389
## [11,] 0.0014537393 0.0014515459 0.0016697005 0.0013081424 0.0023646937
## [12,] 0.0018755573 0.0018727274 0.0021541819 0.0016877139 0.0030508348
## [13,] 0.0009230081 0.0009216154 0.0010601262 0.0008305657 0.0015013912
## [14,] 0.0009745124 0.0009730420 0.0011192817 0.0008769117 0.0015851696
## [15,] 0.0019509783 0.0019480346 0.0022408072 0.0017555813 0.0031735168
## [16,] 0.0031346587 0.0011357164 0.0013064046 0.0010235149 0.0018501802
## [17,] 0.0011357164 0.0029157979 0.0013044335 0.0010219706 0.0018473886
## [18,] 0.0013064046 0.0013044335 0.0023320406 0.0011755638 0.0021250349
## [19,] 0.0010235149 0.0010219706 0.0011755638 0.0018562724 0.0016648784
## [20,] 0.0018501802 0.0018473886 0.0021250349 0.0016648784 0.0063350717
## [21,] 0.0012907633 0.0012888158 0.0014825135 0.0011614890 0.0020995923
## [22,] 0.0010451279 0.0010435510 0.0012003876 0.0009404549 0.0017000348
## [23,] 0.0010668365 0.0010652268 0.0012253210 0.0009599892 0.0017353465
## [24,] 0.0010834045 0.0010817698 0.0012443503 0.0009748979 0.0017622965
## [25,] 0.0010313477 0.0010297916 0.0011845603 0.0009280548 0.0016776196
## [26,] 0.0015129954 0.0015107125 0.0017377594 0.0013614638 0.0024610813
## [27,] 0.0013619136 0.0013598587 0.0015642336 0.0012255134 0.0022153274
## [28,] 0.0006314676 0.0006305148 0.0007252757 0.0005682240 0.0010271632
## [29,] 0.0014117370 0.0014096069 0.0016214585 0.0012703468 0.0022963716
## [30,] 0.0010378461 0.0010362802 0.0011920240 0.0009339023 0.0016881900
## [,21] [,22] [,23] [,24] [,25]
## [1,] 0.0003401840 0.0002754461 0.0002811675 0.0002855340 0.0002718143
## [2,] 0.0004054000 0.0003282514 0.0003350695 0.0003402732 0.0003239233
## [3,] 0.0004448243 0.0003601731 0.0003676543 0.0003733640 0.0003554242
## [4,] 0.0015261157 0.0012356922 0.0012613589 0.0012809479 0.0012193994
## [5,] 0.0006521621 0.0005280540 0.0005390223 0.0005473934 0.0005210916
## [6,] 0.0008486669 0.0006871636 0.0007014368 0.0007123301 0.0006781032
## [7,] 0.0009710710 0.0007862738 0.0008026056 0.0008150701 0.0007759066
## [8,] 0.0010753455 0.0008707047 0.0008887902 0.0009025932 0.0008592243
## [9,] 0.0011055732 0.0008951800 0.0009137739 0.0009279648 0.0008833769
## [10,] 0.0007841069 0.0006348895 0.0006480769 0.0006581415 0.0006265183
## [11,] 0.0016497095 0.0013357658 0.0013635112 0.0013846866 0.0013181535
## [12,] 0.0021283904 0.0017233525 0.0017591486 0.0017864682 0.0017006298
## [13,] 0.0010474335 0.0008481044 0.0008657205 0.0008791651 0.0008369220
## [14,] 0.0011058808 0.0008954290 0.0009140281 0.0009282230 0.0008836226
## [15,] 0.0022139784 0.0017926530 0.0018298885 0.0018583067 0.0017690165
## [16,] 0.0012907633 0.0010451279 0.0010668365 0.0010834045 0.0010313477
## [17,] 0.0012888158 0.0010435510 0.0010652268 0.0010817698 0.0010297916
## [18,] 0.0014825135 0.0012003876 0.0012253210 0.0012443503 0.0011845603
## [19,] 0.0011614890 0.0009404549 0.0009599892 0.0009748979 0.0009280548
## [20,] 0.0020995923 0.0017000348 0.0017353465 0.0017622965 0.0016776196
## [21,] 0.0026534127 0.0011860156 0.0012106505 0.0012294520 0.0011703778
## [22,] 0.0011860156 0.0016606769 0.0009802608 0.0009954843 0.0009476521
## [23,] 0.0012106505 0.0009802608 0.0049205330 0.0010161616 0.0009673359
## [24,] 0.0012294520 0.0009954843 0.0010161616 0.0040430216 0.0009823586
## [25,] 0.0011703778 0.0009476521 0.0009673359 0.0009823586 0.0048078770
## [26,] 0.0017169536 0.0013902132 0.0014190895 0.0014411280 0.0013718830
## [27,] 0.0015455053 0.0012513919 0.0012773848 0.0012972226 0.0012348921
## [28,] 0.0007165921 0.0005802229 0.0005922748 0.0006014729 0.0005725726
## [29,] 0.0016020451 0.0012971721 0.0013241158 0.0013446794 0.0012800686
## [30,] 0.0011777522 0.0009536231 0.0009734309 0.0009885484 0.0009410494
## [,26] [,27] [,28] [,29] [,30]
## [1,] 0.0003987538 0.0003589358 0.0001664249 0.0003720669 0.0002735270
## [2,] 0.0004751981 0.0004277467 0.0001983299 0.0004433951 0.0003259643
## [3,] 0.0005214101 0.0004693441 0.0002176171 0.0004865143 0.0003576637
## [4,] 0.0017888686 0.0016102392 0.0007466068 0.0016691472 0.0012270826
## [5,] 0.0007644455 0.0006881109 0.0003190509 0.0007132844 0.0005243749
## [6,] 0.0009947828 0.0008954477 0.0004151851 0.0009282062 0.0006823758
## [7,] 0.0011382613 0.0010245989 0.0004750676 0.0010620822 0.0007807955
## [8,] 0.0012604889 0.0011346214 0.0005260809 0.0011761297 0.0008646381
## [9,] 0.0012959209 0.0011665153 0.0005408689 0.0012091904 0.0008889429
## [10,] 0.0009191074 0.0008273290 0.0003836010 0.0008575954 0.0006304659
## [11,] 0.0019337417 0.0017406459 0.0008070714 0.0018043246 0.0013264590
## [12,] 0.0024948376 0.0022457129 0.0010412518 0.0023278686 0.0017113453
## [13,] 0.0012277712 0.0011051708 0.0005124257 0.0011456017 0.0008421953
## [14,] 0.0012962814 0.0011668398 0.0005410193 0.0012095268 0.0008891902
## [15,] 0.0025951614 0.0023360188 0.0010831232 0.0024214782 0.0017801629
## [16,] 0.0015129954 0.0013619136 0.0006314676 0.0014117370 0.0010378461
## [17,] 0.0015107125 0.0013598587 0.0006305148 0.0014096069 0.0010362802
## [18,] 0.0017377594 0.0015642336 0.0007252757 0.0016214585 0.0011920240
## [19,] 0.0013614638 0.0012255134 0.0005682240 0.0012703468 0.0009339023
## [20,] 0.0024610813 0.0022153274 0.0010271632 0.0022963716 0.0016881900
## [21,] 0.0017169536 0.0015455053 0.0007165921 0.0016020451 0.0011777522
## [22,] 0.0013902132 0.0012513919 0.0005802229 0.0012971721 0.0009536231
## [23,] 0.0014190895 0.0012773848 0.0005922748 0.0013241158 0.0009734309
## [24,] 0.0014411280 0.0012972226 0.0006014729 0.0013446794 0.0009885484
## [25,] 0.0013718830 0.0012348921 0.0005725726 0.0012800686 0.0009410494
## [26,] 0.0042416494 0.0018115966 0.0008399685 0.0018778709 0.0013805270
## [27,] 0.0018115966 0.0068451486 0.0007560926 0.0016903541 0.0012426730
## [28,] 0.0008399685 0.0007560926 0.0019918487 0.0007837530 0.0005761803
## [29,] 0.0018778709 0.0016903541 0.0007837530 0.0053661076 0.0012881342
## [30,] 0.0013805270 0.0012426730 0.0005761803 0.0012881342 0.0040663385# Project2-c ----------------------------------------------------------------------- #
# Adjust the betas using Vasicek's and Blume's techniques
# Period 2: 01-Jan-2016 to 01-Apr-2019
# Read the data
a2 <- read.csv("stockData_period2.csv", sep=",", header=TRUE)
# Convert adjusted close prices into returns:
r2 <- (a2[-1,3:ncol(a2)]-a2[-nrow(a2),3:ncol(a2)])/a2[-nrow(a2),3:ncol(a2)]
# Initialize the vectors and matrices.
# Period 1:
beta1 <- rep(0,30)
var_beta1 <- rep(0,30)
beta_adj1 <- rep(0,30)
# Perform regression of each stock on the index and record beta and the
# variance of beta in period 1:
for(i in 1:30){
q <- lm(data=r, formula=r[,i] ~ r[,31])
beta1[i] <- q$coefficients[2]
var_beta1[i] <- vcov(q)[2,2]
}
# Vasicek's method: using period from 01-Jan-2011 to 01-Jan-2016
for(i in 1:30){
beta_adj1[i] <- var_beta1[i]*mean(beta1)/(var(beta1)+var_beta1[i]) +
var(beta1)*beta1[i]/(var(beta1)+var_beta1[i])
}
# Compute betas for period 2:
beta2 <- rep(0,30)
for(i in 1:30) {
q <- lm(data=r2, formula=r2[,i] ~ r2[,31])
beta2[i] <- q$coefficients[2]
}
#Compare:
betas <- as.data.frame(cbind(beta1, beta2, beta_adj1))
head(betas)## beta1 beta2 beta_adj1
## 1 0.2613482 0.4833458 0.3730601
## 2 0.3114508 0.7917158 0.3922011
## 3 0.3417387 0.6679200 0.4854019
## 4 1.1724467 1.0676415 1.1377263
## 5 0.5010271 0.3930201 0.5740303
## 6 0.6519930 0.6294794 0.6805010# Blume's method: two periods from 01-Jan-2011 to 01-Jan-2016 and 01-Jan-2016 to 01-Apr-2019
# Forecast of betas in period 3 from 01-May-2019 to 01-Apr-2023:
blume <- lm(betas$beta2 ~ betas$beta1)
beta3 <- as.data.frame(blume$coefficients[1] + blume$coefficients[2]*beta2)
head(beta3)## blume$coefficients[1] + blume$coefficients[2] * beta2
## 1 0.8116825
## 2 0.9523375
## 3 0.8958713
## 4 1.0781939
## 5 0.7704828
## 6 0.8783376# Compute PRESS for Vasicek's method
press.lm <- lm(betas$beta2 ~ betas$beta_adj1)
PRESS <- (mean(beta2)-mean(beta_adj1))^2 + (1-press.lm$coefficients[[2]])*var(beta_adj1) +
(1-summary(press.lm)$r.squared)*var(beta2)
PRESS## [1] 0.1753539Project 3
Please answer the following questions assuming the single index model holds:
Use only the stocks with positive betas in your data. Rank the stocks based on the excess return to beta ratio and complete the entire table based on handout #32: http://www.stat.ucla.edu/~nchristo/statistics_c183_c283/statc183c283_index_steps.pdf. Note: Please use the same Rf as the one in Project 1 if possible.
Find the composition of the point of tangency with and without short sales allowed. Place the two portfolios on the plot with the 30 stocks, S&P500, and the efficient frontier that you constructed in project 1.
We want now to draw the efficient frontier when short sale are not allowed. One way to this is to use a for loop where you vary Rf. For each Rf you find the composition of the optimal portfolio (tangency point) and its expected return and standard deviation. Finally connect the points to draw the efficient frontier.
# -------------------------------- Project3-a -------------------------------- #
# a. Use only the stocks with positive betas in your data. Rank the stocks based on the
# excess return to beta ratio and complete the entire table based on handout #32:
SIM <- function(Rf, r) {
# Function description SIM(Rf, r)
# input: the risk free return Rf and the data of all the stocks and market
# output: the entire table based on handout #32
# Read the data in matrix form:
b <- as.matrix(r)
n <- ncol(r) - 1
# Initialize the vectors and matrices:
x <- rep(0, 6*n)
xx <- matrix(x, ncol=6, nrow=n)
stock <- rep(0,n)
alpha <- rep(0,n)
beta <- rep(0,n)
mse <- rep(0,n)
Rbar <- rep(0,n)
Ratio <- rep(0,n)
col1 <- rep(0,n)
col2 <- rep(0,n)
col3 <- rep(0,n)
col4 <- rep(0,n)
col5 <- rep(0,n)
# Perform regression of each stock on the index and record alpha, beta and mse:
for(i in 1:n) {
alpha[i] <- lm(data=r, formula=r[,i] ~ r[,n+1])$coefficients[1]
beta[i] <- lm(data=r, formula=r[,i] ~ r[,n+1])$coefficients[2]
Rbar[i] <- alpha[i] + beta[i] * mean(b[,n+1])
mse[i] <- sum(lm(data=r, formula=r[,i] ~ r[,n+1])$residuals^2) / (nrow(b)-2)
Ratio[i] <- (Rbar[i] - Rf) / beta[i]
stock[i] <- colnames(r)[i]
}
# So far we have this table:
xx <- data.frame(stock, alpha, beta, Rbar, mse, Ratio)
# only keep the stocks that have positive beta in my data.
xx <- xx[xx[["beta"]] > 0,]
# update the number of stocks n
n <- nrow(xx)
# Rank the stocks based on the excess return to beta ratio
aaa <- xx[order(-Ratio),]
# Create the last 5 columns of the table
col1 <- (aaa[,4]-Rf)*aaa[,3]/aaa[,5]
col3 <- aaa[,3]^2/aaa[,5]
for(i in(1:n)) {
col2[i] <- sum(col1[1:i])
col4[i] <- sum(col3[1:i])
}
for(i in (1:n)) {
col5[i] <- var(r[,n+1])*col2[i]/(1+var(r[,n+1])*col4[i])
}
# The entire table in handout#32 for single index model SIM
xxx <- data.frame(aaa, col1, col2, col3, col4, col5)
return(xxx)
}
# ------------------------- helper functions for Project3-b ------------------------- #
# b. Find the composition of the point of tangency with and without short sales allowed.
# --- Short sales allowed --- #
optimal_portfolio_short <- function(Rf, r) {
# Function description optimal_portfolio_short(Rf, r)
# input: the risk free return Rf and the data of all the stocks and market
# output: the composition of the point of tangency with short sales allowed
xxx <- SIM(Rf, r)
col5 <- xxx[["col5"]]
C_star_short <- col5[nrow(xxx)] # C_star is the last element of the sorted table
# Find the point of tangency
# Compute the zi:
z_short <- (xxx[,3]/xxx[,5])*(xxx[,6]-C_star_short)
# Compute the xi:
x_short <- z_short/sum(z_short)
# The final table when short sales allowed:
table_short <- data.frame(xxx, z_short, x_short)
N_stocks <- nrow(table_short)
# Find the mean and cov.matrix of these stocks returns based on SIM
beta <- table_short[["beta"]]
mean_market <- mean(r[,ncol(r)])
var_market <- var(r[,ncol(r)])
# means
means <- table_short[["Rbar"]]
# cov.matrix
cov.matrix <- matrix(rep(0,N_stocks^2), nrow=N_stocks)
for(i in 1:N_stocks) {
for(j in 1:N_stocks) {
if (i == j) {
cov.matrix[i,j] <- beta[i]^2*var_market + table_short[["mse"]][i]
} else {
cov.matrix[i,j] <- beta[i]*beta[j]*var_market
}
}
}
# Compute the variance and standard deviation of portfolio G:
var_G_short <- t(x_short) %*% cov.matrix %*% x_short
sd_G_short <- var_G_short^0.5
R_Gbar_short <- t(x_short) %*% means
G_short <- list(sd_G_short, R_Gbar_short)
return(G_short)
}
# --- Short sales not allowed --- #
optimal_portfolio_no_short <- function(Rf, r) {
# Function description optimal_portfolio_no_short(Rf, r)
# input: the risk free return Rf and the data of all the stocks and market
# output: the composition of the point of tangency without short sales allowed
xxx <- SIM(Rf, r)
col5 <- xxx[["col5"]]
C_star_no_short <- max(col5)
xxx_no_short <- xxx[1:which(col5==max(col5)), ]
# Compute the zi:
z_no_short <- (xxx_no_short[,3]/xxx_no_short[,5])*(xxx_no_short[,6]-C_star_no_short)
# Compute the xi:
x_no_short <- z_no_short/sum(z_no_short)
# The final table when short sales are not allowed:
table_no_short <- data.frame(xxx_no_short, z_no_short, x_no_short)
N_stocks <- nrow(table_no_short)
# Find the mean and cov.matrix of these stocks returns based on SIM
beta <- table_no_short[["beta"]]
mean_market <- mean(r[,ncol(r)])
var_market <- var(r[,ncol(r)])
# means
means <- table_no_short[["Rbar"]]
# cov.matrix
cov.matrix <- matrix(rep(0,N_stocks^2), nrow=N_stocks)
for(i in 1:N_stocks) {
for(j in 1:N_stocks) {
if (i == j) {
cov.matrix[i,j] <- beta[i]^2*var_market + table_no_short[["mse"]][i]
} else {
cov.matrix[i,j] <- beta[i]*beta[j]*var_market
}
}
}
# Compute the variance and standard deviation of portfolio G:
R_Gbar_no_short <- t(x_no_short) %*% means
var_G_no_short <- t(x_no_short) %*% cov.matrix %*% x_no_short
sd_G_no_short <- var_G_no_short^0.5
G_no_short <- list(sd_G_no_short, R_Gbar_no_short)
return(G_no_short)
}
# ----------------------------------- Main Script --------------------------------- #
# Read the data
a <- read.csv("stockData.csv", sep=",", header=TRUE)
# Convert adjusted close prices into returns:
stock_returns <- (a[-1,3:ncol(a)]-a[-nrow(a),3:ncol(a)])/a[-nrow(a),3:ncol(a)]
# risk free return
Rf = -1
# **** Project3-a **** # written as a function above
# Use only the stocks with positive betas in your data. Rank the stocks based on the
# excess return to beta ratio and complete the entire table based on handout #32:
table <- SIM(Rf, r=stock_returns)
table## stock alpha beta Rbar mse Ratio
## 1 VZ 0.0071242765 0.2613482 0.0093319755 0.0017789023 3.8620201
## 2 T 0.0064415174 0.3114508 0.0090724501 0.0013309350 3.2399101
## 3 CHL 0.0041341113 0.3417387 0.0070208966 0.0028550956 2.9467572
## 5 AMT 0.0088252727 0.5010271 0.0130576224 0.0018037760 2.0219619
## 28 IBM -0.0044583021 0.5505258 0.0001921808 0.0016412773 1.8167943
## 10 UNH 0.0153905368 0.6023944 0.0204791719 0.0019868209 1.6940382
## 6 JNJ 0.0071380635 0.6519930 0.0126456752 0.0009952306 1.5531541
## 7 AMGN 0.0153514684 0.7460306 0.0216534480 0.0028646514 1.3694525
## 13 V 0.0222891378 0.8046965 0.0290866888 0.0016222494 1.2788507
## 8 CVS 0.0133969916 0.8261401 0.0203756841 0.0014820458 1.2351122
## 9 PFE 0.0065879540 0.8493627 0.0137628158 0.0011208004 1.1935570
## 14 WFC 0.0045733287 0.8495990 0.0117501864 0.0007801907 1.1908562
## 25 GOOGL 0.0108851397 0.8991491 0.0184805650 0.0038727199 1.1327159
## 19 UPS 0.0008257373 0.8923203 0.0083634770 0.0009352660 1.1300465
## 30 INTC 0.0052428924 0.9048146 0.0128861754 0.0031193597 1.1194406
## 22 ADP 0.0074340143 0.9111630 0.0151309247 0.0007003629 1.1141047
## 23 AAPL 0.0137222831 0.9300889 0.0215790672 0.0039199111 1.0983671
## 24 MSFT 0.0081079762 0.9445332 0.0160867764 0.0030110789 1.0757555
## 16 BA 0.0076102731 0.9916360 0.0159869669 0.0019972261 1.0245564
## 17 UNP 0.0044849269 0.9901398 0.0128489817 0.0017817951 1.0229353
## 21 UTX -0.0034047116 1.1253127 0.0061011959 0.0011886490 0.8940636
## 18 HON 0.0040115674 1.1389491 0.0136326664 0.0008315622 0.8899719
## 4 CMCSA 0.0102379878 1.1724467 0.0201420527 0.0015676030 0.8700967
## 27 NVDA -0.0001538129 1.1873429 0.0098760853 0.0052144509 0.8505345
## 29 CSCO -0.0015133179 1.2307799 0.0088835079 0.0036139146 0.8197107
## 11 HSBC -0.0101997329 1.2673984 0.0005064216 0.0023558899 0.7894175
## 26 ADBE 0.0087264692 1.3190590 0.0198690188 0.0022290862 0.7731792
## 20 CAT -0.0143343952 1.6130233 -0.0007086269 0.0033255160 0.6195145
## 12 JPM -0.0021617983 1.6351476 0.0116508613 0.0025887946 0.6186909
## 15 BAC -0.0056107122 1.7009011 0.0087573901 0.0064298634 0.5930723
## col1 col2 col3 col4 col5
## 1 148.2864 148.2864 38.39608 38.39608 0.1642292
## 2 236.1320 384.4185 72.88228 111.27836 0.3939497
## 3 120.5347 504.9531 40.90417 152.18253 0.4966539
## 5 281.3926 786.3458 139.16813 291.35066 0.6803015
## 28 335.4897 1121.8355 184.66026 476.01092 0.8368543
## 10 309.4043 1431.2398 182.64306 658.65398 0.9396383
## 6 663.4020 2094.6418 427.13208 1085.78606 1.0740025
## 7 266.0654 2360.7072 194.28599 1280.07205 1.1007682
## 13 510.4656 2871.1728 399.15964 1679.23169 1.1287124
## 8 568.7903 3439.9631 460.51714 2139.74883 1.1450221
## 9 768.2477 4208.2108 643.66234 2783.41117 1.1535859
## 14 1101.7588 5309.9696 925.18205 3708.59322 1.1611260
## 25 236.4658 5546.4354 208.76005 3917.35327 1.1598857
## 19 962.0613 6508.4967 851.34660 4768.69987 1.1553761
## 30 293.8020 6802.2987 262.45431 5031.15418 1.1537764
## 22 1320.6720 8122.9707 1185.41109 6216.56527 1.1471352
## 23 242.3931 8365.3638 220.68494 6437.25021 1.1456612
## 24 318.7322 8684.0960 296.28682 6733.53703 1.1429352
## 16 504.4443 9188.5402 492.35385 7225.89087 1.1357311
## 17 562.8380 9751.3783 550.21858 7776.10945 1.1285485
## 21 952.4918 10703.8701 1065.35126 8841.46071 1.1028109
## 18 1388.3219 12092.1920 1559.96160 10401.42231 1.0733398
## 4 762.9880 12855.1800 876.90019 11278.32249 1.0586625
## 27 229.9512 13085.1312 270.36082 11548.68331 1.0541294
## 29 343.5924 13428.7236 419.16300 11967.84631 1.0464723
## 11 538.2426 13966.9661 681.82247 12649.66878 1.0335033
## 26 603.5062 14570.4724 780.55153 13430.22032 1.0192885
## 20 484.7008 15055.1732 782.38811 14212.60843 0.9985433
## 12 638.9840 15694.1572 1032.80017 15245.40860 0.9741911
## 15 266.8481 15961.0053 449.94182 15695.35042 0.9638359# **** Project3-b **** #
# Place the two portfolios on the plot with the 30 stocks and S&P500:
# Find the mean and cov.matrix of these stocks to trace out efficient frontier
means <- apply(stock_returns,2,mean)
sd <- apply(stock_returns,2,sd)
cov.matrix <- cov(stock_returns)
# --- Plot of the 30 stocks and the market --- #
plot(sd, means, main="Expected Return vs. Standard Deviation",
xlab="Standard Deviation", ylab="Expected Return",
xlim=c(0.00, 0.11), ylim=c(0,0.030), pch=18, col="blue")
text(sd, means, colnames(a)[3:ncol(a)], cex=0.5, pos=4, col="red")
# --- Plot of the efficient frontier using method1 - hyperbola --- #
# Compute A:
ones <- rep(1,31)
A <- as.numeric(t(ones)%*%solve(cov.matrix)%*%means)
# Compute B:
B <- as.numeric(t(means)%*%solve(cov.matrix)%*%means)
# Compute C:
C <- as.numeric(t(ones)%*%solve(cov.matrix)%*%ones)
# Compute D:
D <- as.numeric(B*C - A^2)
# Efficient frontier:
minvar <- 1/C
sdeff <- seq((minvar)^0.5, 1, by = 0.0001)
y1 <- (A + sqrt(D*(C*sdeff^2 - 1)))*(1/C)
y2 <- (A - sqrt(D*(C*sdeff^2 - 1)))*(1/C)
points(sdeff, y1, type = "l")
points(sdeff, y2, type = "l")
# --- Plot of the portfolio G with short sales allowed --- #
G_short <- optimal_portfolio_short(Rf=Rf, r=stock_returns)
sd_G_short <- G_short[[1]]
R_Gbar_short <- G_short[[2]]
# Find the composition of the point of tangency with short sales allowed
sd_G_short; R_Gbar_short # 0.01907851; 0.01339323 ## [,1]
## [1,] 0.01907851## [,1]
## [1,] 0.01339323# Identify portfolio G:
points(sd_G_short, R_Gbar_short, cex=2, col="blue", pch=19)
text(sd_G_short, R_Gbar_short + 0.0005, "G_short", cex=0.8, col='black')
# --- Plot of the portfolio G with short sales not allowed --- #
G_no_short <- optimal_portfolio_no_short(Rf=Rf, r=stock_returns)
sd_G_no_short <- G_no_short[[1]]
R_Gbar_no_short <- G_no_short[[2]]
# Find the composition of the point of tangency without short sales allowed
sd_G_no_short; R_Gbar_no_short # 0.02150784; 0.01087753## [,1]
## [1,] 0.02150784## [,1]
## [1,] 0.01087753# Identify portfolio G:
points(sd_G_no_short, R_Gbar_no_short, cex=2, col="blue", pch=19)
text(sd_G_no_short, R_Gbar_no_short + 0.0005, "G_no_short", cex=0.8, col='black')
# **** Project3-c **** #
# Draw the efficient frontier when short sales are not allowed.
# Try different Rfs and find the point of tangency for each Rf.
sd_no_shorts <- rep(0.0, 202)
return_no_shorts <- rep(0.0, 202)
i = 1
for (rfs in seq(-1, 0.01, 0.005)) {
G_no_shorts <- optimal_portfolio_no_short(Rf=rfs, r=stock_returns)
sd_no_shorts[i] <- G_no_shorts[[1]]
return_no_shorts[i] <- G_no_shorts[[2]]
i = i + 1
}
# Connect the points to draw the efficient frontier.
points(sd_no_shorts, return_no_shorts, type='l', col='red')
Project 4
Please answer the following questions assuming the constant correlation model holds:
Rank the stocks based on the excess return to standard deviation ratio and complete the entire table based on handout #39: http://www.stat.ucla.edu/~nchristo/statistics_c183_c283/statc183c283_rho_steps.pdf . Note: Please use the same Rf as the one in Project 1 if possible.
Find the composition of the point of tangency with and without short sales allowed. Place the two portfolios on the plot with the 30 stocks, S&P500, and the efficient frontier that you constructed in the previous projects.
Assume the multigroup model holds with short sales allowed. Find the composition of the optimal portfolio and place it on the plot of part (b). Note: Please see the numerical example of handout #50 here for more details: http://www.stat.ucla.edu/~nchristo/statistics_c183_c283/statc183c283_multigroup_model.pdf .
# Read the data
a <- read.csv("stockData.csv", sep=",", header=TRUE)
# Convert adjusted close prices into returns:
stock_returns <- (a[-1,3:ncol(a)]-a[-nrow(a),3:ncol(a)])/a[-nrow(a),3:ncol(a)]
# Define risk free return
Rf = -1
# Define the number of stocks
N_stocks <- ncol(stock_returns)-1
# =============================== Project4-a =============================== #
## Rank the stocks based on the excess return to sd ratio and complete the handout #39
# Compute the average correlation:
rho <- (sum(cor(stock_returns[1:N_stocks]))-N_stocks) / (N_stocks*(N_stocks-1))
# Initialize the vectors:
col1 <- rep(0,N_stocks)
col2 <- rep(0,N_stocks)
col3 <- rep(0,N_stocks)
# Initialize the var-covar matrix:
y <- rep(0,N_stocks^2)
mat <- matrix(y, ncol=N_stocks, nrow=N_stocks)
# Compute necessary quantities:
Rbar <- colMeans(stock_returns[1:N_stocks])
Rbar_f <- Rbar-Rf
sigma <- (diag(var(stock_returns[,1:N_stocks])))^.5
Ratio <- Rbar_f/sigma
# Initial table:
xx <- data.frame(Rbar, Rbar_f, sigma, Ratio)
# Order the table based on the excess return to sigma ratio:
aaa <- xx[order(-Ratio),]
# Create the last 3 columns of the table:
for(i in(1:N_stocks)) {
col1[i] <- rho/(1-rho+i*rho)
col2[i] <- sum(aaa[,4][1:i])
}
# Compute the Ci:
for(i in (1:N_stocks)) {
col3[i] <- col1[i]*col2[i]
}
# Create the entire table based on handout #39:
table <- data.frame(aaa, col1, col2, col3)
table## Rbar Rbar_f sigma Ratio col1 col2
## T 0.0090724501 1.0090725 0.03768540 26.77621 0.31398358 26.77621
## JNJ 0.0126456752 1.0126457 0.03833770 26.41384 0.23895548 53.19005
## WFC 0.0117501864 1.0117502 0.04002083 25.28059 0.19286850 78.47064
## ADP 0.0151309247 1.0151309 0.04060298 25.00139 0.16168463 103.47203
## VZ 0.0093319755 1.0093320 0.04274620 23.61220 0.13918117 127.08423
## UPS 0.0083634770 1.0083635 0.04289694 23.50665 0.12217650 150.59089
## PFE 0.0137628158 1.0137628 0.04399932 23.04042 0.10887459 173.63131
## IBM 0.0001921808 1.0001922 0.04431197 22.57160 0.09818476 196.20291
## AMT 0.0130576224 1.0130576 0.04542071 22.30387 0.08940641 218.50678
## CVS 0.0203756841 1.0203757 0.04739146 21.53079 0.08206893 240.03757
## V 0.0290866888 1.0290867 0.04840750 21.25883 0.07584445 261.29640
## HON 0.0136326664 1.0136327 0.04814253 21.05483 0.07049760 282.35123
## UNH 0.0204791719 1.0204792 0.04870634 20.95167 0.06585498 303.30290
## UTX 0.0061011959 1.0061012 0.05131197 19.60753 0.06178606 322.91043
## UNP 0.0128489817 1.0128490 0.05371292 18.85671 0.05819069 341.76714
## CHL 0.0070208966 1.0070209 0.05423058 18.56925 0.05499074 360.33639
## BA 0.0159869669 1.0159870 0.05567965 18.24701 0.05212438 378.58339
## CMCSA 0.0201420527 1.0201421 0.05595188 18.23249 0.04954203 396.81588
## AMGN 0.0216534480 1.0216534 0.05881357 17.37105 0.04720348 414.18693
## MSFT 0.0160867764 1.0160868 0.06317520 16.08363 0.04507575 430.27057
## INTC 0.0128861754 1.0128862 0.06334474 15.99006 0.04313156 446.26063
## ADBE 0.0198690188 1.0198690 0.06483222 15.73090 0.04134815 461.99152
## HSBC 0.0005064216 1.0005064 0.06460092 15.48750 0.03970636 477.47902
## GOOGL 0.0184805650 1.0184806 0.06885569 14.79152 0.03818998 492.27054
## AAPL 0.0215790672 1.0215791 0.06966311 14.66456 0.03678515 506.93511
## CSCO 0.0088835079 1.0088835 0.07282718 13.85312 0.03548002 520.78822
## JPM 0.0116508613 1.0116509 0.07507889 13.47450 0.03426432 534.26273
## CAT -0.0007086269 0.9992914 0.07923216 12.61219 0.03312917 546.87492
## NVDA 0.0098760853 1.0098761 0.08219029 12.28705 0.03206682 559.16197
## BAC 0.0087573901 1.0087574 0.09831284 10.26069 0.03107049 569.42266
## col3
## T 8.407292
## JNJ 12.710054
## WFC 15.134514
## ADP 16.729836
## VZ 17.687732
## UPS 18.398668
## PFE 18.904037
## IBM 19.264136
## AMT 19.535908
## CVS 19.699626
## V 19.817883
## HON 19.905084
## UNH 19.974007
## UTX 19.951364
## UNP 19.887665
## CHL 19.815165
## BA 19.733425
## CMCSA 19.659066
## AMGN 19.551064
## MSFT 19.394766
## INTC 19.247916
## ADBE 19.102494
## HSBC 18.958956
## GOOGL 18.799801
## AAPL 18.647686
## CSCO 18.477575
## JPM 18.306148
## CAT 18.117512
## NVDA 17.930547
## BAC 17.692241# =============================== Project4-b =============================== #
## Plot the 30 stocks, S&P500 and the efficient frontier constructed in project 3.
# Find the mean and cov.matrix of these stocks to trace out efficient frontier
means <- apply(stock_returns,2,mean)
sd <- apply(stock_returns,2,sd)
cov.matrix <- cov(stock_returns)
# --- Plot of the 30 stocks and the market constructed in project 1 --- #
plot(sd, means, main="Expected Return vs. Standard Deviation",
xlab="Standard Deviation", ylab="Expected Return",
xlim=c(0.00, 0.11), ylim=c(0,0.030), pch=18, col="blue")
text(sd, means, colnames(a)[3:ncol(a)], cex=0.5, pos=4, col="red")
# --- Plot of the efficient frontier using method1 in project 1- hyperbola --- #
# Compute A:
ones <- rep(1,31)
A <- as.numeric(t(ones)%*%solve(cov.matrix)%*%means)
# Compute B:
B <- as.numeric(t(means)%*%solve(cov.matrix)%*%means)
# Compute C:
C <- as.numeric(t(ones)%*%solve(cov.matrix)%*%ones)
# Compute D:
D <- as.numeric(B*C - A^2)
# Efficient frontier:
minvar <- 1/C
sdeff <- seq((minvar)^0.5, 1, by = 0.0001)
y1 <- (A + sqrt(D*(C*sdeff^2 - 1)))*(1/C)
y2 <- (A - sqrt(D*(C*sdeff^2 - 1)))*(1/C)
points(sdeff, y1, type = "l")
points(sdeff, y2, type = "l")
# --- Plot of the efficient frontier using method1 in project 3--- #
# Draw the efficient frontier when short sales are not allowed.
# Try different Rfs and find the point of tangency for each Rf.
sd_no_shorts <- rep(0.0, 202)
return_no_shorts <- rep(0.0, 202)
i = 1
for (rfs in seq(-1, 0.01, 0.005)) {
G_no_shorts <- optimal_portfolio_no_short(Rf=rfs, r=stock_returns)
sd_no_shorts[i] <- G_no_shorts[[1]]
return_no_shorts[i] <- G_no_shorts[[2]]
i = i + 1
}
# Connect the points to draw the efficient frontier.
points(sd_no_shorts, return_no_shorts, type='l', col='red')
## Find the composition of the point of tangency with and without short sales
# --- Short sales allowed --- #
# Compute the zi:
z_short <- (1/((1-rho)*table[,3]))*(table[,4]-table[,7][nrow(table)])
# Compute the xi:
x_short <- z_short/sum(z_short)
# The final table:
table_short <- data.frame(table, z_short, x_short)
# Find the cov.matrix of stocks based on constant correlation model:
for(i in 1:N_stocks) {
for(j in 1:N_stocks) {
if(i==j) {
mat[i,j]=table_short[i,3]^2
} else {
mat[i,j]=rho*table_short[i,3]*table_short[j,3]
}
}
}
# Calculate the expected return and sd of the point of tangency
sd_G_short <- (t(x_short) %*% mat %*% x_short)^.5
R_Gbar_short <- t(x_short) %*% table_short[,1]
sd_G_short; R_Gbar_short## [,1]
## [1,] 0.02303598## [,1]
## [1,] 0.01294625# --- Short sales not allowed --- #
table_no_short <- table_short[1:which(table_short[,7]==max(table_short[,7])), ]
# Compute the zi:
z_no_short <- (1/((1-rho)*table_no_short[,3]))*(table_no_short[,4]-
table_no_short[,7][nrow(table_no_short)])
# Compute the xi:
x_no_short <- z_no_short/sum(z_no_short)
# Final table:
table_no_short <- data.frame(table_no_short, z_no_short, x_no_short)
# Calculate the expected return and sd of the point of tangency
N_kept_stocks <- which(table_short[,7]==max(table_short[,7]))
mat_no_short <- mat[1:N_kept_stocks, 1:N_kept_stocks]
sd_G_no_short <- (t(x_no_short) %*% mat_no_short %*% x_no_short)^.5
R_Gbar_no_short <- t(x_no_short) %*% table_no_short[,1]
sd_G_no_short; R_Gbar_no_short## [,1]
## [1,] 0.02566421## [,1]
## [1,] 0.01183722## Add the points of tangency G based on constant correlation model on the plot
points(sd_G_short,R_Gbar_short, col="green", pch=19)
text(sd_G_short,R_Gbar_short, "G_short", cex=0.5, col="black")
points(sd_G_no_short,R_Gbar_no_short, col="green", pch=19)
text(sd_G_no_short,R_Gbar_no_short, "G_no_short", cex=0.5, col="black")
# =============================== Project4-c =============================== #
## Assume the multigroup model holds with short sales allowed.
## Find the composition of the optimal portfolio and place it on the plot of part (b).
# Define the range of column indices of stocks in industry 1,2,3,4,5
stocks_cols <- matrix(c(1,5, 6,10, 11,15, 16,22, 23,30),5,2,byrow=TRUE)
# Define the number of stocks in each industry
N_stocks_g <- c(5,5,5,7,8)
# Compute the correlation matrix cormat
cormat <- cor(stock_returns)
# Compute the average correlation: 5 by 5 matrix
rho <- matrix(rep(0,25),5,5,byrow=TRUE)
for (i in (1:5)) {
for (j in (1:5)) {
cormat_g <- cormat[stocks_cols[i,1]:stocks_cols[i,2], stocks_cols[j,1]:stocks_cols[j,2]]
rho[i,j] <- sum(cormat_g) / (N_stocks_g[i]*N_stocks_g[j])
}
}
# Compute necessary quantities:
Rbar <- colMeans(stock_returns[1:N_stocks])
Rbar_f <- Rbar-Rf
sigma <- (diag(var(stock_returns[,1:N_stocks])))^.5
Ratio <- Rbar_f/sigma
# Initial table:
xx <- data.frame(Rbar, Rbar_f, sigma, Ratio)
# Compute the matrix A and C
# Compute matrix A:
A <- matrix(rep(0,25),5,5,byrow=TRUE)
for (i in (1:5)) {
for (j in (1:5)) {
A[i,j] <- (N_stocks_g[i]*rho[i,j])/(1-rho[i,i])
if (i == j) A[i,j] <- 1 + A[i,j]
}
}
# Compute matrix C:
C <- rep(0,5)
for (i in (1:5)) {
C[i] <- sum(xx[,4][stocks_cols[i,1]:stocks_cols[i,2]]) / (1-rho[i,i])
}
# Compute matrix phi
phi <- solve(A)%*%C
# Compute C_star
C_star <- rho%*%phi
# Initialize the vectors:
# rho_kk
col1 <- c(rep(rho[1,1],5), rep(rho[2,2],5), rep(rho[3,3],5),rep(rho[4,4],7),rep(rho[5,5],8))
# C_star
col2 <- c(rep(C_star[1],5), rep(C_star[2],5), rep(C_star[3],5),rep(C_star[4],7),rep(C_star[5],8))
# Create the entire table based on handout #39:
table <- data.frame(xx, col1, col2)
# --- Short sales allowed --- #
# Compute the zi:
z_mg <- (1/((1-table[,5])*table[,3]))*(table[,4]-table[,6])
# Compute the xi:
x_mg <- z_mg/sum(z_mg)
# The final table:
table_mg <- data.frame(table, z_mg, x_mg)
# Calculate the expected return and sd of the point of tangency
sd_G_mg <- (t(x_mg) %*% mat %*% x_mg)^.5
R_Gbar_mg <- t(x_mg) %*% table_mg[,1]
sd_G_mg; R_Gbar_mg## [,1]
## [1,] 0.03596108## [,1]
## [1,] 0.01366923# Place it on the plot of part (b)
points(sd_G_mg,R_Gbar_mg, col="green", pch=19)
text(sd_G_mg,R_Gbar_mg, "G_multigroup", cex=0.5, col="black")
Project 5
Evaluate your portfolios that you constructed in the previous projects. In your analysis you should include the following:
Time plots of the performance of all portfolios compared to the S&P500 (see the graph on handout #55a).
Calculate the Sharpe ratio, differential excess return, Treynor measure, and Jensen differential performance index.
Decompose the overall evaluation using Fama’s decomposition for the single index model with no short sales allowed.
- Calculate the 99% 5-day VaR for the single index model no short sales allowed scenario using:
- Historical simulations based on the past 500 daily returns of the stocks in your portfolio. Assume today’s day is 10 May, so download data for 501 trading days (including 05/10).
- Use Monte Carlo simulations based on the linear model.
# Read csv file:
# Historical period 2011-01-01 to 2016-01-01:
a1 <- read.csv("stockData.csv", sep=",", header=TRUE)
# Testing period 2016-01-01 to 2019-04-01:
a2 <- read.csv("stockData_period2.csv", sep=",", header=TRUE)
# Convert adjusted close prices into returns:
r1 <- (a1[-1,3:ncol(a1)]-a1[-nrow(a1),3:ncol(a1)])/a1[-nrow(a1),3:ncol(a1)]
r2 <- (a2[-1,3:ncol(a2)]-a2[-nrow(a2),3:ncol(a2)])/a2[-nrow(a2),3:ncol(a2)]
# Compute the mean returns:
R_ibar <- colMeans(r1[,-31])
# Compute the variance-covariance matrix:
var_covar <- cov(r1[,-31])
# Compute the inverse of the variance-covariance matrix:
var_covar_inv <- solve(var_covar)
# Compute the mean of market
RM <- mean(r1[,31])
# Compute the variance of market
varM <- var(r1[,31])
#=====================================================================================
##### PART a. Time plots of the performance of all portfolios compared to the
##### S&P500 for the period 2016-01-01 to 2019-04-01
# ================ Markowitz for The Period 2016-01-01 to 2019-04-0 ================ #
# Add another portfolio:
# Use Rf=-1 to find the optimal portfolio G (tangency point):
# Create the vector R:
Rf <- -1
R <- R_ibar-Rf
# Compute the vector z:
z <- var_covar_inv %*% R
# Compute the vector x:
x_Markowitz <- z/sum(z)
# Compute the return for Markowitz:
Ret_Markowitz <- t(x_Markowitz) %*% t(r2[,-31])
# Time plot:
plot(cumprod(1 + Ret_Markowitz), col="black", ylim=c(0.8,2.5), type='l',ylab="theReturns")
# ---------------------------------------------------
# Compute the composition of the optimal portfolio G:
sd_Markowitz <- (t(x_Markowitz) %*% var_covar %*% x_Markowitz)^0.5
Rbar_Markowitz <- t(x_Markowitz) %*% R_ibar
# =============================== Single Index Model =============================== #
# Read the data in matrix form:
b <- as.matrix(r1)
# Initialize the vectors and matrices:
x <- rep(0, 6*30)
xx <- matrix(x, ncol=6, nrow=30)
stock <- rep(0,30)
alpha <- rep(0,30)
beta <- rep(0,30)
mse <- rep(0,30)
Rbar <- rep(0,30)
Ratio <- rep(0,30)
col1 <- rep(0,30)
col2 <- rep(0,30)
col3 <- rep(0,30)
col4 <- rep(0,30)
col5 <- rep(0,30)
# Perform regression of each stock on the index and record alpha, beta and mse:
for(i in 1:30) {
alpha[i] <- lm(data=r1, formula=r1[,i] ~ r1[,31])$coefficients[1]
beta[i] <- lm(data=r1, formula=r1[,i] ~ r1[,31])$coefficients[2]
Rbar[i] <- alpha[i] + beta[i] * mean(b[,31])
mse[i] <- sum(lm(data=r1, formula=r1[,i] ~ r1[,31])$residuals^2)/(nrow(b)-2)
Ratio[i] <- (Rbar[i] - Rf) / beta[i]
stock[i] <- colnames(r1[,-31])[i]
}
# Initialize the table:
xx_SIM <- data.frame(stock, alpha, beta, Rbar, mse, Ratio)
row.names(xx_SIM) <- colnames(r1[,-31])
# Rank the stocks based on the excess return to beta ratio:
aaa <- xx_SIM[order(-Ratio),]
# Create the last 5 columns of the table:
col1 <- (aaa[,4]-Rf)*aaa[,3]/aaa[,5]
col3 <- aaa[,3]^2/aaa[,5]
for(i in(1:30)) {
col2[i] <- sum(col1[1:i])
col4[i] <- sum(col3[1:i])
}
# Compute the Ci:
for(i in (1:30)) {
col5[i] <- varM*col2[i]/(1+varM*col4[i])
}
# The entire table in handout#32 for SIM
xxx_SIM <- data.frame(aaa, col1, col2, col3, col4, col5)
# Initialize the var-covar matrix based on SIM:
mat <- matrix(0, 30, 30)
# cov.matrix
for(i in 1:30) {
for(j in 1:30) {
if (i == j) {
mat[i,j] <- xxx_SIM$beta[i]^2*varM + xxx_SIM$mse[i]
} else {
mat[i,j] <- xxx_SIM$beta[i]*xxx_SIM$beta[j]*varM
}
}
}
# ------------------- Single Index Model with Short Sales Allowed ------------------ #
xxx_SIM_SS <- xxx_SIM
# Compute the vector z:
z <- (xxx_SIM_SS[,3]/xxx_SIM_SS[,5])*(xxx_SIM_SS[,6]-col5[nrow(xxx_SIM)])
# Compute the vector x:
x_SIM_SS <- z/sum(z)
# The final table for SIM_SS:
xxx_SIM_SS <- data.frame(xxx_SIM_SS, z, x_SIM_SS)
# Compute the return for SIM_SS:
Ret_SIM_SS <- t(x_SIM_SS) %*% t(r2[,xxx_SIM_SS[,1]])
# Time plot
lines(cumprod(1 + Ret_SIM_SS), col="green", lty=2)
# ---------------------------------------------------
# Compute the composition of the optimal portfolio G:
sd_SIM_SS <- (t(x_SIM_SS) %*% mat %*% x_SIM_SS) ^ 0.5
Rbar_SIM_SS <- t(x_SIM_SS) %*% xxx_SIM$Rbar
# ----------------- Single Index Model with Short Sales Not Allowed ---------------- #
xxx_SIM_NSS <- xxx_SIM[1:which(col5==max(col5)), ]
# Compute the vector z:
z <- (xxx_SIM_NSS[,3]/xxx_SIM_NSS[,5])*(xxx_SIM_NSS[,6]-max(col5))
# Compute the vector x:
x_SIM_NSS <- z/sum(z)
# The final table for SIM_NSS:
xxx_SIM_NSS <- data.frame(xxx_SIM_NSS, z, x_SIM_NSS)
# Compute the return for SIM_NSS:
Ret_SIM_NSS <- t(x_SIM_NSS) %*% t(r2[, xxx_SIM_NSS[,1]])
# Time plot
lines(cumprod(1 + Ret_SIM_NSS), col="blue", lty=3)
# ------------------------------------------------------
# Subset the variance covariance matrix based on SIM_NSS
N_kept_stocks <- which(col5==max(col5))
mat <- mat[1:N_kept_stocks, 1:N_kept_stocks]
# Compute the composition of the optimal portfolio G:
sd_SIM_NSS <- (t(x_SIM_NSS) %*% mat %*% x_SIM_NSS) ^ 0.5
Rbar_SIM_NSS <- t(x_SIM_NSS) %*% xxx_SIM_NSS$Rbar
# =========================== Constant Correlation Model =========================== #
# Compute the average correlation:
rho <- (sum(cor(r1[,-31]))-30) / (30*(30-1))
# Initialize the var-covar matrix:
y <- rep(0,30^2)
mat <- matrix(y, ncol=30, nrow=30)
# Initialize the vectors:
col1 <- rep(0,30)
col2 <- rep(0,30)
col3 <- rep(0,30)
# Compute necessary quantities:
Rbar <- colMeans(r1[1:30])
Rbar_f <- Rbar-Rf
sigma <- (diag(var(r1[,1:30])))^.5
Ratio <- Rbar_f/sigma
# Initial the table:
xx <- data.frame(Rbar, Rbar_f, sigma, Ratio)
# Rank the stocks based on the excess return to sigma ratio:
aaa <- xx[order(-Ratio),]
# Create the last 3 columns of the table:
for(i in(1:30)) {
col1[i] <- rho/(1-rho+i*rho)
col2[i] <- sum(aaa[,4][1:i])
}
# Compute the Ci:
for(i in (1:30)) {
col3[i] <- col1[i]*col2[i]
}
# The entire table in handout#39 for CCM
xxx_CCM <- data.frame(aaa, col1, col2, col3)
# Initialize the var-covar matrix based on CCM:
mat <- matrix(0, 30, 30)
# cov.matrix
for(i in 1:30) {
for(j in 1:30) {
if(i == j) {
mat[i,j] = xxx_CCM[i,3]^2
} else {
mat[i,j] = rho*xxx_CCM[i,3]*xxx_CCM[j,3]
}
}
}
# --------------- Constant Correlation Model with Short Sales Allowed -------------- #
# Compute the vector z:
z <- (1/((1-rho)*xxx_CCM[,3]))*(xxx_CCM[,4]-xxx_CCM[,7][nrow(xxx_CCM)])
# Compute the vector x:
x_CCM_SS <- z/sum(z)
# The final table for CCM_SS:
xxx_CCM_SS <- data.frame(xxx_CCM, z, x_CCM_SS)
# Compute the return for CCM_SS:
Ret_CCM_SS <- t(x_CCM_SS) %*% t(r2[,row.names(xxx_CCM_SS)])
# Time plot
lines(cumprod(1 + Ret_CCM_SS), col="yellow", lty=4)
# ---------------------------------------------------
# Compute the composition of the optimal portfolio G:
sd_CCM_SS <- (t(x_CCM_SS) %*% mat %*% x_CCM_SS) ^ 0.5
Rbar_CCM_SS <- t(x_CCM_SS) %*% xxx_CCM$Rbar
# ------------- Constant Correlation Model with Short Sales Not Allowed ------------ #
xxx_CCM_NSS <- xxx_CCM[1:which(col3==max(col3)), ]
# Compute the vector z:
z <- (1/((1-rho)*xxx_CCM_NSS[,3]))*(xxx_CCM_NSS[,4]-max(col3))
# Compute the vector x:
x_CCM_NSS <- z/sum(z)
# The final table for CCM_NSS:
xxx_CCM_NSS <- data.frame(xxx_CCM_NSS, z, x_CCM_NSS)
# Compute the return for CCM_NSS:
Ret_CCM_NSS <- t(x_CCM_NSS) %*% t(r2[,row.names(xxx_CCM_NSS)])
# Time plot
lines(cumprod(1 + Ret_CCM_NSS), col="purple", lty=5)
# ------------------------------------------------------
# Subset the variance covariance matrix based on CCM_NSS
N_kept_stocks <-which(xxx_CCM[,7]==max(xxx_CCM[,7]))
mat <- mat[1:N_kept_stocks, 1:N_kept_stocks]
# Compute the composition of the optimal portfolio G:
sd_CCM_NSS <- (t(x_CCM_NSS) %*% mat %*% x_CCM_NSS) ^ 0.5
Rbar_CCM_NSS <- t(x_CCM_NSS) %*% xxx_CCM_NSS$Rbar
# ============================== Multiple Group Model ============================== #
# Define the range of column indices of stocks in industry 1,2,3,4,5:
stocks_cols <- matrix(c(1,5, 6,10, 11,15, 16,22, 23,30),5,2,byrow=TRUE)
# Define the number of stocks in each industry:
N_stocks_g <- c(5,5,5,7,8)
# Compute the correlation matrix cormat:
cormat <- cor(r1)
# Compute the average correlation: 5 by 5 matrix:
rho <- matrix(rep(0,25),5,5,byrow=TRUE)
for (i in (1:5)) {
for (j in (1:5)) {
cormat_g <- cormat[stocks_cols[i,1]:stocks_cols[i,2],
stocks_cols[j,1]:stocks_cols[j,2]]
rho[i,j] <- sum(cormat_g) / (N_stocks_g[i]*N_stocks_g[j])
}
}
# Compute necessary quantities:
Rbar <- colMeans(r1[1:30])
Rbar_f <- Rbar-Rf
sigma <- (diag(var(r1[,1:30])))^.5
Ratio <- Rbar_f/sigma
# Initial the table:
xx <- data.frame(Rbar, Rbar_f, sigma, Ratio)
# Compute the matrix A and C:
# Compute matrix A:
A <- matrix(rep(0,25),5,5,byrow=TRUE)
for (i in (1:5)) {
for (j in (1:5)) {
A[i,j] <- (N_stocks_g[i]*rho[i,j])/(1-rho[i,i])
if (i == j) A[i,j] <- 1 + A[i,j]
}
}
# Compute matrix C:
C <- rep(0,5)
for (i in (1:5)) {
C[i] <- sum(xx[,4][stocks_cols[i,1]:stocks_cols[i,2]]) / (1-rho[i,i])
}
# Compute matrix phi:
phi <- solve(A) %*% C
# Compute the vector C_i:
C_i <- rho %*% phi
# Initialize the vectors:
# Compute the rho_kk:
col1 <- c(rep(rho[1,1],5), rep(rho[2,2],5), rep(rho[3,3],5),
rep(rho[4,4],7), rep(rho[5,5],8))
# Compute the C_i:
col2 <- c(rep(C_i[1],5), rep(C_i[2],5), rep(C_i[3],5), rep(C_i[4],7), rep(C_i[5],8))
# Create the entire table based on handout #39:
xxx_MGM <- data.frame(xx, col1, col2)
# Initialize the var-covar matrix based on MGM:
mat <- matrix(0, 30, 30)
# cov.matrix
for(i in 1:30) {
for(j in 1:30) {
if(i == j) {
mat[i,j] = xxx_MGM[i,3]^2
} else {
mat[i,j] = col1[i]*xxx_MGM[i,3]*xxx_MGM[j,3]
}
}
}
# Compute the vector z:
z <- (1/((1-xxx_MGM[,5])*xxx_MGM[,3]))*(xxx_MGM[,4]-xxx_MGM[,6])
# Compute the vector x:
x_MGM_SS <- z/sum(z)
# The final table:
xxx_MGM_SS <- data.frame(xxx_MGM, z, x_MGM_SS)
# Compute the return for MGM_SS:
Ret_MGM_SS <- t(x_MGM_SS) %*% t(r2[,row.names(xxx_MGM_SS)])
# Time plot
lines(cumprod(1 + Ret_MGM_SS), col="gray", lty=6)
# ---------------------------------------------------
# Compute the composition of the optimal portfolio G:
sd_MGM_SS <- (t(x_MGM_SS) %*% mat %*% x_MGM_SS) ^ 0.5
Rbar_MGM_SS <- t(x_MGM_SS) %*% xxx_MGM_SS$Rbar
# ========================== Equal Allocation Performance ========================== #
x_EQUAL <- rep(1/30, 30) # equal allocation weights
# Compute the return for EQUAL:
Ret_EQUAL <- t(x_EQUAL) %*% t(r2[,-31])
# Time plot
lines(cumprod(1 + Ret_EQUAL), col="orange")
# ---------------------------------------------------
# Compute the composition of the optimal portfolio G:
sd_EQUAL <- (t(x_EQUAL) %*% var_covar %*% x_EQUAL) ^ 0.5
Rbar_EQUAL <- t(x_EQUAL) %*% R_ibar
# ========================== Market (S&P500) performance =========================== #
lines(cumprod(1+r2[,31]), col="pink", lty=2)
# Add a legend:
legend('topleft', c('Markowitz','SIM_SS','SIM_NSS','CCM_SS','CCM_NSS',
'MGM_SS','EQUAL','S&P500'),
col=c('black','green','blue','yellow','purple','gray','orange','pink'),
cex = 0.75, lty=1:6)
#=======================================================================================
##### PART b. Calculate the Sharpe ratio, differential excess return, Treynor measure,
##### and Jensen differential performance index.
Rf <- -10000
# Define some helper functions to compute the above four values for portfolio evaluation
# Sharpe ratio
sharpe_ratio <- function(sd, R){
return ((R-Rf)/sd)
}
# Differential excess return
diff_excess_return <- function(sd, R){
R_prime <- Rf + (RM-Rf)*sd/varM
return (R-R_prime)
}
# Treynor measure
Treynor <- function(beta, R) {
return ((R-Rf)/beta)
}
# Jensen differential performance index
Jensen <- function(beta, R) {
R_prime <- Rf + (RM-Rf)*beta
return (R-R_prime)
}
PortEval <- as.data.frame(matrix(nrow=7,ncol=4))
colnames(PortEval)<-c("Sharpe ratio", "Differential excess return",
"Treynor measure", " Jensen's Index")
row.names(PortEval)<- c("Markowitz","SIM_SS","SIM_NSS","CCM_SS","CCM_NSS","MGM_SS","EQUAL")
# Compute beta for use in the following calculation
beta_Markowitz <- as.numeric(t(x_Markowitz) %*% beta)
beta_SIM_SS <- as.numeric(t(x_SIM_SS) %*% xxx_SIM[,3])
beta_SIM_NSS <- as.numeric(t(x_SIM_NSS) %*% xxx_SIM_NSS[,3])
beta_CCM_SS <- as.numeric(t(x_CCM_SS) %*% xx_SIM[row.names(xxx_CCM_SS),3])
beta_CCM_NSS <- as.numeric(t(x_CCM_NSS) %*% xx_SIM[row.names(xxx_CCM_NSS),3])
beta_MGM_SS <- as.numeric(t(x_MGM_SS) %*% beta)
beta_EQUAL <- as.numeric(t(x_EQUAL) %*% beta)
# Sharpe ratio
PortEval[1,1] <- sharpe_ratio(sd_Markowitz, Rbar_Markowitz) # Markowitz
PortEval[2,1] <- sharpe_ratio(sd_SIM_SS, Rbar_SIM_SS) # SIM_SS
PortEval[3,1] <- sharpe_ratio(sd_SIM_NSS, Rbar_SIM_NSS) # SIM_NSS
PortEval[4,1] <- sharpe_ratio(sd_CCM_SS, Rbar_CCM_SS) # CCM_SS
PortEval[5,1] <- sharpe_ratio(sd_CCM_NSS, Rbar_CCM_NSS) # CCM_NSS
PortEval[6,1] <- sharpe_ratio(sd_MGM_SS, Rbar_MGM_SS) # MGM_SSs
PortEval[7,1] <- sharpe_ratio(sd_EQUAL, Rbar_EQUAL) # EQUAL
# Differential excess return
PortEval[1,2] <- diff_excess_return(sd_Markowitz, Rbar_Markowitz)
PortEval[2,2] <- diff_excess_return(sd_SIM_SS, Rbar_SIM_SS)
PortEval[3,2] <- diff_excess_return(sd_SIM_NSS, Rbar_SIM_NSS)
PortEval[4,2] <- diff_excess_return(sd_CCM_SS, Rbar_CCM_SS)
PortEval[5,2] <- diff_excess_return(sd_CCM_NSS, Rbar_CCM_NSS)
PortEval[6,2] <- diff_excess_return(sd_MGM_SS, Rbar_MGM_SS)
PortEval[7,2] <- diff_excess_return(sd_EQUAL, Rbar_EQUAL)
# Treynor measure
PortEval[1,3] <- Treynor(beta_Markowitz, Rbar_Markowitz)
PortEval[2,3] <- Treynor(beta_SIM_SS, Rbar_SIM_SS)
PortEval[3,3] <- Treynor(beta_SIM_NSS, Rbar_SIM_NSS)
PortEval[4,3] <- Treynor(beta_CCM_SS, Rbar_CCM_SS)
PortEval[5,3] <- Treynor(beta_CCM_NSS, Rbar_CCM_NSS)
PortEval[6,3] <- Treynor(beta_MGM_SS, Rbar_MGM_SS)
PortEval[7,3] <- Treynor(beta_EQUAL, Rbar_EQUAL)
# Jensen's index
PortEval[1,4] <- Jensen(beta_Markowitz, Rbar_Markowitz)
PortEval[2,4] <- Jensen(beta_SIM_SS, Rbar_SIM_SS)
PortEval[3,4] <- Jensen(beta_SIM_NSS, Rbar_SIM_NSS)
PortEval[4,4] <- Jensen(beta_CCM_SS, Rbar_CCM_SS)
PortEval[5,4] <- Jensen(beta_CCM_NSS, Rbar_CCM_NSS)
PortEval[6,4] <- Jensen(beta_MGM_SS, Rbar_MGM_SS)
PortEval[7,4] <- Jensen(beta_EQUAL, Rbar_EQUAL)
# PortEval
#=====================================================================================
##### PART c. Decompose the overall evaluation using Fama's decomposition for the single
##### index model with no short sales allowed.
RA <- Rbar_SIM_NSS
beta_A <- beta_SIM_NSS
RA_prime <- Rf + (RM-Rf)*beta_A
# Return from selectivity
R_select <- RA - RA_prime
# Return from net selectivity
beta_A_prime <- sd_SIM_NSS / (varM^0.5)
RA_prime2 <- Rf + (RM-Rf) * beta_A_prime
R_net_select <- RA - RA_prime2
# Return from diversification
R_div <- R_select - R_net_select
# Return from risk
R_risk <- RA_prime - Rf
#=====================================================================================
##### PART c. Decompose the overall evaluation using Fama's decomposition for the single
##### index model with no short sales allowed.
# 1. Historical simulations based on the past 500 daily returns of the stocks in your portfolio.
# Get data from 2017-05-16 to 2019-05-10 (500 days)
a <- read.csv("stockData_5.csv", sep=",", header=TRUE)
# There are 12 stocks included in SIM_NSS:
row.names(xxx_SIM_NSS)## [1] "VZ" "T" "CHL" "AMT" "IBM" "UNH" "JNJ" "AMGN" "V" "CVS"
## [11] "PFE" "WFC"# Compute DP (change in portfolio) for each day in the historical period.
# Convert adjusted close prices into returns:
r <- (a[-1,3:ncol(a)]-a[-nrow(a),3:ncol(a)])/a[-nrow(a),3:ncol(a)]
r <- r[,row.names(xxx_SIM_NSS)]
# Assume portfolio value of $1000000
# Compute the portfolio changes in dollar ammount for each possible scenario:
x <- 1000000*x_SIM_NSS
DP <- as.matrix(r) %*% x
# Find the 1st percentile of the distribution of DP:
# Histogram:
hist(DP)
# Find the 1st percentile:
VaR <- quantile(DP, 0.01)
# Place it on the histogram:
points(VaR, 0, pch=19)
# Verify:
sum(DP <= VaR) #This should give 5.## [1] 5# Finally compute the 5-day 99% VaR:
VaR*sqrt(5)## 1%
## -53666.93# 2. Use Monte Carlo simulations based on the linear model.
# Assume DX ~ N12(0, Sigma)
# Obtain many random vectors from this distibution.
# Use Cholesky or spectral decomposition method
#Use each vector to compute the change in the portfolio.
#Compute variance covariance matrix:
Sigma <- var(r)
#Compute variance and standard deviation of DP:
#Here is one sample:
L <- chol(Sigma)
#One samle:
e <- rnorm(12)
mu <- rep(0,12)
DX <- mu + t(L) %*% e
DP <- t(x) %*% DX
# Many samples:
errors <- rnorm(12000)
epsilon <- matrix(errors,12,1000, byrow=FALSE)
DXX <- t(L) %*% epsilon
aa <- t(x) %*% DXX # Simulated changes in portfolio.
# 5-day 99% VaR using simulations:
sd(aa) * qnorm(.99)*12^.5## [1] 63041.21# Or using spectral decomposition:
q1 <- eigen(Sigma)
Sigmasqrt <- q1$vectors %*% diag(q1$values^.5) %*% t(q1$vectors)
errors <- rnorm(12000)
epsilon <- matrix(errors,12,1000, byrow=FALSE)
DXX <- Sigmasqrt %*% epsilon
aa <- t(x) %*% DXX # Simulated changes in portfolio.
# 5-day 99% VaR using simulations:
sd(aa) * qnorm(.99)*12^.5## [1] 63552.08