Import the data

# import install.packages('ggplot2') install.packages('fPortfolio')
require(fPortfolio)
## Loading required package: fPortfolio
## Loading required package: MASS
## Loading required package: robustbase
## Loading required package: timeDate
## Loading required package: timeSeries
## Loading required package: fBasics
## 
## Attaching package: 'fBasics'
## 
## The following object(s) are masked from 'package:base':
## 
##     norm
## 
## Loading required package: fAssets
## Loading required package: sn
## Loading required package: mnormt
## Loading required package: fCopulae
## 
## Attaching package: 'fAssets'
## 
## The following object(s) are masked from 'package:fCopulae':
## 
##     .mvstFit

rm(list = ls())
# Fama french factor returns source
# http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/data_library.html
# Downloaded September 2013 This file was created by CMPT_ME_BEME_RETS
# using the 201308 CRSP database. The 1-month TBill return is from
# Ibbotson and Associates, Inc.
data <- read.table("data.txt", comment.char = "%")
colnames(data) = c("Date", "MktRF", "SMB", "HML", "RF")
head(data)
##     Date MktRF   SMB   HML   RF
## 1 192607  2.65 -2.39 -2.57 0.22
## 2 192608  2.59 -1.27  4.58 0.25
## 3 192609  0.37 -1.25 -0.09 0.23
## 4 192610 -3.45 -0.02  1.02 0.32
## 5 192611  2.43 -0.24 -0.63 0.31
## 6 192612  2.74 -0.12  0.16 0.28
FamaData = ts(data[2:5], frequency = 12, start = c(1926, 7))
# Fama french 25 size and book/market portoflio returns source
# http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/data_library.html
# Downloaded September 2013 Average Value Weighted Returns -- Monthly
port25 <- read.table("portfolio25.txt", comment.char = "%")
colnames(port25) = c("Date", 1:25)
head(port25)
##     Date     1      2     3     4     5     6     7     8     9    10
## 1 192607  5.59 -10.14 -0.50 -1.32 -0.64  1.84  4.97  2.42 -0.79  2.05
## 2 192608 -1.72  -4.29  3.10  0.79  4.82  2.40 -2.97  3.02  2.41  7.19
## 3 192609 -5.08  -2.48 -5.64  2.50  0.75 -2.44 -1.51  1.15 -1.47 -2.14
## 4 192610 -9.40  -6.62 -4.89 -0.23 -3.06 -4.02 -3.90 -7.02 -5.13 -0.56
## 5 192611  5.88   5.32  2.55 -3.58  1.40  2.54 -2.27  4.03  2.62  1.41
## 6 192612 14.62   0.73 -0.84  5.32  2.15  3.23  4.02  2.81  0.95  3.45
##      11    12    13    14    15    16    17    18    19    20    21    22
## 1  1.56  2.70 -0.98  3.43 -2.01  2.18  1.10  1.16  0.57  2.56  3.37  6.08
## 2 -1.05  1.59  2.90  4.82  8.49  0.83  3.95  1.86  2.10  4.47  1.15  4.10
## 3 -0.45  1.11 -2.57  1.86 -3.31  1.45 -0.74 -1.62  1.57  2.18 -1.31  3.66
## 4 -4.81 -2.11 -0.11 -1.96 -3.21 -2.16 -1.76 -2.08 -2.91 -5.21 -2.84 -3.14
## 5  1.82  4.62  2.74  3.82  3.75  3.63  2.31  3.77  4.94  1.78  4.29  2.61
## 6 -1.32  2.26 -1.01  3.11  0.62  2.68  2.36  2.21  2.70  1.80  1.50  3.48
##      23    24    25
## 1  2.00  2.93  0.56
## 2  1.81  5.64  7.76
## 3 -0.23 -0.30 -2.43
## 4 -2.21 -4.59 -5.81
## 5  1.47  3.55  2.56
## 6  2.07  5.75  2.41
tsport25 = ts(port25[2:26], frequency = 12, start = c(1926, 7))

Use data starting in 194701. (If you plot the data you will see a clear difference before and after 1947. Just why this massive stabilization happened is an open question.)

FamaData = window(FamaData, start = c(1947, 1), end = c(2013, 8), frequency = 12)
tsport25 = window(tsport25, start = c(1947, 1), end = c(2013, 8), frequency = 12)

Adjust for excess return

window(tsport25, start = c(1947, 1), end = c(1947, 12), frequency = 12)
##               1     2     3     4     5     6     7     8     9    10
## Jan 1947   5.69  5.74  2.72  4.71  5.43  5.03  3.05  3.22  2.32  3.80
## Feb 1947   0.82 -2.08 -0.22  0.64  0.45 -0.42 -0.77  1.46 -1.43  1.03
## Mar 1947  -5.31 -4.35 -5.43 -4.26 -1.81 -4.19 -4.65 -3.41 -2.47 -3.18
## Apr 1947 -11.45 -9.22 -9.92 -9.12 -9.54 -8.84 -6.43 -7.87 -9.43 -9.15
## May 1947  -6.11 -6.38 -7.79 -5.31 -5.32 -6.49 -4.82 -4.09 -3.33 -1.49
## Jun 1947   6.82  2.54  8.03  3.21  6.31  5.60  3.89  6.67  5.88  4.91
## Jul 1947  10.18  7.60  8.23  5.25  9.23  4.78  6.53  5.89  6.35  7.84
## Aug 1947  -2.50 -4.28 -3.77 -1.30 -2.39 -2.10 -0.98 -1.82 -0.93 -1.35
## Sep 1947   1.19  0.48 -0.65 -0.33  3.36 -0.64  1.36  0.89  0.61  3.27
## Oct 1947   2.47  5.44  7.50  4.64  1.98  3.09  3.77  2.82  4.69  3.25
## Nov 1947  -4.78 -6.97 -4.27 -2.14 -1.75 -4.75 -3.26 -2.58 -3.92 -3.35
## Dec 1947  -3.49  4.12 -1.67 -0.15  5.08 -1.60  1.63  1.69 -0.58  5.91
##             11    12    13    14    15    16    17    18    19    20    21
## Jan 1947  1.59  3.04  1.82  1.19  4.45 -1.77  0.30  1.59  3.62  2.08  3.35
## Feb 1947 -1.95 -1.60 -1.09 -1.04  1.14 -1.95 -0.87 -1.77 -2.09  0.11  0.34
## Mar 1947 -2.11 -2.36 -2.08 -1.54 -2.20 -0.61 -1.79 -2.64 -1.03 -2.69 -1.88
## Apr 1947 -9.74 -8.15 -7.71 -6.65 -5.96 -6.65 -6.65 -7.45 -8.76 -8.03 -4.71
## May 1947 -4.12 -3.61 -3.02 -2.96 -3.86 -3.05 -3.50 -1.57 -4.44 -2.76 -1.11
## Jun 1947  4.59  4.96  6.40  5.58  5.07  6.87  5.87  4.96  5.58  6.24  6.26
## Jul 1947  6.18  3.98  8.25  6.81  7.36  3.96  3.96  8.01  4.73  9.97  3.35
## Aug 1947 -0.07 -1.50 -1.80 -1.46 -0.92 -1.32 -1.21 -3.00 -1.86 -1.91 -1.84
## Sep 1947  0.82 -1.39  0.81  1.45  1.95 -0.79 -0.80  2.54  2.28  0.90 -0.46
## Oct 1947  5.68  3.25  3.68  4.56  0.63  3.14  2.70  4.20  1.57 -0.11  1.71
## Nov 1947 -2.62 -3.71 -2.83 -3.14 -1.67 -2.70 -2.50 -1.90 -1.85 -3.92 -1.53
## Dec 1947  1.57  4.14  0.33  2.42  3.02  4.54  2.99  1.10  0.61  3.55  1.43
##             22    23    24    25
## Jan 1947  0.15  0.68 -0.52  1.38
## Feb 1947 -0.50 -1.41 -1.65 -2.49
## Mar 1947 -1.76 -2.13  0.61 -2.16
## Apr 1947 -5.25 -2.51 -2.84 -3.89
## May 1947 -0.19 -0.90  1.80 -2.12
## Jun 1947  6.85  1.32  6.10  4.38
## Jul 1947  3.82  2.63  3.58  7.25
## Aug 1947 -1.76 -1.44 -1.04 -2.97
## Sep 1947 -0.81 -1.39 -0.31 -0.58
## Oct 1947  4.34  2.45  2.51  3.60
## Nov 1947 -1.79 -1.35 -2.33 -1.47
## Dec 1947  3.86  3.69  4.79  7.50
for (i in 1:25) {
    tsport25[, i] = tsport25[, i] - FamaData[, "RF"]
}
window(tsport25, start = c(1947, 1), end = c(1947, 12), frequency = 12)
##               1     2     3     4     5     6     7     8     9    10
## Jan 1947   5.66  5.71  2.69  4.68  5.40  5.00  3.02  3.19  2.29  3.77
## Feb 1947   0.79 -2.11 -0.25  0.61  0.42 -0.45 -0.80  1.43 -1.46  1.00
## Mar 1947  -5.34 -4.38 -5.46 -4.29 -1.84 -4.22 -4.68 -3.44 -2.50 -3.21
## Apr 1947 -11.48 -9.25 -9.95 -9.15 -9.57 -8.87 -6.46 -7.90 -9.46 -9.18
## May 1947  -6.14 -6.41 -7.82 -5.34 -5.35 -6.52 -4.85 -4.12 -3.36 -1.52
## Jun 1947   6.79  2.51  8.00  3.18  6.28  5.57  3.86  6.64  5.85  4.88
## Jul 1947  10.15  7.57  8.20  5.22  9.20  4.75  6.50  5.86  6.32  7.81
## Aug 1947  -2.53 -4.31 -3.80 -1.33 -2.42 -2.13 -1.01 -1.85 -0.96 -1.38
## Sep 1947   1.13  0.42 -0.71 -0.39  3.30 -0.70  1.30  0.83  0.55  3.21
## Oct 1947   2.41  5.38  7.44  4.58  1.92  3.03  3.71  2.76  4.63  3.19
## Nov 1947  -4.84 -7.03 -4.33 -2.20 -1.81 -4.81 -3.32 -2.64 -3.98 -3.41
## Dec 1947  -3.57  4.04 -1.75 -0.23  5.00 -1.68  1.55  1.61 -0.66  5.83
##             11    12    13    14    15    16    17    18    19    20    21
## Jan 1947  1.56  3.01  1.79  1.16  4.42 -1.80  0.27  1.56  3.59  2.05  3.32
## Feb 1947 -1.98 -1.63 -1.12 -1.07  1.11 -1.98 -0.90 -1.80 -2.12  0.08  0.31
## Mar 1947 -2.14 -2.39 -2.11 -1.57 -2.23 -0.64 -1.82 -2.67 -1.06 -2.72 -1.91
## Apr 1947 -9.77 -8.18 -7.74 -6.68 -5.99 -6.68 -6.68 -7.48 -8.79 -8.06 -4.74
## May 1947 -4.15 -3.64 -3.05 -2.99 -3.89 -3.08 -3.53 -1.60 -4.47 -2.79 -1.14
## Jun 1947  4.56  4.93  6.37  5.55  5.04  6.84  5.84  4.93  5.55  6.21  6.23
## Jul 1947  6.15  3.95  8.22  6.78  7.33  3.93  3.93  7.98  4.70  9.94  3.32
## Aug 1947 -0.10 -1.53 -1.83 -1.49 -0.95 -1.35 -1.24 -3.03 -1.89 -1.94 -1.87
## Sep 1947  0.76 -1.45  0.75  1.39  1.89 -0.85 -0.86  2.48  2.22  0.84 -0.52
## Oct 1947  5.62  3.19  3.62  4.50  0.57  3.08  2.64  4.14  1.51 -0.17  1.65
## Nov 1947 -2.68 -3.77 -2.89 -3.20 -1.73 -2.76 -2.56 -1.96 -1.91 -3.98 -1.59
## Dec 1947  1.49  4.06  0.25  2.34  2.94  4.46  2.91  1.02  0.53  3.47  1.35
##             22    23    24    25
## Jan 1947  0.12  0.65 -0.55  1.35
## Feb 1947 -0.53 -1.44 -1.68 -2.52
## Mar 1947 -1.79 -2.16  0.58 -2.19
## Apr 1947 -5.28 -2.54 -2.87 -3.92
## May 1947 -0.22 -0.93  1.77 -2.15
## Jun 1947  6.82  1.29  6.07  4.35
## Jul 1947  3.79  2.60  3.55  7.22
## Aug 1947 -1.79 -1.47 -1.07 -3.00
## Sep 1947 -0.87 -1.45 -0.37 -0.64
## Oct 1947  4.28  2.39  2.45  3.54
## Nov 1947 -1.85 -1.41 -2.39 -1.53
## Dec 1947  3.78  3.61  4.71  7.42
# adjust for percent representation
tsport25 = tsport25/100
window(tsport25, start = c(1947, 1), end = c(1947, 12), frequency = 12)
##                1       2       3       4       5       6       7       8
## Jan 1947  0.0566  0.0571  0.0269  0.0468  0.0540  0.0500  0.0302  0.0319
## Feb 1947  0.0079 -0.0211 -0.0025  0.0061  0.0042 -0.0045 -0.0080  0.0143
## Mar 1947 -0.0534 -0.0438 -0.0546 -0.0429 -0.0184 -0.0422 -0.0468 -0.0344
## Apr 1947 -0.1148 -0.0925 -0.0995 -0.0915 -0.0957 -0.0887 -0.0646 -0.0790
## May 1947 -0.0614 -0.0641 -0.0782 -0.0534 -0.0535 -0.0652 -0.0485 -0.0412
## Jun 1947  0.0679  0.0251  0.0800  0.0318  0.0628  0.0557  0.0386  0.0664
## Jul 1947  0.1015  0.0757  0.0820  0.0522  0.0920  0.0475  0.0650  0.0586
## Aug 1947 -0.0253 -0.0431 -0.0380 -0.0133 -0.0242 -0.0213 -0.0101 -0.0185
## Sep 1947  0.0113  0.0042 -0.0071 -0.0039  0.0330 -0.0070  0.0130  0.0083
## Oct 1947  0.0241  0.0538  0.0744  0.0458  0.0192  0.0303  0.0371  0.0276
## Nov 1947 -0.0484 -0.0703 -0.0433 -0.0220 -0.0181 -0.0481 -0.0332 -0.0264
## Dec 1947 -0.0357  0.0404 -0.0175 -0.0023  0.0500 -0.0168  0.0155  0.0161
##                9      10      11      12      13      14      15      16
## Jan 1947  0.0229  0.0377  0.0156  0.0301  0.0179  0.0116  0.0442 -0.0180
## Feb 1947 -0.0146  0.0100 -0.0198 -0.0163 -0.0112 -0.0107  0.0111 -0.0198
## Mar 1947 -0.0250 -0.0321 -0.0214 -0.0239 -0.0211 -0.0157 -0.0223 -0.0064
## Apr 1947 -0.0946 -0.0918 -0.0977 -0.0818 -0.0774 -0.0668 -0.0599 -0.0668
## May 1947 -0.0336 -0.0152 -0.0415 -0.0364 -0.0305 -0.0299 -0.0389 -0.0308
## Jun 1947  0.0585  0.0488  0.0456  0.0493  0.0637  0.0555  0.0504  0.0684
## Jul 1947  0.0632  0.0781  0.0615  0.0395  0.0822  0.0678  0.0733  0.0393
## Aug 1947 -0.0096 -0.0138 -0.0010 -0.0153 -0.0183 -0.0149 -0.0095 -0.0135
## Sep 1947  0.0055  0.0321  0.0076 -0.0145  0.0075  0.0139  0.0189 -0.0085
## Oct 1947  0.0463  0.0319  0.0562  0.0319  0.0362  0.0450  0.0057  0.0308
## Nov 1947 -0.0398 -0.0341 -0.0268 -0.0377 -0.0289 -0.0320 -0.0173 -0.0276
## Dec 1947 -0.0066  0.0583  0.0149  0.0406  0.0025  0.0234  0.0294  0.0446
##               17      18      19      20      21      22      23      24
## Jan 1947  0.0027  0.0156  0.0359  0.0205  0.0332  0.0012  0.0065 -0.0055
## Feb 1947 -0.0090 -0.0180 -0.0212  0.0008  0.0031 -0.0053 -0.0144 -0.0168
## Mar 1947 -0.0182 -0.0267 -0.0106 -0.0272 -0.0191 -0.0179 -0.0216  0.0058
## Apr 1947 -0.0668 -0.0748 -0.0879 -0.0806 -0.0474 -0.0528 -0.0254 -0.0287
## May 1947 -0.0353 -0.0160 -0.0447 -0.0279 -0.0114 -0.0022 -0.0093  0.0177
## Jun 1947  0.0584  0.0493  0.0555  0.0621  0.0623  0.0682  0.0129  0.0607
## Jul 1947  0.0393  0.0798  0.0470  0.0994  0.0332  0.0379  0.0260  0.0355
## Aug 1947 -0.0124 -0.0303 -0.0189 -0.0194 -0.0187 -0.0179 -0.0147 -0.0107
## Sep 1947 -0.0086  0.0248  0.0222  0.0084 -0.0052 -0.0087 -0.0145 -0.0037
## Oct 1947  0.0264  0.0414  0.0151 -0.0017  0.0165  0.0428  0.0239  0.0245
## Nov 1947 -0.0256 -0.0196 -0.0191 -0.0398 -0.0159 -0.0185 -0.0141 -0.0239
## Dec 1947  0.0291  0.0102  0.0053  0.0347  0.0135  0.0378  0.0361  0.0471
##               25
## Jan 1947  0.0135
## Feb 1947 -0.0252
## Mar 1947 -0.0219
## Apr 1947 -0.0392
## May 1947 -0.0215
## Jun 1947  0.0435
## Jul 1947  0.0722
## Aug 1947 -0.0300
## Sep 1947 -0.0064
## Oct 1947  0.0354
## Nov 1947 -0.0153
## Dec 1947  0.0742

optimizing portfolio

mu = colMeans(tsport25)
Sigma = var(tsport25)
weight = solve(Sigma) %*% mu
Remv = tsport25 %*% weight
mean(Remv)
## [1] 0.1527
# Report in percentage
meanRet = mean(Remv) * 100
sdRet = sd(Remv) * 100
## Warning: sd(<matrix>) is deprecated.
##  Use apply(*, 2, sd) instead.
Sharpe = meanRet/sdRet
meanRet
## [1] 15.27
sdRet
## [1] 39.07
Sharpe
## [1] 0.3907

plot(weight)

plot of chunk optimization

now for the R e star


E_ReRe = Sigma + mu %*% t(mu)
Re_star_wts = t(mu) %*% solve(E_ReRe)
Re_star = Re_star_wts %*% t(tsport25)
meanReStar = mean(Re_star) * 100
sdReStar = sd(t(Re_star)) * 100
## Warning: sd(<matrix>) is deprecated.
##  Use apply(*, 2, sd) instead.
SharpeReStar = meanReStar/sdReStar
meanReStar
## [1] 13.25
sdReStar
## [1] 33.9
SharpeReStar
## [1] 0.3907

Efficient Frontier

plot efficient frontier

plot(sdRet, meanRet, xlim = c(0, 55), ylim = c(0, 20))
# Yellow for ReStar
points(sdReStar, meanReStar, col = "Blue")
lines(c(0, 10 * sdRet), c(0, 10 * meanRet))
for (i in 1:25) {
    points(sd(tsport25[, i]) * 100, mean(tsport25[, i]) * 100)
    print(sd(tsport25[, i]) * 100)
}

plot of chunk plot_ef

## [1] 7.709
## [1] 6.537
## [1] 5.723
## [1] 5.384
## [1] 5.834
## [1] 6.703
## [1] 5.623
## [1] 5.135
## [1] 5.1
## [1] 5.794
## [1] 6.171
## [1] 5.154
## [1] 4.805
## [1] 4.822
## [1] 5.396
## [1] 5.528
## [1] 4.875
## [1] 4.817
## [1] 4.717
## [1] 5.443
## [1] 4.543
## [1] 4.298
## [1] 4.191
## [1] 4.355
## [1] 5.043

ERR and ER

ERR = Re_star %*% tsport25[, 1]
ERR
##      [,1]
## [1,] 2.53
ER = mean(tsport25[, 1])
ER
## [1] 0.003166