CoCalc -- demo_JPM2024MinDownsideRisk.R

GitHub Repository: braverock/portfolioanalytics
Path: blob/master/demo/demo_JPM2024MinDownsideRisk.R
¹⁴³³ views
1
## This R script reproduces all the Exhibits in the paper 
2
## "Minimum Downside Risk Portfolios" by R.D. Martin,
3
## S. Stoyanov, X. Zhao and P. Sarker, published in the 
4
## Oct. 2024 issue of the Journal of Portfolio Management.
5

6
##
7
## Copy/paste this script into your own computer R file. Then
8
## run code lines 23 to 229, which creates functions needed in
9
## subsequent code that replicates the Exhibits. We recommend
10
## running the subsequent code in chunks to replicate each of
11
## the Exhibits in the JPM paper.
12

13
## Running Times for an Intel(R) Core(TM) i7-10750H Processor:
14
## Exhibits 1-5: 10 seconds, with 9 seconds for Exhibit 5
15
## Exhibits 6,8,10,12: Approximately 2 minutes each
16
## Exhibits 14,16,18: Approximately 3.5 minutes each
17
## Other Exhibits: Negligible
18

19
#### Load needed R functions
20
####
21

22
## divHHImat.R
23
divHHImat <- function(wtsmat){
24
  n <- nrow(wtsmat)
25
  if(n < 1){
26
    warning("empty data set")
27
    return()
28
  }
29
  diversification <- rep(0, n)
30
  for(i in 1:n){
31
    diversification[i] <- 1 - sum(wtsmat[i,]^2)
32
  }
33
  DIV <- diversification
34
  return(DIV)
35
}
36

37
## TOcontrol.R
38
TOcontrol <- function(wts, delta){
39
  idx <- index(wts)
40
  out <- copy(wts)
41
  TO <- rep(NA, length(idx))
42
  for(i in 2:length(idx)){
43
    currentTO <- sum(abs(coredata(wts[idx[i], ]) - coredata(wts[idx[i-1], ])))
44
    TO[i] <- currentTO
45
    if(currentTO <= delta){
46
      out[idx[i], ] <- out[idx[i-1], ]
47
    }
48
  }
49
  return(wts = out)
50
}
51

52
## ToDivMES.R
53
ToDivMES <- function(x){
54
  ## wts: a list with xts objects wts.MV, wts.MES05, wts.MES05TOC
55
  
56
  # TO Values
57
  wts.MV <- x$wts.MV
58
  MV.TO <- 100*coredata(turnOver(wts.MV))
59
  muMV.TO <- round(mean(MV.TO), 1)
60
  sdMV.TO <- round(sd(MV.TO), 1)
61
  
62
  wts.MES05 <- x$wts.MES05
63
  MES05.TO <- 100*coredata(turnOver(wts.MES05))
64
  muMES05.TO <- round(mean(MES05.TO), 1)
65
  sdMES05.TO <- round(sd(MES05.TO), 1)
66
  
67
  wts.MES05TOC <- x$wts.MES05TOC
68
  MES05.TOC <- 100*coredata(turnOver(wts.MES05TOC))
69
  muMES05.TOC <- round(mean(MES05.TOC), 1)
70
  sdMES05.TOC <- round(sd(MES05.TOC), 1)
71
  
72
  # DIV Values
73
  MV.DIV <- 100*coredata(divHHI(wts.MV))
74
  muMV.DIV <- round(mean(MV.DIV), 1)
75
  sdMV.DIV <- round(sd(MV.DIV), 1)
76
  
77
  MES05.DIV <- 100*coredata(divHHI(wts.MES05))
78
  muMES05.DIV <- round(mean(MES05.DIV), 1)
79
  sdMES05.DIV <- round(sd(MES05.DIV), 1)
80
  
81
  MES05TOC.DIV <- 100*coredata(divHHI(wts.MES05TOC))
82
  muMES05TOC.DIV <- round(mean(MES05TOC.DIV), 1)
83
  sdMES05TOC.DIV <- round(sd(MES05TOC.DIV), 1)
84
  
85
  # TO and DIV data frame
86
  muSdTO_DIV <- rbind(c(muMV.TO, sdMV.TO, muMV.DIV, sdMV.DIV),
87
                      c(muMES05.TO, sdMES05.TO, muMES05.DIV, sdMES05.DIV),
88
                      c(muMES05.TOC, sdMES05.TOC, muMES05TOC.DIV, sdMES05TOC.DIV))
89
  muSdTO_DIV <- data.frame(muSdTO_DIV)
90
  names(muSdTO_DIV) <- c("TO Mean", "TO StdDev", "DIV Mean", "DIV StdDev")
91
  row.names(muSdTO_DIV) <- c("MV", "MES05", "MES05-TOC")
92
  return(muSdTO_DIV) 
93
}
94

95
## ToDivMCSM.R
96
ToDivMCSM <- function(x){
97
  ## wts: a list with xts objects wts.MV, wts.MES05, wts.MCSM15
98
  
99
  # TO Values
100
  wts.MV <- x$wts.MV
101
  MV.TO <- 100*coredata(turnOver(wts.MV))
102
  muMV.TO <- round(mean(MV.TO), 1)
103
  sdMV.TO <- round(sd(MV.TO), 1)
104
  
105
  wts.MES05 <- x$wts.MES05
106
  MES05.TO <- 100*coredata(turnOver(wts.MES05))
107
  muMES05.TO <- round(mean(MES05.TO), 1)
108
  sdMES05.TO <- round(sd(MES05.TO), 1)
109
  
110
  wts.MCSM15 <- x$wts.MCSM15
111
  MCSM15.TO <- 100*coredata(turnOver(wts.MCSM15))
112
  muMCSM15.TO <- round(mean(MCSM15.TO), 1)
113
  sdMCSM15.TO <- round(sd(MCSM15.TO), 1)
114
  
115
  # DIV Values
116
  MV.DIV <- 100*coredata(divHHI(wts.MV))
117
  muMV.DIV <- round(mean(MV.DIV), 1)
118
  sdMV.DIV <- round(sd(MV.DIV), 1)
119
  
120
  MES05.DIV <- 100*coredata(divHHI(wts.MES05))
121
  muMES05.DIV <- round(mean(MES05.DIV), 1)
122
  sdMES05.DIV <- round(sd(MES05.DIV), 1)
123
  
124
  MCSM15.DIV <- 100*coredata(divHHI(wts.MCSM15))
125
  muMCSM15.DIV <- round(mean(MCSM15.DIV), 1)
126
  sdMCSM15.DIV <- round(sd(MCSM15.DIV), 1)
127
  
128
  # TO and DIV data frame
129
  muSdTO_DIV <- rbind(c(muMV.TO, sdMV.TO, muMV.DIV, sdMV.DIV),
130
                      c(muMES05.TO, sdMES05.TO, muMES05.DIV, sdMES05.DIV),
131
                      c(muMCSM15.TO, sdMCSM15.TO, muMCSM15.DIV, sdMCSM15.DIV))
132
  muSdTO_DIV <- data.frame(muSdTO_DIV)
133
  names(muSdTO_DIV) <- c("TO Mean", "TO StdDev", "DIV Mean", "DIV StdDev")
134
  row.names(muSdTO_DIV) <- c("MV", "MES05", "MCSM15")
135
  return(muSdTO_DIV) 
136
}
137

138

139
## Pushpak function to calculate the mean and stdev of TO and DIV
140
## Here we changed Pushpak's function name MeanStd_TODIV to ToDivMeanSd
141

142
ToDivMeanSd <- function(weights_list){
143
  
144
  # List objects for storing turnover and diversification for all portfolios
145
  turnover_list <- list()
146
  diversification_list <- list()
147
  
148
  # Calculate turnover and diversification for all portfolios
149
  for (i in 1:length(weights_list)) {
150
    portfolio_name <- names(weights_list)[i]
151
    
152
    # Extract portfolio weights from the list object
153
    assign(paste0("wts_", portfolio_name), weights_list[[i]])
154
    
155
    # Calculate turnover and diversification and save in separate list objects
156
    turnover_list[[paste0("TO_", portfolio_name)]] <- 100*coredata(PCRA::turnOver(get(paste0("wts_", portfolio_name))))
157
    diversification_list[[paste0("DIV_", portfolio_name)]] <- 100*coredata(divHHI(get(paste0("wts_", portfolio_name))))
158
  }
159
  
160
  # Calculate mean of turnover
161
  mu_turnover_list <- lapply(turnover_list, mean)
162
  mu_turnover_list <- lapply(mu_turnover_list, round, 1)
163
  
164
  # Calculate standard deviation of turnover
165
  sd_turnover_list <- lapply(turnover_list, sd)
166
  sd_turnover_list <- lapply(sd_turnover_list, round, 1)
167
  
168
  # Calculate mean of diversification
169
  mu_diversification_list <- lapply(diversification_list, mean)
170
  mu_diversification_list <- lapply(mu_diversification_list, round, 1)
171
  
172
  # Calculate standard deviation of diversification
173
  sd_diversification_list <- lapply(diversification_list, sd)
174
  sd_diversification_list <- lapply(sd_diversification_list, round, 1)
175
  
176
  # Mean and stdev of turnover
177
  mu_turnover <- t(as.data.frame(mu_turnover_list))
178
  row.names(mu_turnover) <- names(weights_list)
179
  colnames(mu_turnover) <- "TO Mean"
180
  
181
  sd_turnover <- t(as.data.frame(sd_turnover_list))
182
  row.names(sd_turnover) <- names(weights_list)
183
  colnames(sd_turnover) <- "TO StdDev"
184
  
185
  # Mean and stdev of diversification
186
  mu_diversification <- t(as.data.frame(mu_diversification_list))
187
  row.names(mu_diversification) <- names(weights_list)
188
  colnames(mu_diversification) <- "DIV Mean"
189
  
190
  sd_diversification <- t(as.data.frame(sd_diversification_list))
191
  row.names(sd_diversification) <- names(weights_list)
192
  colnames(sd_diversification) <- "DIV StdDev"
193
  
194
  # Combine into a single dataframe
195
  muStd_TO_DIV <- cbind(mu_turnover, sd_turnover, mu_diversification, sd_diversification)
196
  
197
  return(muStd_TO_DIV)
198
}
199

200

201
## ratioFromThresholdTdist.R
202
ratioFromThresholdTdist <- function(eta = 1.0, df = 5)
203
{
204
  integrand.top <- function(x, eta)
205
    (x - eta) * dt(x, df)
206
  
207
  value.top <- integrate(integrand.top, eta, 
208
                         Inf, eta = eta)$value
209
  
210
  integrand.bottom <- function(x, eta)
211
    (x - eta)^2 * dt(x, df)
212
  
213
  value.bottom <- integrate(integrand.bottom, eta, Inf, 
214
                            eta = eta)$value
215
  ratio <- value.top/sqrt(value.bottom)
216
  ratio
217
}
218

219
## thresholdFromTailProbTdist.R
220
thresholdFromTailProbTdist <- function(qtl, df = 5,
221
                                       interval = c(1e-6, 20)) # 1e-6
222
{
223
  # Tail probabilities gamma = 1 - alpha, e.g., if alpha = 0.9,
224
  # then the upper tail probability is gamma = 0.1
225
  obj <- function(q, eta)
226
    q - ratioFromThresholdTdist(eta, df = df)
227
  
228
  uniroot(obj, interval = interval, q = qtl, check.conv = TRUE, tol = 1e-8)$root
229
}
230

231
#### End of functions needed for the following R script.
232
####
233

234
## Load data for Exhibits 1 - 5
235
library(PCRA)
236
library(xts)
237
stocksCRSPweekly <- getPCRAData("stocksCRSPweekly")
238
dateRange    <- c("2004-01-01", "2005-12-31")
239
stockItems <- c("Date", "TickerLast", "CapGroupLast", "Return", 
240
                "MktIndexCRSP", "Ret13WkBill")
241
returnsAll <- selectCRSPandSPGMI("weekly",
242
                                 dateRange = dateRange,
243
                                 stockItems = stockItems, 
244
                                 factorItems = NULL, 
245
                                 subsetType = "CapGroupLast",
246
                                 subsetValues = "SmallCap", 
247
                                 outputType = "xts")
248

249
returns <- returnsAll[ , 1:30]
250
RFts <- returnsAll[ , 108] 
251
RFmean <- mean(RFts)
252

253

254
## Exhibit 1
255

256
library(PortfolioAnalytics)
257
library(CVXR)
258
library(data.table)
259
pspec <- portfolio.spec(assets = names(returns))
260
pspecFI <- add.constraint(pspec, type = "full_investment")
261
pspecLO <- add.constraint(portfolio = pspecFI, type = "long_only")
262

263
## Mean-ES Long-Only Efront p = 5% with ES Ratio
264
p <- 0.05
265
pspecESLO <- add.objective(pspecLO, type = "risk", name = "ES",
266
                           arguments = list(p = p))
267
meanESlo.ef <- create.EfficientFrontier(returns, portfolio = pspecESLO, 
268
                                        type = "mean-ES")
269

270
xlim = c(0.0, 0.20)
271
ylim = c(-0.004, 0.015)
272
chart.EfficientFrontier(meanESlo.ef, match.col = "ES", type = "l",
273
                        chart.assets = TRUE, rf = RFmean,
274
                        labels.assets = FALSE, cex.assets = 1,
275
                        main = NULL,
276
                        RAR.text = "ES ratio", pch = 16, lwd = 1.5,
277
                        cex = 2.5, cex.axis = 1.1,
278
                        xlim = xlim, ylim = ylim) 
279

280

281
## Exhibit 2
282

283
efDat <- meanESlo.ef$frontier
284
efMat <- as.matrix(efDat[ , ])
285
dimnames(efMat)[[1]] <- 1:25
286
MU <- efMat[ , 1]
287
efWts <- efMat[ , -(1:3)]
288
DIV <- divHHImat(efWts)
289
plot(MU, DIV, type = "b", pch = 20, ylim = c(0,1))
290
abline(h = 0.9, lty = "dotted")
291

292

293
## Exhibit 3
294

295
p <- 0.05
296
pspecESLO <- add.objective(pspecLO, type = "risk", name = "ES",
297
                           arguments = list(p = p))
298
pspecLObox <- add.constraint(portfolio = pspecFI, type = "box", 
299
                             min = 0.02, max = 0.1)
300
pspecESLObox <- add.objective(pspecLObox, type = "risk", name = "ES",
301
                              arguments = list(p = p))
302
pspecLSbox <- add.constraint(portfolio = pspecFI, type = "box", 
303
                             min = -0.1, max = 0.1)
304
pspecESLSbox <- add.objective(pspecLSbox, type = "risk", name = "ES",
305
                              arguments = list(p = p))
306

307
portfList <- combine.portfolios(list(pspecESLSbox, pspecESLO, pspecESLObox))
308
legendLabels <- c("Long Short Box (-0.1, 0.1)", "Long Only", "Long Only Box (0.02, 0.1)") 
309

310
chart.EfficientFrontierOverlay(returns, portfolio_list = portfList, 
311
                               type = "mean-ES", match.col = "ES", 
312
                               legend.loc = "topright", chart.assets = TRUE,
313
                               legend.labels = legendLabels, cex.legend = 1,
314
                               labels.assets = FALSE, lwd = c(2, 2, 3),
315
                               col = c("dark green", "black", "dark red"),
316
                               lty = c("dashed", "solid", "dotted"),
317
                               xlim = xlim, ylim = ylim, main = NULL) 
318

319

320

321
## Exhibit 4
322

323
pspecES05 <- add.objective(portfolio = pspecLO, type = "risk", name = "ES", 
324
                           arguments = list(p=0.05))
325
pspecES25 <- add.objective(portfolio = pspecLO, type = "risk", name = "ES", 
326
                           arguments = list(p=0.25))
327
pspecES50 <- add.objective(portfolio = pspecLO, type = "risk", name = "ES", 
328
                           arguments = list(p=0.50))
329

330
# Combine the portfolios into a list
331
portfESlist <- combine.portfolios(list(pspecES50, pspecES25, pspecES05))
332

333
# Plot the efficient frontier overlay of the portfolios with varying tail probabilities
334
legendESlabels <- c("ES (p = 0.50)", "ES (p = 0.25)", "ES (p = 0.05)")
335

336
portfList <- combine.portfolios(list(pspecESLSbox, pspecESLO, pspecESLObox))
337
legendLabels <- c("Long Short Box (-0.1, 0.1)", "Long Only", "Long Only Box (0.02, 0.1)") 
338

339
chart.EfficientFrontierOverlay(returns, portfolio_list = portfESlist, 
340
                               type = "mean-ES", match.col = "ES", 
341
                               legend.loc = "topright", chart.assets = TRUE,
342
                               legend.labels = legendESlabels, cex.legend = 1,
343
                               labels.assets = FALSE, lwd = c(2,2,2),
344
                               col = c("dark green" , "black", "dark red"),
345
                               lty = c("solid", "dashed", "dotted"),
346
                               xlim = xlim, ylim = ylim, main = NULL)
347

348

349
## Exhibit 5 (9 seconds)
350

351
pspecESLO_050 <- add.objective(pspecLO, type = "risk", name = "ES",
352
                               arguments = list(p = 0.050))
353

354
# The follow function takes about 1 minute (check)
355
# reduce n.portfolios for faster, but less accurate, rendition
356
chart.EfficientFrontierCompare(returns, pspecESLO_050, risk_type = "ES", 
357
                               guideline = TRUE,  cex.axis = 1.2,
358
                               match.col = c("StdDev", "ES"),
359
                               n.portfolios = 10,
360
                               lwd=c(1.2, 1.2, 1.0, 1.0),
361
                               col = c(2,1,1,1), lty = c(2,1,4,4),
362
                               xlim = c(0.00, 0.08), ylim = c(0.0, 0.013), 
363
                               legend.loc = "topleft", main = NULL)
364
# A slightly better plot is obtained with larger n.portfolios, with very
365
# small % changes in Risk and Return
366

367

368
## Load packages
369

370
library(PortfolioAnalytics)
371
library(CVXR)
372
library(data.table)
373
library(xts)
374
library(PCRA)
375

376
# Load CRSP daily smallcap returns for Exhibits 6-7, 8-9, 10-11
377

378
stocksCRSPdaily <- getPCRAData(dataset = "stocksCRSPdaily")
379
dateRange <- c("1993-01-01","2015-12-31")
380
smallcapTS <- selectCRSPandSPGMI(
381
  periodicity = "daily",
382
  dateRange = dateRange,
383
  stockItems = c("Date", "TickerLast", "CapGroupLast", "Return", 
384
                 "MktIndexCRSP", "Ret13WkBill"),
385
  factorItems = NULL,
386
  subsetType = "CapGroupLast",
387
  subsetValues = "SmallCap",
388
  outputType = "xts")
389

390
# Extract Market and RF from smallcapTS
391
Market <- smallcapTS[ , 107]
392
names(Market) <- "Market"
393
RF <- smallcapTS[ , 108]
394
names(RF)  <- "RF"
395

396
# Remove "MktIndexCRSP", "Ret13WkBill" from smallcapTS
397
smallcapTS <- smallcapTS[ , -c(107,108)]
398

399

400
## Exhibit 6 (2 minutes and 0 seconds)
401

402
ret <- smallcapTS[ , 1:30]
403

404
# Generate MV, and MES portfolios
405
pspec <- portfolio.spec(assets = names(ret))
406
pspecFI <- add.constraint(pspec, type = "full_investment")
407
pspecLO <- add.constraint(pspecFI, type = "long_only")
408
pspecMV <- add.objective(pspecLO, type = "risk", name = "var")
409
pspecMES05 <- add.objective(pspecLO, type = "risk", name = "ES",
410
                            arguments = list(p=0.05))
411

412
# Optimize Portfolio with Monthly Rebalancing
413
window <- 260
414
bt.MV <- optimize.portfolio.rebalancing(ret, pspecMV,
415
                                        optimize_method = "CVXR",
416
                                        rebalance_on = "months",
417
                                        rolling_window = window)
418

419
bt.MES05 <- optimize.portfolio.rebalancing(ret, pspecMES05,
420
                                           optimize_method = "CVXR",
421
                                           rebalance_on = "months",
422
                                           rolling_window = window)
423

424
# Extract time series of portfolio weights
425
wts.MV <- extractWeights(bt.MV)
426
wts.MV <- wts.MV[complete.cases(wts.MV),]
427
wts.MES05 <- extractWeights(bt.MES05)
428
wts.MES05 <- wts.MES05[complete.cases(wts.MES05),]
429

430
wts.MES05TOC <- TOcontrol(wts.MES05, 0.9) # Optimal for 1-30
431

432
# For table below
433
wts.comb21 <- list(wts.MV = wts.MV, wts.MES05 = wts.MES05, 
434
                   wts.MES05TOC = wts.MES05TOC)
435

436
# Compute cumulative returns of the portfolios
437
MV <- Return.rebalancing(ret, wts.MV)
438
MES05 <- Return.rebalancing(ret, wts.MES05)
439
MES05TOC <- Return.rebalancing(ret, wts.MES05TOC)
440

441
# Combine MV, MES05, MES05_TOC gross cumulative returns
442
ret.comb <- na.omit(merge(MV, MES05, MES05TOC, Market))
443
names(ret.comb) <- c("MV", "MES05", "MES05-TOC", "Market")
444

445
# For table below
446
ret.comb21 <- ret.comb[ , -4]
447

448
backtest.plot(ret.comb, plotType = "cumRet",
449
              main = "MV, MES05, MES05-TOC(0.9), Stocks 1-30",
450
              colorSet = c("red","darkgreen","darkblue","black"), 
451
              ltySet = c(3, 1, 1, 1), lwdSet = c(0.7, 0.7, 0.7, 0.7))
452

453

454
## Exhibit 7
455

456
# Create TO and DIV values data frame
457
muSdTO_DIV <- ToDivMeanSd(wts.comb21)
458

459
ret.comb21Short <- ret.comb21["2006/2014", ]
460

461
dat <- ret.comb21Short
462
SR <- RPESE::SR.SE(dat)$SR
463
DSR <- RPESE::DSR.SE(dat)$DSR
464
SR_DSR <- data.frame(round(sqrt(252)*cbind(SR,DSR),2))
465

466
# Combine the two data frames
467
portStats <- data.frame(muSdTO_DIV, SR_DSR)
468
row.names(portStats) <- names(dat)
469
portStats
470

471

472
## Exhibit 8 (1 minute and 55 seconds)
473

474
ret <- smallcapTS[ , 31:60]
475

476
# Generate MV, and MES portfolios
477
pspec <- portfolio.spec(assets = names(ret))
478
pspecFI <- add.constraint(pspec, type = "full_investment")
479
pspecLO <- add.constraint(pspecFI, type = "long_only")
480
pspecMV <- add.objective(pspecLO, type = "risk", name = "var")
481
pspecMES05 <- add.objective(pspecLO, type = "risk", name = "ES",
482
                            arguments = list(p=0.05))
483

484
# Optimize Portfolio at Monthly Rebalancing and 500-Day Training
485
window <- 260
486
bt.MV <- optimize.portfolio.rebalancing(ret, pspecMV,
487
                                        optimize_method = "CVXR",
488
                                        rebalance_on = "months",
489
                                        rolling_window = window)
490

491
bt.MES05 <- optimize.portfolio.rebalancing(ret, pspecMES05,
492
                                           optimize_method = "CVXR",
493
                                           rebalance_on = "months",
494
                                           rolling_window = window)
495

496
# Extract time series of portfolio weights
497
wts.MV <- extractWeights(bt.MV)
498
wts.MV <- wts.MV[complete.cases(wts.MV),]
499
wts.MES05 <- extractWeights(bt.MES05)
500
wts.MES05 <- wts.MES05[complete.cases(wts.MES05),]
501

502
wts.MES05TOC <- TOcontrol(wts.MES05, 0.5) # Optimal for 31-60
503

504
# For table below
505
wts.comb22 <- list(wts.MV = wts.MV, wts.MES05 = wts.MES05, 
506
                   wts.MES05TOC = wts.MES05TOC)
507

508
# Compute cumulative returns of the portfolios
509
MV <- Return.rebalancing(ret, wts.MV)
510
MES05 <- Return.rebalancing(ret, wts.MES05)
511
MES05TOC <- Return.rebalancing(ret, wts.MES05TOC)
512

513
# Combine MV, MES05, MES05_TOC gross cumulative returns
514
ret.comb <- na.omit(merge(MV, MES05, MES05TOC, Market, all=F))
515
names(ret.comb) <- c("MV", "MES05", "MES05-TOC", "Market")
516

517
# For table below
518
ret.comb22 <- ret.comb[ , -4]
519

520
backtest.plot(ret.comb, plotType = "cumRet",
521
              main = "MV, MES05, MES05-TOC(0.5), Stocks 31-60",
522
              colorSet = c("red","darkgreen","darkblue","black"), 
523
              ltySet = c(3, 1, 1, 1), lwdSet = c(0.7, 0.7, 0.7, 0.7))
524

525

526
## Exhibit 9
527

528
# Create TO and DIV values data frame
529
muSdTO_DIV <- ToDivMeanSd(wts.comb22)
530

531
ret.comb22Short <- ret.comb22["2006/2014", ]
532

533
dat <- ret.comb22Short
534
SR <- RPESE::SR.SE(dat)$SR
535
DSR <- RPESE::DSR.SE(dat)$DSR
536
SR_DSR <- data.frame(round(sqrt(252)*cbind(SR,DSR),2))
537

538
# Combine the two data frames
539
portStats <- data.frame(muSdTO_DIV, SR_DSR)
540
row.names(portStats) <- names(dat)
541
portStats
542

543

544
## Exhibit 10 (1 minute and 55 seconds)
545

546
ret <- smallcapTS[ , 61:90]
547

548
# Generate MV, and MES portfolios
549
pspec <- portfolio.spec(assets = names(ret))
550
pspecFI <- add.constraint(pspec, type = "full_investment")
551
pspecLO <- add.constraint(pspecFI, type = "long_only")
552
pspecMV <- add.objective(pspecLO, type = "risk", name = "var")
553
pspecMES05 <- add.objective(pspecLO, type = "risk", name = "ES",
554
                            arguments = list(p=0.05))
555

556
# Optimize Portfolio at Monthly Rebalancing
557
window <- 260
558
bt.MV <- optimize.portfolio.rebalancing(ret, pspecMV,
559
                                        optimize_method = "CVXR",
560
                                        rebalance_on = "months",
561
                                        rolling_window = window)
562

563
bt.MES05 <- optimize.portfolio.rebalancing(ret, pspecMES05,
564
                                           optimize_method = "CVXR",
565
                                           rebalance_on = "months",
566
                                           rolling_window = window)
567

568
# Extract time series of portfolio weights
569
wts.MV <- extractWeights(bt.MV)
570
wts.MV <- wts.MV[complete.cases(wts.MV),]
571
wts.MES05 <- extractWeights(bt.MES05)
572
wts.MES05 <- wts.MES05[complete.cases(wts.MES05),]
573

574
wts.MES05TOC <- TOcontrol(wts.MES05, 0.5) # Optimal for 61-90
575

576
# For table below
577
wts.comb23 <- list(wts.MV = wts.MV, wts.MES05 = wts.MES05, 
578
                   wts.MES05TOC = wts.MES05TOC)
579

580
# Compute cumulative returns of the portfolios
581
MV <- Return.rebalancing(ret, wts.MV)
582
MES05 <- Return.rebalancing(ret, wts.MES05)
583
MES05TOC <- Return.rebalancing(ret, wts.MES05TOC)
584

585
# Combine MV, MES05, MES05_TOC gross cumulative returns
586
ret.comb <- na.omit(merge(MV, MES05, MES05TOC, Market, all=F))
587
names(ret.comb) <- c("MV", "MES05", "MES05-TOC", "Market")
588

589
# For table below
590
ret.comb23 <- ret.comb[ , -4]
591

592
backtest.plot(ret.comb, plotType = "cumRet",
593
              main = "MV, MES05, MES05-TOC(0.5), Stocks 61-90",
594
              colorSet = c("red","darkgreen","darkblue","black"), 
595
              ltySet = c(3, 1, 1, 1), lwdSet = c(0.7, 0.7, 0.7, 0.7))
596

597

598

599
## Exhibit 11
600

601
# Create TO and DIV values data frame
602

603
muSdTO_DIV <- ToDivMeanSd(wts.comb23)
604

605
ret.comb23Short <- ret.comb23["2006/2014", ]
606
dat <- ret.comb23Short
607
SR <- RPESE::SR.SE(dat)$SR
608
DSR <- RPESE::DSR.SE(dat)$DSR
609
SR_DSR <- data.frame(round(sqrt(252)*cbind(SR,DSR),2))
610

611
# Combine the two data frames
612
portStats <- data.frame(muSdTO_DIV, SR_DSR)
613
row.names(portStats) <- names(dat)
614
portStats
615

616
## Load packages again (not necessary)
617
library(PortfolioAnalytics)
618
library(CVXR)
619
library(data.table)
620
library(xts)
621
library(PCRA)
622

623
## Load daily microcap returns for Exhibits 12-13
624

625
stocksCRSPdaily <- getPCRAData(dataset = "stocksCRSPdaily")
626
dateRange <- c("1993-01-01","2015-12-31")
627
microcapTS <- selectCRSPandSPGMI(
628
  periodicity = "daily",
629
  dateRange = dateRange,
630
  stockItems = c("Date", "TickerLast", "CapGroupLast", "Return", 
631
                 "MktIndexCRSP", "Ret13WkBill"),
632
  factorItems = NULL,
633
  subsetType = "CapGroupLast",
634
  subsetValues = "MicroCap",
635
  outputType = "xts")
636

637
# Extract Market and RF from microcapTS
638
Market <- microcapTS[ , 35]
639
names(Market) <- "Market"
640
RF <- microcapTS[ , 36]
641
names(RF)  <- "RF"
642

643

644
# Remove "MktIndexCRSP", "Ret13WkBill" from smallcapTS
645
microcapTS <- microcapTS[ , -c(35, 36)]
646

647

648
## Exhibit 12 (1 minute and 58 seconds)
649
ret <- microcapTS
650

651
# Generate MV, and MES portfolios
652
pspec <- portfolio.spec(assets = names(ret))
653
pspecFI <- add.constraint(pspec, type = "full_investment")
654
pspecLO <- add.constraint(pspecFI, type = "long_only")
655
pspecMV <- add.objective(pspecLO, type = "risk", name = "var")
656
pspecMES05 <- add.objective(pspecLO, type = "risk", name = "ES",
657
                            arguments = list(p=0.05))
658

659
# Optimize Portfolio at Monthly Rebalancing
660
window <- 260
661
bt.MV <- optimize.portfolio.rebalancing(ret, pspecMV,
662
                                        optimize_method = "CVXR",
663
                                        rebalance_on = "months",
664
                                        rolling_window = window)
665

666
bt.MES05 <- optimize.portfolio.rebalancing(ret, pspecMES05,
667
                                           optimize_method = "CVXR",
668
                                           rebalance_on = "months",
669
                                           rolling_window = window)
670

671
# Extract time series of portfolio weights
672
wts.MV <- extractWeights(bt.MV)
673
wts.MV <- wts.MV[complete.cases(wts.MV),]
674
wts.MES05 <- extractWeights(bt.MES05)
675
wts.MES05 <- wts.MES05[complete.cases(wts.MES05),]
676

677
wts.MES05TOC <- TOcontrol(wts.MES05, 0.5)
678

679
# For table below
680
wts.comb24 <- list(wts.MV = wts.MV, wts.MES05 = wts.MES05, 
681
                   wts.MES05TOC = wts.MES05TOC)
682

683
# Compute cumulative returns of the portfolios
684
MV <- Return.rebalancing(ret, wts.MV)
685
MES05 <- Return.rebalancing(ret, wts.MES05)
686
MES05TOC <- Return.rebalancing(ret, wts.MES05TOC)
687

688
# Combine MV, MES05, MES05_TOC gross cumulative returns
689
ret.comb <- na.omit(merge(MV, MES05, MES05TOC, Market, all=F))
690
names(ret.comb) <- c("MV", "MES05", "MES05-TOC", "Market")
691

692
# For table below
693
ret.comb24 <- ret.comb[ , -4]
694

695
backtest.plot(ret.comb, plotType = "cumRet",
696
              main = "MV, MES05, MES05-TOC(0.5), 34 Microcap Stocks",
697
              colorSet = c("red","darkgreen","darkblue","black"), 
698
              ltySet = c(3, 1, 1, 1), lwdSet = c(0.7, 0.7, 0.7, 0.7))
699

700

701

702

703
## Exhibit 13
704

705
# Create TO and DIV values data frame
706
muSdTO_DIV <- ToDivMeanSd(wts.comb24)
707

708
ret.comb24Short <- ret.comb24["2006/2014", ]
709
dat <- ret.comb24Short
710
SR <- RPESE::SR.SE(dat)$SR
711
DSR <- RPESE::DSR.SE(dat)$DSR
712
SR_DSR <- data.frame(round(sqrt(252)*cbind(SR,DSR),2))
713

714
# Combine the two data frames
715
portStats <- data.frame(muSdTO_DIV, SR_DSR)
716
row.names(portStats) <- names(dat)
717
portStats
718

719

720
## Load packages again (not necessary to repeat)
721

722
library(PortfolioAnalytics)
723
library(CVXR)
724
library(data.table)
725
library(xts)
726
library(PCRA)
727

728
# Load CRSP smallcap returns for Exhibits 14-15, 16-17, 18-19
729

730
stocksCRSPdaily <- getPCRAData(dataset = "stocksCRSPdaily")
731
dateRange <- c("1993-01-01","2015-12-31")
732
smallcapTS <- selectCRSPandSPGMI(
733
  periodicity = "daily",
734
  dateRange = dateRange,
735
  stockItems = c("Date", "TickerLast", "CapGroupLast", "Return", 
736
                 "MktIndexCRSP", "Ret13WkBill"),
737
  factorItems = NULL,
738
  subsetType = "CapGroupLast",
739
  subsetValues = "SmallCap",
740
  outputType = "xts")
741

742
# Extract Market and RF from smallcapTS
743
Market <- smallcapTS[ , 107]
744
names(Market) <- "Market"
745
RF <- smallcapTS[ , 108]
746
names(RF)  <- "RF"
747

748
# Remove "MktIndexCRSP", "Ret13WkBill" from smallcapTS
749
smallcapTS <- smallcapTS[ , -c(107,108)]
750

751

752
## Exhibit 14 (3 minutes and 28 seconds)
753
ret <- smallcapTS[ , 1:30]
754

755
# Generate MV, and MES portfolios
756
pspec <- portfolio.spec(assets = names(ret))
757
pspecFI <- add.constraint(pspec, type = "full_investment")
758
pspecLO <- add.constraint(pspecFI, type = "long_only")
759
pspecMV <- add.objective(pspecLO, type = "risk", name = "var")
760
pspecMES05 <- add.objective(pspecLO, type = "risk", name = "ES",
761
                            arguments = list(p=0.05))
762
pspecMCSM15 <- add.objective(pspecLO, type = "risk", name = "CSM", 
763
                             arguments = list(p=0.15))
764

765
# Optimize Portfolio with Monthly Rebalancing 
766
window <- 260
767
bt.MV <- optimize.portfolio.rebalancing(ret, pspecMV,
768
                                        optimize_method = "CVXR",
769
                                        rebalance_on = "months",
770
                                        rolling_window = window)
771

772
bt.MES05 <- optimize.portfolio.rebalancing(ret, pspecMES05,
773
                                           optimize_method = "CVXR",
774
                                           rebalance_on = "months",
775
                                           rolling_window = window)
776

777
bt.MCSM15 <- optimize.portfolio.rebalancing(ret, pspecMCSM15,
778
                                            optimize_method = "CVXR",
779
                                            rebalance_on = "months",
780
                                            rolling_window = window)
781

782
# Extract time series of portfolio weights
783
wts.MV <- extractWeights(bt.MV)
784
wts.MV <- wts.MV[complete.cases(wts.MV),]
785
wts.MES05 <- extractWeights(bt.MES05)
786
wts.MES05 <- wts.MES05[complete.cases(wts.MES05),]
787
wts.MCSM15 <- extractWeights(bt.MCSM15)
788
wts.MCSM15 <- wts.MCSM15[complete.cases(wts.MCSM15),]
789

790
wts.MES05TOC <- TOcontrol(wts.MES05, 0.9) 
791
wts.MCSM15TOC <- TOcontrol(wts.MCSM15, 0.8) 
792

793
# For table below
794
wts.comb31TOC <- list(wts.MV = wts.MV, wts.MES05TOC = wts.MES05TOC, 
795
                      wts.MCSM15TOC = wts.MCSM15TOC)
796

797
# Compute cumulative returns of the portfolios
798
MV <- Return.rebalancing(ret, wts.MV)
799
MES05TOC <- Return.rebalancing(ret, wts.MES05TOC)
800
MCSM15TOC <- Return.rebalancing(ret, wts.MCSM15TOC)
801

802

803
# Combine MV, MES05, MES05_TOC gross cumulative returns
804
ret.comb <- na.omit(merge(MV, MES05TOC, MCSM15TOC, Market, all=F))
805
names(ret.comb) <- c("MV", "MES05-TOC", "MCSM15-TOC", "Market")
806

807
# For table below
808
ret.comb31TOC <- ret.comb[ , -4]
809

810
backtest.plot(ret.comb, plotType = "cumRet",
811
              main = "MV, MES05-TOC(0.9), MCSM15-TOC(0.8), Stocks 1-30",
812
              colorSet = c("red","darkgreen","darkblue","black"), 
813
              ltySet = c(3, 1, 1, 1), lwdSet = c(0.7, 0.7, 0.7, 0.7))
814

815

816
## Exhibit 15
817

818
# Create TO and DIV values data frame
819
muSdTO_DIV <- ToDivMeanSd(wts.comb31TOC)
820

821
ret.comb31TOCShort <- ret.comb31TOC["2006/2014", ]
822
dat <- ret.comb31TOCShort
823
SR <- RPESE::SR.SE(dat)$SR
824
DSR <- RPESE::DSR.SE(dat)$DSR
825
SR_DSR <- data.frame(round(sqrt(252)*cbind(SR,DSR),2))
826

827
# Combine the two data frames
828
portStats <- data.frame(muSdTO_DIV, SR_DSR)
829
row.names(portStats) <- names(dat)
830
portStats
831

832

833
## Exhibit 16 (3 minutes and 41 seconds)
834
ret <- smallcapTS[ , 31:60]
835

836
# Optimize Portfolio with Monthly Rebalancing 
837
window <- 260
838
bt.MV <- optimize.portfolio.rebalancing(ret, pspecMV,
839
                                        optimize_method = "CVXR",
840
                                        rebalance_on = "months",
841
                                        rolling_window = window)
842

843
bt.MES05 <- optimize.portfolio.rebalancing(ret, pspecMES05,
844
                                           optimize_method = "CVXR",
845
                                           rebalance_on = "months",
846
                                           rolling_window = window)
847

848
bt.MCSM15 <- optimize.portfolio.rebalancing(ret, pspecMCSM15,
849
                                            optimize_method = "CVXR",
850
                                            rebalance_on = "months",
851
                                            rolling_window = window)
852

853
# Extract time series of portfolio weights
854
wts.MV <- extractWeights(bt.MV)
855
wts.MV <- wts.MV[complete.cases(wts.MV),]
856
wts.MES05 <- extractWeights(bt.MES05)
857
wts.MES05 <- wts.MES05[complete.cases(wts.MES05),]
858
wts.MCSM15 <- extractWeights(bt.MCSM15)
859
wts.MCSM15 <- wts.MCSM15[complete.cases(wts.MCSM15),]
860

861
wts.MES05TOC <- TOcontrol(wts.MES05, 0.5) 
862
wts.MCSM15TOC <- TOcontrol(wts.MCSM15, 0.6) 
863

864
# For table below
865
wts.comb32TOC <- list(wts.MV = wts.MV, wts.MES05TOC = wts.MES05TOC, 
866
                      wts.MCSM15TOC = wts.MCSM15TOC)
867

868
# Compute cumulative returns of the portfolios
869
MV <- Return.rebalancing(ret, wts.MV)
870
MES05TOC <- Return.rebalancing(ret, wts.MES05TOC)
871
MCSM15TOC <- Return.rebalancing(ret, wts.MCSM15TOC)
872

873

874
# Combine cumulative gross returns
875
ret.comb <- na.omit(merge(MV, MES05TOC, MCSM15TOC, Market, all=F))
876
names(ret.comb) <- c("MV", "MES05-TOC", "MCSM15-TOC", "Market")
877

878
# For table below
879
ret.comb32TOC <- ret.comb[ , -4]
880

881
backtest.plot(ret.comb, plotType = "cumRet",
882
              main = "MV, MES05-TOC(0.5), MCSM15-TOC(0.6), Stocks 31-60",
883
              colorSet = c("red","darkgreen","darkblue","black"), 
884
              ltySet = c(3, 1, 1, 1), lwdSet = c(0.7, 0.7, 0.7, 0.7))
885

886

887

888
## Exhibit 17
889

890
# Create TO and DIV values data frame
891
muSdTO_DIV <- ToDivMeanSd(wts.comb32TOC)
892

893
ret.comb32TOCShort <- ret.comb32TOC["2006/2014", ]
894
dat <- ret.comb32TOCShort
895
SR <- RPESE::SR.SE(dat)$SR
896
DSR <- RPESE::DSR.SE(dat)$DSR
897
SR_DSR <- data.frame(round(sqrt(252)*cbind(SR,DSR),2))
898

899
# Combine the two data frames
900
portStats <- data.frame(muSdTO_DIV, SR_DSR)
901
row.names(portStats) <- names(dat)
902
portStats
903

904

905
## Exhibit 18 (3 minutes and 41 seconds)
906
ret <- smallcapTS[ , 61:90]
907

908
# Generate MV, and MES portfolios
909
pspec <- portfolio.spec(assets = names(ret))
910
pspecFI <- add.constraint(pspec, type = "full_investment")
911
pspecLO <- add.constraint(pspecFI, type = "long_only")
912
pspecMV <- add.objective(pspecLO, type = "risk", name = "var")
913
pspecMES05 <- add.objective(pspecLO, type = "risk", name = "ES",
914
                            arguments = list(p=0.05))
915
pspecMCSM15 <- add.objective(pspecLO, type = "risk", name = "CSM", 
916
                             arguments = list(p=0.15))
917

918
# Optimize Portfolio with Monthly Rebalancing 
919
window <- 260
920
bt.MV <- optimize.portfolio.rebalancing(ret, pspecMV,
921
                                        optimize_method = "CVXR",
922
                                        rebalance_on = "months",
923
                                        rolling_window = window)
924

925
bt.MES05 <- optimize.portfolio.rebalancing(ret, pspecMES05,
926
                                           optimize_method = "CVXR",
927
                                           rebalance_on = "months",
928
                                           rolling_window = window)
929

930
bt.MCSM15 <- optimize.portfolio.rebalancing(ret, pspecMCSM15,
931
                                            optimize_method = "CVXR",
932
                                            rebalance_on = "months",
933
                                            rolling_window = window)
934

935
# Extract time series of portfolio weights
936
wts.MV <- extractWeights(bt.MV)
937
wts.MV <- wts.MV[complete.cases(wts.MV),]
938
wts.MES05 <- extractWeights(bt.MES05)
939
wts.MES05 <- wts.MES05[complete.cases(wts.MES05),]
940
wts.MCSM15 <- extractWeights(bt.MCSM15)
941
wts.MCSM15 <- wts.MCSM15[complete.cases(wts.MCSM15),]
942

943
wts.MES05TOC <- TOcontrol(wts.MES05, 0.6) # Use this value of delta
944
wts.MCSM15TOC <- TOcontrol(wts.MCSM15, 0.8) # Use this value of delta
945

946
# For table below
947
wts.comb33TOC <- list(wts.MV = wts.MV, wts.MES05TOC = wts.MES05TOC, 
948
                      wts.MCSM15TOC = wts.MCSM15TOC)
949

950
# Compute cumulative returns of the portfolios
951
MV <- Return.rebalancing(ret, wts.MV)
952
MES05TOC <- Return.rebalancing(ret, wts.MES05TOC)
953
MCSM15TOC <- Return.rebalancing(ret, wts.MCSM15TOC)
954

955

956
# Combine MV, MES05, MES15TOC gross cumulative returns
957
ret.comb <- na.omit(merge(MV, MES05TOC, MCSM15TOC, Market, all=F))
958
names(ret.comb) <- c("MV", "MES05-TOC", "MCSM15-TOC", "Market")
959

960
# For table below
961
ret.comb33TOC <- ret.comb[ , -4]
962

963
backtest.plot(ret.comb, plotType = "cumRet",
964
              main = "MV, MES05-TOC(0.6), MCSM15-TOC(0.8), Stocks 61-90",
965
              colorSet = c("red","darkgreen","darkblue","black"), 
966
              ltySet = c(3, 1, 1, 1), lwdSet = c(0.7, 0.7, 0.7, 0.7))
967

968

969

970
## Exhibit 19
971

972
# Create TO and DIV values data frame
973
muSdTO_DIV <- ToDivMeanSd(wts.comb33TOC)
974

975
ret.comb33TOCShort <- ret.comb33TOC["2006/2014", ]
976
dat <- ret.comb33TOCShort
977
SR <- RPESE::SR.SE(dat)$SR
978
DSR <- RPESE::DSR.SE(dat)$DSR
979
SR_DSR <- data.frame(round(sqrt(252)*cbind(SR,DSR),2))
980

981
# Combine the two data frames
982
portStats <- data.frame(muSdTO_DIV, SR_DSR)
983
row.names(portStats) <- names(dat)
984
portStats
985

986

987
## Exhibt 20
988

989
## Thresholds from Tail Probs
990
thresholds <- function(dof, Z = FALSE)
991
{
992
  # Z = FALSE controls row.names suffix ".T" versus ".Z"
993
  tailProbs <- c(0.01, 0.05, 0.10, 0.15, 0.20)
994
  n <- length(tailProbs)
995
  ThresholdTdist <- rep(0,n)
996
  for(i in 1:n) {
997
    ThresholdTdist[i] <- thresholdFromTailProbTdist(tailProbs[i], df = dof)
998
  }
999
  rnd <- 5
1000
  ThresholdTdist <- round(ThresholdTdist,rnd)
1001
  
1002
  # TupperBnd <- function(alpha) qt((1-(1 - alpha)^2), df = dof)
1003
  TupperBnd <- function(tailProbs) qt((1-tailProbs^2), df = dof)
1004
  
1005
  Tquantiles <- round(qt(1 - tailProbs, df = dof),rnd)
1006
  Tprobs <- round(1 - pt(ThresholdTdist, df = dof), rnd)
1007
  # TupperBnd <- round(TupperBnd(1 - tailProbs),rnd)
1008
  TupperBnd <- round(TupperBnd(tailProbs),rnd)
1009
  
1010
  UBprobs <- tailProbs^2
1011
  dat <- data.frame(rbind(TupperBnd, ThresholdTdist, Tquantiles, UBprobs, Tprobs))
1012
  if(Z == TRUE){
1013
    row.names(dat) <- c("UpperBnd.Z", "Threshold.Z", "Quantile.Z", 
1014
                        "UpperBndProbs.Z", "ThresholdProbs.Z")
1015
  } else {
1016
    row.names(dat) <- c("UpperBnd.T", "Threshold.T", "Quantile.T", 
1017
                        "UpperBndProbs.T", "ThresholdProbs.T")
1018
  }
1019
  names(dat) <- c("1%", "5%", "10%", "15%", "20%")
1020
  return(dat) # UBprobs relatively close to Tprob even with df = 3
1021
}
1022

1023
thresh.Z <- thresholds(500, Z = TRUE)
1024
thresh.T <- thresholds(10, Z = FALSE)
1025
datOut <- rbind(thresh.Z, thresh.T)
1026
datOut
1027

1028
Product

Resources

Company
