[Returnanalytics-commits] r2177 - pkg/MPO/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jul 19 02:16:09 CEST 2012
Author: jamesleehobbs
Date: 2012-07-19 02:16:09 +0200 (Thu, 19 Jul 2012)
New Revision: 2177
Modified:
pkg/MPO/R/ClassicMV.R
pkg/MPO/R/TransactionCostOpt.R
pkg/MPO/R/TurnoverOpt.R
Log:
-Added long only
Modified: pkg/MPO/R/ClassicMV.R
===================================================================
--- pkg/MPO/R/ClassicMV.R 2012-07-18 20:17:30 UTC (rev 2176)
+++ pkg/MPO/R/ClassicMV.R 2012-07-19 00:16:09 UTC (rev 2177)
@@ -39,7 +39,7 @@
UnconstrainedFrontier <- function(returns,npoints = 10){
nassets <- ncol(returns)
min.variance.port <- MinVariancePortOpt(returns)
- mu.max <- max(apply(returns,2,mean))
+ mu.max <- max(apply(returns,2,mean))*1.5
mu.min <- min.variance.port$port.mu
mu.vals <- seq(mu.min, mu.max, length.out = npoints)
result = matrix (0,nrow = npoints, ncol = (nassets+2))
Modified: pkg/MPO/R/TransactionCostOpt.R
===================================================================
--- pkg/MPO/R/TransactionCostOpt.R 2012-07-18 20:17:30 UTC (rev 2176)
+++ pkg/MPO/R/TransactionCostOpt.R 2012-07-19 00:16:09 UTC (rev 2177)
@@ -6,10 +6,10 @@
#generic quadratic utility maximization
-UtilityMaximization <- function(returns,lambda){
+UtilityMaximization <- function(returns,lambda,long.only = FALSE){
nassets <- ncol(returns)
cov.mat <- cov(returns)
- Dmat <- 2*cov.mat*lambda #objective won't return cov matrix, no need to x2
+ Dmat <- 2*cov.mat*lambda
mu <- apply(returns,2,mean)
dvec <- -mu #linear part is to maximize mean return
@@ -20,17 +20,26 @@
#right hand side of constraints
bvec <- c(-1)
+ #optional long only constraint
+ if(long.only == TRUE){
+ constraint.long.only <- -diag(nassets)
+ Amat <- cbind(Amat, constraint.long.only)
+ bvec <- c(bvec,rep(0,nassets))
+ print("LONG ONLY")
+ }
+
solution <- solve.QP(Dmat,dvec,Amat,bvec,meq=1)
- w <- solution$solution
- port.var <- -w%*%cov.mat%*%-w
- port.mu <- -w%*%mu
+ w <- -solution$solution
+ port.var <- w%*%cov.mat%*%w
+ port.mu <- w%*%mu
list(w = w, port.var=port.var, port.mu=port.mu)
}
#lambda - risk aversion paramter
#c - proportional transaction cost
-TransactionCostOpt <- function(returns,lambda,w.initial,c){
+#TODO - fix long only constraint
+TransactionCostOpt <- function(returns,lambda,w.initial,c,long.only = FALSE){
nassets <- ncol(returns)
if(length(c)==1){
c = rep(c,nassets)
@@ -41,31 +50,42 @@
#step 1: optimize without constraints to determine buys vs sells
#if w*>w.initial c = c
#if w* < w.initial c = -c
- unconstrained <- UtilityMaximization(returns,lambda)
+ unconstrained <- UtilityMaximization(returns,lambda,long.only)
w.unconstrained <- unconstrained$w
+ diff <- w.unconstrained-w.initial
sign.vec <- rep(1,nassets)
- sign.vec[w.unconstrained<0] <- -1
+ sign.vec[diff<0] <- -1
c <- c*sign.vec
#TODO fix this part
#step 2: optimize with fixed c from step 1
#this solution will be good as long as no buys or sells flip
cov.mat <- cov(returns)
- Dmat <- cov.mat*lambda #objective won't return cov matrix, no need to x2
+ Dmat <- 2*cov.mat*lambda
mu <- apply(returns,2,mean)
dvec <- -(mu-c) #linear part is to maximize mean return
#left hand side of constraints
constraint.weight.sum <- rep(1,nassets)
- constraint.weight.buysell <- diag(sign.vec)
+ constraint.weight.buysell <- -diag(sign.vec)
Amat <- cbind(constraint.weight.sum,constraint.weight.buysell)
#right hand side of constraints
- bvec <- c(1,(w.initial*sign.vec))
+ bvec <- c(-1,(w.initial*sign.vec))
+ #optional long only constraint
+ if(long.only == TRUE){
+ if ( length(w.initial[w.initial<0]) > 0 ){
+ stop("Long-Only specified but some initial weights are negative")
+ }
+ constraint.long.only <- -diag(nassets)
+ Amat <- cbind(Amat, constraint.long.only)
+ bvec <- c(bvec,rep(0,nassets))
+ }
+
solution <- solve.QP(Dmat,dvec,Amat,bvec,meq=1)
- w <- solution$solution
+ w <- -solution$solution
port.var <- w%*%cov.mat%*%w
port.mu <- w%*%mu
list(w = w, port.var=port.var, port.mu=port.mu)
@@ -74,14 +94,15 @@
#TODO add documentation
TransCostFrontier <- function(returns,npoints = 10, min.lambda, max.lambda,
- w.initial,c,long.only = FALSE)
+ w.initial,c,long.only = FALSE)
{
p = ncol(returns)
efront = matrix(rep(0,npoints*(p+2)),ncol = p+2)
dimnames(efront)[[2]] = c("MU","SD",dimnames(returns)[[2]])
lambda.vals = seq(min.lambda,max.lambda,length.out = npoints)
for(i in 1:npoints) {
- opt <- TransactionCostOpt(returns,lambda = lambda.vals[i],w.initial,c)
+ opt <- TransactionCostOpt(returns,lambda = lambda.vals[i],w.initial,c,long.only)
+ #opt <- UtilityMaximization(returns,lambda = lambda.vals[i])
efront[i,"MU"] <- opt$port.mu
efront[i,"SD"] <- sqrt(opt$port.var)
efront[i,3:ncol(efront)] <- opt$w
@@ -89,3 +110,4 @@
efront
}
+
Modified: pkg/MPO/R/TurnoverOpt.R
===================================================================
--- pkg/MPO/R/TurnoverOpt.R 2012-07-18 20:17:30 UTC (rev 2176)
+++ pkg/MPO/R/TurnoverOpt.R 2012-07-19 00:16:09 UTC (rev 2177)
@@ -66,7 +66,7 @@
#TODO add documentation
-efrontMVTurnover <- function(returns,npoints = 10, minmu, maxmu,
+TurnoverFrontier <- function(returns,npoints = 10, minmu, maxmu,
w.initial,turnover,long.only = FALSE)
{
p = ncol(returns)
@@ -83,44 +83,5 @@
efront
}
-#long and short example
-data("Returns.RData")
-port.turn.10 <- efrontMVTurnover(large.cap.returns,npoints=20,minmu=0.001,maxmu=.1,
- w.initial=rep(1/100,100),turnover=10)
-port.turn.2 <- efrontMVTurnover(large.cap.returns,npoints=20,minmu=0.001,maxmu=.05,
- w.initial=rep(1/100,100),turnover=2)
-port.turn.1 <- efrontMVTurnover(large.cap.returns,npoints=20,minmu=0.001,maxmu=.025,
- w.initial=rep(1/100,100),turnover=1)
-port.turn.05 <- efrontMVTurnover(large.cap.returns,npoints=20,minmu=0.001,maxmu=.016,
- w.initial=rep(1/100,100),turnover=.5)
-plot(x=port.turn.10[,"SD"],y=port.turn.10[,"MU"],type="l",
- main="Efficent Frontiers with Turnover Constraints",xlab="SD",ylab="MU")
-lines(x=port.turn.2[,"SD"],y=port.turn.2[,"MU"],col="blue")
-lines(x=port.turn.1[,"SD"],y=port.turn.1[,"MU"],col="red")
-lines(x=port.turn.05[,"SD"],y=port.turn.05[,"MU"],col="orange")
-legend("topleft",bty="n",legend = c("Turnover 10","Turnover 2"
- ,"Turnover 1","Turnover .5"), col=c("black",
- "blue","red","orange"),lty=1)
-#long only example
-port.turn.long.10 <- efrontMVTurnover(large.cap.returns,npoints=20,minmu=0.001,maxmu=.020,
- w.initial=rep(1/100,100),turnover=10,long.only=TRUE)
-port.turn.long.2 <- efrontMVTurnover(large.cap.returns,npoints=20,minmu=0.001,maxmu=.020,
- w.initial=rep(1/100,100),turnover=2,long.only=TRUE)
-port.turn.long.1 <- efrontMVTurnover(large.cap.returns,npoints=20,minmu=0.001,maxmu=.015,
- w.initial=rep(1/100,100),turnover=1,long.only=TRUE)
-port.turn.long.05 <- efrontMVTurnover(large.cap.returns,npoints=20,minmu=0.001,maxmu=.012,
- w.initial=rep(1/100,100),turnover=.5,long.only=TRUE)
-
-plot(x=port.turn.long.10[,"SD"],y=port.turn.long.10[,"MU"],type="l",
- main="Long-Only Efficent Frontiers with Turnover Constraints",xlab="SD",ylab="MU")
-lines(x=port.turn.long.2[,"SD"],y=port.turn.long.2[,"MU"],col="blue")
-lines(x=port.turn.long.1[,"SD"],y=port.turn.long.1[,"MU"],col="red")
-lines(x=port.turn.long.05[,"SD"],y=port.turn.long.05[,"MU"],col="orange")
-legend("topleft",bty="n",legend = c("Turnover 10","Turnover 2",
- "Turnover 1","Turnover .5"), col=c("black",
- "blue","red","orange"),lty=1)
-
-
-
More information about the Returnanalytics-commits
mailing list