Paquete R para la cartera

Question

En el contexto de la teoría moderna de la cartera, a menudo se desea minimizar $\mathbf{w}^{\mathrm{{\scriptstyle T}}}\boldsymbol{\Sigma}\mathbf{w}$ con sujeción a $\mathbf{w}^{T}\boldsymbol{\mu}=c_{1}$ , $\left\Vert \mathbf{w}\right\Vert _{1}<c_{2}$ y $\mathbf{w}^{T}\mathbf{1}=1$ . ¿Existe una función o paquete de R para hacer esto?

Answer 1

Si puedes añadir constantes lineales (como puedes hacer en quadprog) entonces puedes formular $w \mu = c_1$ como restricción lineal, no importa lo que $\mu$ es (y primero se elimina del objetivo poniendo el parámetro a cero. El único problema es la norma Permítanme aclarar, esto es: $$ \sum_{i=1}^n |w_i| < c_2 $$ Por lo tanto, usted permite las ventas en corto, pero quiere limitar el apalancamiento -> ¿verdad? Me temo que quadprog no puede manejar tales restricciones.

Algunos solucionadores pueden manejar restricciones cuadráticas entonces $$ \sum_{i=1}^n |w_i|^2 = w^T w< c_2^* $$ limitaría el apalancamiento. La primera ecuación anterior describe una restricción para el $L_1$ - norma . Si quiere decir que $|w_i|$ debe estar acotado para cada $i$ entonces, por supuesto, se obtiene esto por las dos desigualdades: $$ w \le c_2 \quad \text{and} \quad w \ge -c_2. $$

EDITAR después del comentario de John: El paquete nloptr puede manejar restricciones no lineales. Siga los ejemplos del enlace para definir la función objetivo y la restricción. Tenga en cuenta que el gradiente de $$ f(w) = w^T \Sigma w $$ viene dada por $$ 2 \Sigma w.$$ Proporcionar el gradiente mejorará el resultado de este optimizador no lineal.

EDIT: Si desea algo construido para la optimización de la cartera directamente, entonces usted podría mirar fPorfolio y, por ejemplo, esto presentación . Encuentro que la documentación carece de detalles y me pregunto si todas las características "prometidas" en la presentación funcionan correctamente. En la página 13 dicen que el paquete puede manejar restricciones no lineales. Si lo pruebas, por favor dinos si esto funciona.

Answer 2

Me pregunto si es posible utilizar solve.QP de quadprog mediante el uso de variables ficticias. Una variable ficticia $y_i$ se utilizaría para cada $w_i$ Cada uno de ellos $y_i$ se limitaría a ser mayor que cero, y la restricción de apalancamiento se aplicaría a la suma de los $y_i$ . La formulación del problema sería la siguiente $$ \text{min } w^tΣw $$ con sujeción a las restricciones $$ w^t\mu= c_1 $$ $$ w^t 1 = 1 $$

$$ y_i \geq 0 $$ $$ w_i + y_i \geq 0 $$ $$ -w_i + y_i \geq 0 $$

$$ -\sum y_i \geq -c_2 $$

El código podría tener el siguiente aspecto

leveraged_port <- function( er,cov.mat, target_return=NULL, leverage=1., tickers=NULL ){
   library(quadprog)
# leverage checks and adjustments
   if(leverage < 1.) stop( "leverage must be >= 1.")
   if( target_return > (leverage+1)/2*max(er)) stop("target_return not achievable; increase leverage or decrease target_return")
   lev_adj  <- 1.E-06
   if(leverage < 1 + lev_adj) leverage  <- 1 + lev_adj
   n_asset <- length(er)
   zeros <- integer(n_asset)
 # quad problem
 # calculate small diag value for dummy variables so Dmat is positive def.
    diag_dum <- 1.e-05*min(diag(cov.mat))
    Dmat <- diag(diag_dum, nrow=2*n_asset, ncol=2*n_asset)
    Dmat[1:n_asset, 1:n_asset] <- 2*cov.mat
    dvec <- numeric(2*n_asset)
    meq <-  2
 # constraints on weights
    bvec <- c(1, target_return)
    Amat <- matrix( c(rep(1,n_asset), er, diag(n_asset), -diag(n_asset), diag(0, nrow=n_asset),
                      zeros), nrow=n_asset) 
 # constraints on dummy variables
    bvec <- c(bvec, zeros, zeros, zeros, -leverage)
    Amat <- rbind( Amat, matrix(c(zeros, zeros, diag(n_asset), diag(n_asset), diag(n_asset), 
                                  -rep(1,n_asset)), nrow=n_asset))
    sol<-solve.QP(Dmat, dvec, Amat, bvec, meq=meq)
    weights<-sol$solution[1:n_asset]
        names(weights) <- tickers
        exp.ret <- t(er)%*%weights
        std.dev <- sqrt(weights %*% cov.mat %*% weights)
        ret <- list(er = as.vector(exp.ret),
                    StdDev = as.vector(std.dev),
                    weights = weights,
                    sum_weights = sum(weights),
                    leverage = sum(abs(weights)),
                    lagrange_mults=sol$Lagrangian )  
 }

Los resultados del siguiente problema de ejemplo parecen factibles

library(quantmod)
tickers <- c("MSFT","AAPL", "AMZN", "YHOO", "XOM", "CVX", "UNH", "NKE")
prices <- do.call(cbind, 
         lapply(tickers, function(x) getSymbols(x, from="2010-01-01", auto.assign=FALSE, warnings=FALSE)[,6]))
colnames(prices) <- tickers
returns <- diff(prices, arithmetic=FALSE, na.pad=FALSE) - 1
means <- sapply(returns, mean)

QPsol <- leveraged_port(er=means, cov.mat=cov(coredata(returns)), target_return=.0016, leverage=1.8, tickers)

con los resultados

QPsol
$er
[1] 0.0016

$StdDev
[1] 0.01830004

$weights
         MSFT          AAPL          AMZN          YHOO           XOM           CVX           UNH           NKE 
-9.809695e-14  1.044254e+00 -5.297152e-14 -1.780017e-17 -4.000000e-01 -1.556950e-13  3.557464e-01  4.224909e-14 

$sum_weights
[1] 1

$leverage
[1] 1.8