CoCalc -- EfficientFrontier

GitHub Repository: braverock/portfolioanalytics
Path: blob/master/sandbox/paper_analysis/insample/EfficientFrontier_ComputeWeights.R
¹⁴³³ views
1

2
#################################################################################
3
# Make Exhibit 3 Risk budget paper: Efficient frontier plot
4
#################################################################################
5

6

7
setwd("c:/Documents and Settings/Administrator/Desktop/risk budget programs/insample")
8
#setwd("c:/Documents and Settings/n06054/Desktop/risk budget programs")
9
cAssets = 4; p = priskbudget = 0.95;
10
mincriterion = "mES" ; percriskcontribcriterion = "mES";
11

12
# Load programs
13

14
source("Risk_budget_functions.R"); 
15
library(zoo); library(fGarch); library("PerformanceAnalytics"); library("PortfolioAnalytics")
16
clean = TRUE
17
CC = TRUE
18

19
#   Load the data
20
firstyear = 1976 ; firstquarter = 1; lastyear = 2010; lastquarter = 2; 
21
data = read.table( file= paste(getwd(),"/data.txt",sep="") ,header=T)
22
date = as.Date(data[,1],format="%Y-%m-%d")
23

24
monthlyR = zoo( data[,2:(1+cAssets)] , order.by = date )
25

26
if(clean){ monthlyR = clean.boudt2(monthlyR,alpha=0.05)[[1]] }
27
mu = apply(monthlyR,2,'mean')
28
sigma = cov(monthlyR)
29
if(!CC){
30
  M3 = PerformanceAnalytics:::M3.MM(monthlyR) 
31
  M4 = PerformanceAnalytics:::M4.MM(monthlyR) 
32
}else{
33
  source( "coskewkurtosis.R"  ) 
34
  M3 = coskewCC(monthlyR-matrix( rep(mu,nrow(monthlyR)) , nrow=nrow(monthlyR) , byrow=TRUE)  ); 
35
  M4 = cokurtCC(monthlyR-matrix( rep(mu,nrow(monthlyR)) , nrow=nrow(monthlyR) , byrow=TRUE)  );
36
}
37
N = ncol(monthlyR)
38

39

40
#################################################################################
41
# Make Exhibit 3 Risk budget paper: Efficient frontier plot
42
#################################################################################
43

44
mESfun = function( series ){ return( operMES(  series , alpha = 0.05 , r = 2 ) ) }
45
assetmu = apply( monthlyR , 2 , 'mean' )
46
assetCVaR = apply( monthlyR , 2 , 'mESfun' )
47
#      Bond      SP500     NAREIT     SPGSCI 
48
#0.01228896 0.12481216 0.27768243 0.20588189 
49
mESfun2 = function( w ){ return( operPortMES(w,mu=mu,alpha=0.05,sigma=sigma,M3=M3,M4=M4)[[1]]   ) }
50
mESfun2( as.matrix(c(0,1,0,0)) )
51

52
minmu = min(assetmu); maxmu = max(assetmu); print(minmu*12); print(maxmu*12);
53

54
# Mean/CVaR concentration efficient portfolios
55
#-----------------------------------------------
56

57
eps = 0.025
58
set.seed(1234)
59
rpconstraint<-constraint(assets=N, min_sum=(1-eps), max_sum=(1+eps), 
60
      min=rep(0,N), max=rep(1,N), weight_seq=generatesequence(),by=.001,rounding=3)
61
rp<- random_portfolios(rpconstraints=rpconstraint,permutations=200)
62
rp<-rbind( rp , diag( rep(1,4) ) )  
63
rp <-rp/rowSums(rp)
64
controlDE <- list(reltol=1e-6,steptol=150, itermax = 5000,trace = 100, strategy=6, c=.4,
65
                NP=as.numeric(nrow(rp)),initialpop=rp) 
66
#controlDE <- list(reltol=1e-6,steptol=150, itermax = 5000,trace = 100, strategy=2, c=0,
67
#                NP=as.numeric(nrow(rp)),initialpop=rp) 
68
# unconstrained solution is Minimum CVaR Concentration portfolio (having the equal risk contribution property):
69
# sol = MinMaxCompCVaRconportfolio(R=monthlyR, Riskupper = Inf ,Returnlower= -Inf )
70
minmu = min( apply(monthlyR,2,'mean' )); 
71
sol = PortfolioOptim(  minriskcriterion = "mES" , MinMaxComp = T, percriskcontribcriterion = "mES" , 
72
                Riskupper = Inf ,  mu = mu, sigma = sigma, M3=M3, M4=M4, controlDE = controlDE)
73

74
W               = as.vector( sol[[1]] ) ;   vmu             = as.vector( sol[[2]] )
75
vrisk           = as.vector( sol[[3]] ) ;   mPercrisk       = as.vector( sol[[4]] )  
76
vmaxpercrisk    = max( sol[[4]] )       ;   vmaxriskcontrib = max( sol[[5]] ) 
77

78
mutarget = minmu+0.00001
79
while( mutarget <= maxmu ){
80
   print("------------")
81
    print( c(minmu,mutarget,maxmu) ) 
82
   sol = PortfolioOptim(  minriskcriterion = "mES" , MinMaxComp = T, percriskcontribcriterion = "mES" , 
83
                      Riskupper = Inf ,Returnlower= mutarget,
84
                      mu = mu, sigma = sigma, M3=M3, M4=M4, controlDE = controlDE) 
85
   controlDE$initialpop = rbind( rp , W )
86
   controlDE$NP         = as.numeric( nrow(controlDE$initialpop) )
87
   W = rbind( W, as.vector( sol[[1]] ) )
88
   mPercrisk = rbind( mPercrisk , as.vector( sol[[4]] ) )
89
   vmu = c( vmu , as.vector( sol[[2]] ))
90
   vrisk = c( vrisk , as.vector( sol[[3]] ) )
91
   vmaxpercrisk = c( vmaxpercrisk , max( sol[[4]] ) )
92
   vmaxriskcontrib = c( vmaxriskcontrib , max( sol[[5]] ) )
93
   oldmutarget = mutarget
94
   mutarget = as.vector( sol[[2]] ) + 0.00001
95
   if( mutarget == oldmutarget ){ mutarget = mutarget +  0.00001 }
96
}
97

98
# For the highest return targets, a very high penalty parameter is (sometimes) needed
99

100
for( mutarget in c(seq( max(vmu) , maxmu,0.00001),maxmu) ){
101
   print("------------")
102
   print( c("mutarget equal to",mutarget) )
103
   controlDE$initialpop = rbind( rp , W )
104
   controlDE$NP         = as.numeric( nrow(controlDE$initialpop) )
105
   sol = PortfolioOptim(  minriskcriterion = "mES" , MinMaxComp = T, percriskcontribcriterion = "mES" , 
106
            Riskupper = Inf ,Returnlower= mutarget, penalty = 1e9,
107
            mu = mu, sigma = sigma, M3=M3, M4=M4) 
108
   W = rbind( W, as.vector( sol[[1]] ) )
109
   mPercrisk = rbind( mPercrisk , as.vector( sol[[4]] ) )
110
   vmu = c( vmu , as.vector( sol[[2]] ))
111
   vrisk = c( vrisk , as.vector( sol[[3]] ) )
112
   vmaxpercrisk = c( vmaxpercrisk , max( sol[[4]] ) )
113
   vmaxriskcontrib = c( vmaxriskcontrib , max( sol[[5]] ) )
114
}
115

116

117
EffFrontier_stats = cbind( vmu , vrisk , vmaxpercrisk , vmaxriskcontrib)
118
if(clean){
119
   if(!CC){
120
      write.csv( W , file = "EffFrontierMinCVaRConc_weights_clean.csv" )
121
      write.csv( mPercrisk , file = "EffFrontierMinCVaRConc_percrisk_clean.csv" )
122
      write.csv( EffFrontier_stats , file = "EffFrontierMinCVaRConc_stats_clean.csv" )
123
   }else{
124
      write.csv( W , file = "EffFrontierMinCVaRConc_weights_clean_CC.csv" )
125
      write.csv( mPercrisk , file = "EffFrontierMinCVaRConc_percrisk_clean_CC.csv" )
126
      write.csv( EffFrontier_stats , file = "EffFrontierMinCVaRConc_stats_clean_CC.csv" )
127
   }
128
}else{
129
   if(!CC){
130
      write.csv( W , file = "EffFrontierMinCVaRConc_weights.csv" )
131
      write.csv( mPercrisk , file = "EffFrontierMinCVaRConc_percrisk.csv" )
132
      write.csv( EffFrontier_stats , file = "EffFrontierMinCVaRConc_stats.csv" )
133
   }else{
134
      write.csv( W , file = "EffFrontierMinCVaRConc_weights_CC.csv" )
135
      write.csv( mPercrisk , file = "EffFrontierMinCVaRConc_percrisk_CC.csv" )
136
      write.csv( EffFrontier_stats , file = "EffFrontierMinCVaRConc_stats_CC.csv" )
137
   }
138
}
139

140
# Mean/CVaR efficient portfolios
141
#--------------------------------
142

143
eps = 0.025
144
set.seed(1234)
145
rpconstraint<-constraint(assets=N, min_sum=(1-eps), max_sum=(1+eps), 
146
      min=rep(0,N), max=rep(1,N), weight_seq=generatesequence(),by=.001,rounding=3)
147
rp<- random_portfolios(rpconstraints=rpconstraint,permutations=200)
148
rp<-rbind( rp , diag( rep(1,4) ) )  
149
rp <-rp/rowSums(rp)
150
controlDE <- list(reltol=1e-6,steptol=150, itermax = 5000,trace = 100, strategy=6, c=.4,
151
                NP=as.numeric(nrow(rp)),initialpop=rp) 
152

153
# unconstrained solution is Minimum CVaR portfolio (having the property that percentage CVaR corresponds to porfolio weights):
154
minmu = min( apply(monthlyR,2,'mean' )); 
155
sol = PortfolioOptim(  minriskcriterion = "mES" , MinMaxComp = F, percriskcontribcriterion = "mES" , 
156
                Riskupper = Inf , mu = mu, sigma = sigma, M3=M3, M4=M4, controlDE = controlDE) 
157

158
W               = as.vector( sol[[1]] ) ;   vmu             = as.vector( sol[[2]] )
159
vrisk           = as.vector( sol[[3]] ) ;   mPercrisk       = as.vector( sol[[4]] )  
160
vmaxpercrisk    = max( sol[[4]] )       ;   vmaxriskcontrib = max( sol[[5]] ) 
161

162
mutarget = minmu+0.00001
163
while( mutarget <= maxmu ){
164
   print("------------")
165
   print( c("mutarget equal to",mutarget) )
166
   controlDE$initialpop = rbind( rp , W )
167
   controlDE$NP         = as.numeric( nrow(controlDE$initialpop) )
168
   sol = PortfolioOptim(  minriskcriterion = "mES" , MinMaxComp = F, percriskcontribcriterion = "mES" , 
169
                      Riskupper = Inf ,Returnlower= mutarget,
170
                      mu = mu, sigma = sigma, M3=M3, M4=M4, controlDE = controlDE) 
171
   W = rbind( W, as.vector( sol[[1]] ) )
172
   mPercrisk = rbind( mPercrisk , as.vector( sol[[4]] ) )
173
   vmu = c( vmu , as.vector( sol[[2]] ))
174
   vrisk = c( vrisk , as.vector( sol[[3]] ) )
175
   vmaxpercrisk = c( vmaxpercrisk , max( sol[[4]] ) )
176
   vmaxriskcontrib = c( vmaxriskcontrib , max( sol[[5]] ) )
177
   oldmutarget = mutarget
178
   mutarget = as.vector( sol[[2]] ) + 0.00001
179
   if( mutarget == oldmutarget ){ mutarget = mutarget +  0.00001 }
180
}
181

182
# For the highest return targets, a very high penalty parameter is (sometimes) needed
183

184
for( mutarget in c(seq( max(vmu) , maxmu, 0.00001),maxmu) ){
185
   print( c("mutarget equal to",mutarget) )
186
   controlDE$initialpop = rbind( rp , W )
187
   controlDE$NP         = as.numeric( nrow(controlDE$initialpop) )
188
   sol = PortfolioOptim(  minriskcriterion = "mES" , MinMaxComp = F, percriskcontribcriterion = "mES" , 
189
            Riskupper = Inf ,Returnlower= mutarget, penalty = 1e9,
190
            mu = mu, sigma = sigma, M3=M3, M4=M4, controlDE = controlDE) 
191
   W = rbind( W, as.vector( sol[[1]] ) )
192
   mPercrisk = rbind( mPercrisk , as.vector( sol[[4]] ) )
193
   vmu = c( vmu , as.vector( sol[[2]] ))
194
   vrisk = c( vrisk , as.vector( sol[[3]] ) )
195
   vmaxpercrisk = c( vmaxpercrisk , max( sol[[4]] ) )
196
   vmaxriskcontrib = c( vmaxriskcontrib , max( sol[[5]] ) )
197
}
198

199
EffFrontier_stats = cbind( vmu , vrisk , vmaxpercrisk , vmaxriskcontrib)
200
if(clean){
201
   if(!CC){
202
      write.csv( W , file = "EffFrontierMinCVaR_weights_clean.csv" )
203
      write.csv( mPercrisk , file = "EffFrontierMinCVaR_percrisk_clean.csv" )
204
      write.csv( EffFrontier_stats , file = "EffFrontierMinCVaR_stats_clean.csv" )
205
   }else{
206
      write.csv( W , file = "EffFrontierMinCVaR_weights_clean_CC.csv" )
207
      write.csv( mPercrisk , file = "EffFrontierMinCVaR_percrisk_clean_CC.csv" )
208
      write.csv( EffFrontier_stats , file = "EffFrontierMinCVaR_stats_clean_CC.csv" )
209
   }
210
}else{
211
   if(!CC){
212
      write.csv( W , file = "EffFrontierMinCVaR_weights.csv" )
213
      write.csv( mPercrisk , file = "EffFrontierMinCVaR_percrisk.csv" )
214
      write.csv( EffFrontier_stats , file = "EffFrontierMinCVaR_stats.csv" )
215
   }else{
216
      write.csv( W , file = "EffFrontierMinCVaR_weights_CC.csv" )
217
      write.csv( mPercrisk , file = "EffFrontierMinCVaR_percrisk_CC.csv" )
218
      write.csv( EffFrontier_stats , file = "EffFrontierMinCVaR_stats_CC.csv" )
219
   }
220
}
221

222

223
# Mean/StdDev efficient portfolios (use quadprog)
224
#-------------------------------------------------
225

226
library(quadprog)
227
N = 4 ;  maxweight = 1; minweight = 0; sumweights = 1; 
228
Amat = rbind( rep(1,N) ,  diag(x =1,nrow=N,ncol=N) ,  diag(x =-1,nrow=N,ncol=N) , as.numeric(mu) );
229
bvec =  c( sumweights , rep(minweight,N), rep(-maxweight,N)  ) 
230
dvec = matrix( rep(0,N) , ncol=1 )
231

232
mutarget = -10000; 
233
# min(-d^T b + 1/2 b^T D b) with the constraints A^T b >= b_0.
234
optw = solve.QP( Dmat = sigma   , dvec = dvec , Amat = t(Amat) , 
235
   bvec = matrix( c(bvec,mutarget) , ncol = 1) , meq =1  )$solution
236
sol = ES(weights=optw, portfolio_method="component", mu = mu, sigma = sigma, m3=M3, m4=M4,invert=FALSE)
237
W               = optw                             ;   vmu             = sum(optw*mu)
238
vrisk           = sol$MES                          ;   mPercrisk       = as.vector( sol$pct_contrib_MES )  
239
vmaxpercrisk    = max( sol$pct_contrib_MES )       ;   vmaxriskcontrib = max( sol$contribution ) 
240

241
# unconstrained solution is Minimum CVaR portfolio (having the property that percentage CVaR corresponds to porfolio weights):
242
minmu = min( apply(monthlyR,2,'mean' )); 
243

244

245
for( mutarget in seq(minmu+0.00005,maxmu,0.00005) ){
246
   optw = solve.QP( Dmat = sigma   , dvec = dvec , Amat = t(Amat) , 
247
          bvec = matrix( c(bvec,mutarget) , ncol = 1) , meq =1  )$solution
248
   sol = ES(weights=optw, portfolio_method="component", mu = mu, sigma = sigma, m3=M3, m4=M4,invert=FALSE)
249
   W = rbind( W, optw )
250
   mPercrisk = rbind( mPercrisk , as.vector( sol$pct_contrib_MES ) )
251
   vmu = c( vmu , sum(optw*mu) )
252
   vrisk = c( vrisk , sol$MES )
253
   vmaxpercrisk = c( vmaxpercrisk , max( sol$pct_contrib_MES ) )
254
   vmaxriskcontrib = c( vmaxriskcontrib , max( sol$contribution ) )
255
}
256

257
if(clean){
258
   write.csv( W , file = "EffFrontierMinVar_weights_clean.csv" )
259
   write.csv( mPercrisk , file = "EffFrontierMinVar_percrisk_clean.csv" )
260
   EffFrontier_stats = cbind( vmu , vrisk , vmaxpercrisk , vmaxriskcontrib)
261
   write.csv( EffFrontier_stats , file = "EffFrontierMinVar_stats_clean.csv" )
262
}else{
263
   write.csv( W , file = "EffFrontierMinVar_weights.csv" )
264
   write.csv( mPercrisk , file = "EffFrontierMinVar_percrisk.csv" )
265
   EffFrontier_stats = cbind( vmu , vrisk , vmaxpercrisk , vmaxriskcontrib)
266
   write.csv( EffFrontier_stats , file = "EffFrontierMinVar_stats.csv" )
267
}
268

269

270

271

272
Product

Resources

Company
