[COLOR=Green]# ***********************************************************************
# Back test 'Minimum Correlation Portfolio' di D. Varadi et al.
# by Cren
# ***********************************************************************
# Carico i package[/COLOR]
require(gogarch)
require(PerformanceAnalytics)
[COLOR=Green]# Calcolo i rendimenti aritmetici degli indici[/COLOR]
dX.0 <- returns(MV_datas, method = 'discrete') ; dX <- dX.0[-1,]
[COLOR=Green]# Per aiutarmi nel back test, costruisco una funzione per applicare in
# expanding window l'algoritmo: prende in input i dati, la funzione da
# applicare e l'ampiezza iniziale della finestra; mi restituisce l'output
# nel medesimo formato dei dati in ingresso[/COLOR]
roll.app <- function(data, FUN, width) {
temp <- matrix(NA, nrow = nrow(data), ncol = ncol(data))
for(i in 1:(nrow(data) - (width - 1))) {
temp[i + width - 1,] <- FUN(data[i:(i + width - 1),])
}
return(temp)
}
[COLOR=Green]# L'algoritmo 'Minimum Correlation Portfolio' è un procedimento euristico
# scoperto da David Varadi. Nel seguito scrivo l'algoritmo per estrarre i pesi
# ottimali; per la correlazione uso un GARCH(1,1) multivariato a residui
# condizionatamente normali
[/COLOR]
corr.pars <- function(data) {
V <- gogarch(data = data, formula = ~ garch(1,1))@V
Rho <- cov2cor(V)
mu.p <- mean(c(Rho))
sigma.p <- sd(c(Rho))
Adj.Rho <- 1 - pnorm(q = Rho, mean = mu.p, sd = sigma.p)
init.w <- rowMeans(Adj.Rho)
w.rank <- rank(init.w) / sum(rank(init.w))
rpw <- (w.rank %*% Adj.Rho) / sum((w.rank %*% Adj.Rho))
sigma <- sqrt(diag(V))
w.opt <- (rpw / sigma) / sum(rpw / sigma)
return(w.opt)
}
[COLOR=Green]# Applico in expanding window la funzione per estrarre i pesi ottimali
# del 'Minimum Correlation Portfolio', quindi li trasformo in serie storica[/COLOR]
w.t <- roll.app(data = dX, FUN = corr.pars, width = 200)
w.t <- xts(w.t, index(as.xts(dX)))
colnames(w.t) <- colnames(MV_datas)
[COLOR=Green]# Visualizzo l'evoluzione dei pesi ottimali nel tempo[/COLOR]
plot.zoo(w.t, format = '%y', main = 'Optimal Weights')
[COLOR=Green]# Calcolo i rendimenti della strategia; notare la funzione 'lag':
# applichiamo al periodo successivo i pesi calcolati nel periodo
# precedente, quindi c'è un ritardo di un periodo nell'adeguamento della
# allocazione ottimale (come faremmo nella realtà, ovviamente)[/COLOR]
ret <- lag(w.t) * dX
tot.ret <- xts(rowSums(ret), index(ret))
[COLOR=Green]# Visualizzo alcune misure di performance[/COLOR]
charts.PerformanceSummary(R = tot.ret, p = .99, gap = 50, methods = 'ModifiedES')
table.AnnualizedReturns(R = tot.ret, scale = 48)
table.DownsideRisk(tot.ret, p = .99)
table.Returns(tot.ret)
table.Drawdowns(tot.ret)
