HOW TO CREATE A PORTFOLIO OPTIMIZER - COMO CREAR UN OPTIMIZADOR DE CARTERAS

Existen diferentes formas de solucionar el problema de la optimización de carteras, algunas soluciones son elegantes e intuitivas; pero lentas de ejecución, otras son sencillamente brillantes y rápidas; como el Método Matricial (método del gradiente) que os presento a continuación.

There are different ways to solve the problem of portfolio optimization, some solutions are elegant and intuitive, but slower execution, others are simply brilliant and fast, like Matrix method (gradient method) that I present below.

Código fuente en Visual Basic para crear un optimizador de carteras en Excel.
Source code in Visual Basic for Excel to create a portfolio optimizer.

En color burdeos dentro de la subrutina GSM (Optimizador) aparecen la funciones internas que necesitamos desarrollar para poder hacer funcionar GSM(Optimizador).
The red inside the subroutine GSM (Optimizer) are internal functions that we need to develop to be able to run GSM (Optimizer).

Estas funciones las presentaré en la siguiente entrada del blog.
These functions present them in the following blog entry.

Los rangos de celdas dentro de la hoja Excel pueden ser personalizados por cada usuario, adecuando posteriormente estos rangos en la subrutina GSM (Optimizador).
The ranges of cells within the Excel sheet can be customized for each user, then adapting these ranges in the subroutine GSM (Optimizer).

METODO MATRICIAL CON LAMBDA AUTOMATICO Y PERSONALIZADO
MATRIX METHOD WITH AUTOMATIC AND CUSTOM LAMBDA.

Sub GSM()
Sheets("Optimizador").Select
Rows("28:50").Select
Selection.ClearContents
Range("a12").Select
Sheets("Optimizador").Cells(28, 2) = "Carteras"
Sheets("Optimizador").Cells(29, 2) = "Nivel Lambda"
Sheets("Optimizador").Cells(30, 2) = "Dt"
Sheets("Optimizador").Cells(31, 2) = "R(e)"

'DEFINICION DE VARIABLES INICIALES CAPTURA DATOS
'VARIABLE DEFINITION OF INITIAL DATA CAPTURE
n = Sheets("INPUTS").Cells(2, 1)
ncarteras = Sheets("Optimizador").Cells(8, 3)
precision = Sheets("Optimizador").Cells(7, 3)
ReDim activo(n)
ReDim DESVIA(n, 1)
ReDim rentab(n, 1)
ReDim cor(n, n)
For X = 1 To n
activo(X) = Sheets("INPUTS").Cells(X + 1, 2)
Sheets("Optimizador").Cells(X + 27 + 4, 2) = activo(X)
DESVIA(X, 1) = Sheets("INPUTS").Cells(X + 1, 3) / 100
rentab(X, 1) = Sheets("INPUTS").Cells(X + 1, 4) / 100
Next X
For X = 1 To n
For i = 1 To n
cor(i, X) = Sheets("INPUTS").Cells(X + 1, i + 5)
Next i
Next X


'DEFINICION DE VARIABLES OPERATIVAS
'DEFINITION OF OPERATING VARIABLES
ReDim w0(n, 1)
ReDim W(n, 1)
ReDim wt(1, n)
Dim IBUY, ISELL, MUBUY, MUSELL
Dim A, conta, rt, C, MULT
Dim K0
Dim K1
ReDim MU(n, 1)
ReDim swap(n, 1)
ReDim Covar(n, n)
ReDim covar2(n, n)
ReDim rent(n, 1)
ReDim CAR(n + 2, ncarteras)
Dim mat
Dim matr()
ReDim LBD(n, 1)
ReDim UBD(n, 1)
For X = 1 To n
rent(X, 1) = rentab(X, 1)
Next X

'ASIGNA VALOR A LOS MAX-MIN PESOS
'ASSIGN VALUE TO THE MAX-MIN WEIGHTS
For X = 1 To n
LBD(X, 1) = Sheets("RESTRICCIONES").Cells(X + 1, 3)
UBD(X, 1) = Sheets("RESTRICCIONES").Cells(X + 1, 2)
Next X

'ASIGNA VALOR A LA MATRIZ DE COVARIANZAS
'VALUE ASSIGNED COVARIANCE MATRIX
For X = 1 To n
For Y = 1 To n
Covar(Y, X) = DESVIA(X, 1) * DESVIA(Y, 1) * cor(Y, X)
covar2(Y, X) = Covar(Y, X) * 2
Next Y
Next X

'ASIGNA VALOR AL VECTOR DE PESOS INICIALES
'VALUE ASSIGNED TO TABLE OF INITIAL WEIGHTS
For X = 1 To n
w0(X, 1) = 1 / n
'If X = 1 Then w0(X, 1) = 1
W(X, 1) = w0(X, 1)
Next X
'IDENTIFICA EL VALOR MAXIMO DE TOLERANCIA AL RIESGO
'IDENTIFY THE MAXIMUM VALUE RISK TOLERANCE
If IdentificaLanda = 0 Then aux = 100
If IdentificaLanda = 1 Then aux = Sheets("Optimizador").Cells(6, 3)
MULT = aux / ncarteras
For X = 1 To n
numero = numero + (DESVIA(X, 1) / rentab(X, 1))
Next X
numero = aux
rt = numero
PASO = numero / ncarteras

'COMIENZA EL PROCESO DE CALCULO DE CARTERAS OPTIMAS
'CALCULATION PROCESS BEGINS OPTIMAL PORTFOLIO
For C = 1 To ncarteras
If C = 1 Then rt = 0.0001 'NUMERO
If C > 1 Then rt = rt + PASO
If C = ncarteras Then rt = numero
If rt < 0 Then C = ncarteras
If rt < 0 Then rt = 0.0001

'CALCULA EL VALOR DE LA FUNCION OBJETIVO  Mu = Ep - (Vp / Rt)
'CALCULATE THE VALUE OF OBJECTIVE FUNCTION  Mu = Ep - (Vp / Rt)
For conta = 1 To 1000
mat = MATVECTP(covar2, W)
ReDim matr(n, 1)
For Y = 1 To n
mat(Y, 1) = mat(Y, 1) * 2
mat(Y, 1) = mat(Y, 1) * (1 / rt)
matr(Y, 1) = mat(Y, 1)
Next Y
mat = MATRIZD(rent, matr)
For Y = 1 To n
matr(Y, 1) = mat(Y, 1)
MU(Y, 1) = mat(Y, 1)
Next Y

'ENCUENTRA EL MEJOR ACTIVO PARA COMPRAR Y VENDER
'FIND THE BEST ASSETS TO BUY AND SELL
IBUY = 0: MUBUY = -1E+200
ISELL = 0: MUSELL = 1E+200
For X = 1 To n
'Para Comprar
'To buy
If W(X, 1) < UBD(X, 1) Then
If MU(X, 1) > MUBUY Then
MUBUY = MU(X, 1)
IBUY = X
End If
End If
'Para Vender
'To sell
If W(X, 1) > LBD(X, 1) Then
If MU(X, 1) < MUSELL Then
MUSELL = MU(X, 1)
ISELL = X
End If
End If
Next X

'ACABA EL PROCESO SI Mu ES MENOR QUE LA PRECISION
'FINISH THE PROCESS IF Mu IS LESS THAN THE ACCURACY
If (MUBUY - MUSELL) <= 0.0001 Then GoTo DESVIA

'ASIGNA VALOR INICIAL AL VECTOR SWAP
'INITIAL VALUE ASSIGNED TO VECTOR SWAP
For X = 1 To n
swap(X, 1) = 0
Next X
swap(IBUY, 1) = 1
swap(ISELL, 1) = -1

'CALCULA LAS CANTIDADES OPTIMAS DE SWAP SIN LAS RESTRICCIONES DE PESOS
'CALCULATED AMOUNTS WITHOUT SWAP OPTIMUM WEIGHT RESTRICTIONS
mat = MATRIZT(swap)
ReDim matr(1, n)
For X = 1 To n
matr(1, X) = mat(1, X)
Next X
K0 = MATRIZP(matr, MU)
mat = MATRIZP(matr, covar2)
For X = 1 To n
matr(1, X) = mat(1, X)
Next X
mat = MATRIZP(matr, swap)
K1 = mat(1, 1) / rt
A = K0(1, 1) / (2 * K1)

'REDUCE LA CANTIDAD SWAP SI SE EXCEDE EL PESO MAXIMO REQUERIDO
'REDUCE THE AMOUNT OF SWAP IF YOU EXCEED THE MAXIMUM WEIGHT REQUIRED
If A > (UBD(IBUY, 1) - W(IBUY, 1)) Then
A = UBD(IBUY, 1) - W(IBUY, 1)
End If

'AUMENTA LA CANTIDAD SWAP SI SE EXCEDE EL PESO MINIMO REQUERIDO
'INCREASE THE NUMBER OF SWAP IF YOU EXCEED THE MAXIMUM WEIGHT REQUIRED
If A > (W(ISELL, 1) - LBD(ISELL, 1)) Then
A = W(ISELL, 1) - LBD(ISELL, 1)
End If

'TERMINA EL PROCESO SI LA CANTIDAD A = 0
'FINISH THE PROCESS IF A = 0
If A = 0 Then GoTo DESVIA

'EFECTUA LOS CAMBIOS EN EL VECTOR DE PESOS
'MAKES CHANGES TO THE TABLE OF WEIGHTS
ReDim matr(n, 1)
For X = 1 To n
matr(X, 1) = swap(X, 1) * A
Next X
mat = MATRIZS(W, matr)
For X = 1 To n
W(X, 1) = mat(X, 1)
Next X
Next conta
DESVIA:

'CALCULA LA RENTABILIDAD DE LA CARTERA
CALCULATING PORTFOLIO RETURN
mat = MATRIZT(W)
For X = 1 To n
wt(1, X) = mat(1, X)
Next X
mat = MATRIZP(wt, rent)
CAR(n + 1, C) = mat(1, 1) * 100

'CALCULA EL RIESGO DE LA CARTERA
'CALCULATING PORTFOLIO RISK
mat = MATRIZP(wt, Covar)
ReDim matr(1, n)
For X = 1 To n
matr(1, X) = mat(1, X)
Next X
mat = MATRIZP(matr, W)
CAR(n + 2, C) = Sqr(mat(1, 1)) * 100

'PRESENTA LOS DATOS EN EL HOJA EXCEL
'PRESENTS DATA ON EXCEL SHEET
For X = 1 To n
Sheets("Optimizador").Cells(28, C + 2) = C
Sheets("Optimizador").Cells(29, C + 2) = Format(rt, "0.0000")
Sheets("Optimizador").Cells(31, C + 2) = Format(CAR(n + 1, C), "0.000000") 'Format(CAR(n + 1, C) / 100, "0.000000")
Sheets("Optimizador").Cells(30, C + 2) = Format(CAR(n + 2, C), "0.000000") 'Format(CAR(n + 2, C) / 100, "0.000000")
Sheets("Optimizador").Cells(X + 27 + 4, C + 2) = Format(W(X, 1) * 100, "0.00000")
CAR(X, C) = W(X, 1)
Next X
Sheets("Optimizador").Cells(9, 3) = C
Next C
End Sub