[Returnanalytics-commits] r2159 - pkg/MPO/R

[noreply at r-forge.r-project.org]

Author: jamesleehobbs
Date: 2012-07-14 23:20:50 +0200 (Sat, 14 Jul 2012)
New Revision: 2159

Added:
   pkg/MPO/R/ClassicMV.R
   pkg/MPO/R/TransactionCostOpt.R
Log:
-ClassicMV & proportional transaction cost optimization added

Added: pkg/MPO/R/ClassicMV.R
===================================================================
--- pkg/MPO/R/ClassicMV.R	                        (rev 0)
+++ pkg/MPO/R/ClassicMV.R	2012-07-14 21:20:50 UTC (rev 2159)
@@ -0,0 +1,55 @@
+#classic mv
+#From Guy Yollins code
+MinVariancePortOpt = function(returns)
+{
+  C <- var(returns)
+  one <- rep(1, nrow(C))
+  z <- solve(C, one)
+  # Compute z = C.inv * 1
+  cc <- t(one) %*% z
+  # Compute cc = 1.transpose * C.inv * 1
+  cc <- as.numeric(cc)
+  # Convert 1-by-1 matrix to a scalar
+  w <- z/cc
+  mu <- apply(returns, 2, mean)
+  a <- t(mu) %*% z
+  port.mu <- as.numeric(a/cc)
+  port.sd <- 1/cc^0.5
+  list(w = w, port.mu = port.mu, port.sd = port.sd)
+}
+
+
+PortOptUnconstrained <- function(returns,mu.target){
+  nassets <- ncol(returns)
+  cov.mat <- cov(returns)
+  Dmat <- 2*cov.mat
+  mu <- apply(returns,2,mean)
+  dvec <- rep(0,nassets) #no linear part
+  constraint.sum <- c(rep(1,nassets))
+  constraint.mu.target <- mu
+  Amat <- cbind(constraint.sum, constraint.mu.target)
+  bvec <- c(1,mu.target)
+  solution <- solve.QP(Dmat,dvec,Amat,bvec,meq=(2))
+  port.sd <- (solution$value)^0.5
+  w <- solution$solution
+  port.mu <- w%*%mu
+  list(w = w, port.sd = port.sd, port.mu = port.mu)
+}
+
+UnconstrainedFrontier <- function(returns,npoints = 10){
+  nassets <- ncol(returns)
+  min.variance.port <- MinVariancePortOpt(returns)
+  mu.max <- max(apply(returns,2,mean))
+  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))
+  colnames(result)=c("MU","SD",colnames(returns))
+  for(i in 1:npoints){
+    sol <- PortOptUnconstrained(returns,mu.vals[i])
+    result[i,"MU"] <- sol$port.mu
+    result[i,"SD"] <- sol$port.sd
+    result[i,3:(nassets+2)] <- sol$w
+  }
+  result  
+}
+

Added: pkg/MPO/R/TransactionCostOpt.R
===================================================================
--- pkg/MPO/R/TransactionCostOpt.R	                        (rev 0)
+++ pkg/MPO/R/TransactionCostOpt.R	2012-07-14 21:20:50 UTC (rev 2159)
@@ -0,0 +1,91 @@
+library(xts)
+library(quadprog)
+library(corpcor)
+
+
+
+
+#generic quadratic utility maximization
+UtilityMaximization <- function(returns,lambda){
+  nassets <- ncol(returns)
+  cov.mat <- cov(returns)
+  Dmat <- 2*cov.mat*lambda #objective won't return cov matrix, no need to x2
+  mu <- apply(returns,2,mean)
+  dvec <- -mu #linear part is to maximize mean return
+  
+  #left hand side of constraints
+  constraint.weight.sum <- rep(1,nassets)
+  Amat <- cbind(constraint.weight.sum)
+  
+  #right hand side of constraints
+  bvec <- c(-1)
+  
+  solution <- solve.QP(Dmat,dvec,Amat,bvec,meq=1)
+  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){
+  nassets <- ncol(returns)
+  if(length(c)==1){
+    c = rep(c,nassets)
+  }
+  if(length(c)!=nassets){
+    stop("c must either be a single value, or the same length as the number of assets")
+  }
+  #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)
+  w.unconstrained <- unconstrained$w
+  
+  sign.vec <- rep(1,nassets)
+  sign.vec[w.unconstrained<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
+  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)
+  Amat <- cbind(constraint.weight.sum,constraint.weight.buysell)
+  
+  #right hand side of constraints
+  bvec <- c(1,(w.initial*sign.vec))
+  
+  solution <- solve.QP(Dmat,dvec,Amat,bvec,meq=1)
+  w <- solution$solution
+  port.var <- w%*%cov.mat%*%w
+  port.mu <- w%*%mu
+  list(w = w, port.var=port.var, port.mu=port.mu)
+}
+
+
+#TODO add documentation
+TransCostFrontier <- function(returns,npoints = 10, min.lambda, max.lambda,
+                             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)
+    efront[i,"MU"] <- opt$port.mu
+    efront[i,"SD"] <- sqrt(opt$port.var)
+    efront[i,3:ncol(efront)] <- opt$w
+  }
+  
+  efront
+}