[Returnanalytics-commits] r2222 - in pkg/MPO: . R examples man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Aug 6 00:11:32 CEST 2012
Author: jamesleehobbs
Date: 2012-08-06 00:11:32 +0200 (Mon, 06 Aug 2012)
New Revision: 2222
Added:
pkg/MPO/R/BackTest.R
pkg/MPO/R/ProportionalCostOpt.R
pkg/MPO/examples/BackTestingExamples.R
pkg/MPO/man/BackTestTimes.Rd
pkg/MPO/man/BackTestWeights.Rd
Modified:
pkg/MPO/DESCRIPTION
pkg/MPO/NAMESPACE
pkg/MPO/R/TurnoverOpt.R
pkg/MPO/examples/Examples.R
pkg/MPO/man/TurnoverOpt.Rd
Log:
-added backtesting
-modified TurnoverOpt to work with backtesting
-added Proportional cost model
Modified: pkg/MPO/DESCRIPTION
===================================================================
--- pkg/MPO/DESCRIPTION 2012-08-04 01:36:01 UTC (rev 2221)
+++ pkg/MPO/DESCRIPTION 2012-08-05 22:11:32 UTC (rev 2222)
@@ -28,3 +28,4 @@
'TransactionCostOpt.R'
'TurnoverOpt.R'
'ProportionalCostOpt.R'
+ 'BackTest.R'
Modified: pkg/MPO/NAMESPACE
===================================================================
--- pkg/MPO/NAMESPACE 2012-08-04 01:36:01 UTC (rev 2221)
+++ pkg/MPO/NAMESPACE 2012-08-05 22:11:32 UTC (rev 2222)
@@ -1,3 +1,5 @@
+export(BackTestTimes)
+export(BackTestWeights)
export(ProportionalCostOpt)
export(TransactionCostOpt)
export(TransCostFrontier)
Added: pkg/MPO/R/BackTest.R
===================================================================
--- pkg/MPO/R/BackTest.R (rev 0)
+++ pkg/MPO/R/BackTest.R 2012-08-05 22:11:32 UTC (rev 2222)
@@ -0,0 +1,62 @@
+#' BackTesting Time Period Function
+#'
+#' Calculates rebalance dates
+#'
+#' @param dates A date object, such as calling index() on an xts object
+#' @rebalance.periods frequency of rebalancing periods
+#' @training.length length of training data
+#' @return returns a list training start and end dates, and rebalancing dates
+#' @author Doug Martin
+#' @export
+BackTestTimes <- function(dates, rebalance.periods, training.length) {
+
+ lds = length(dates)
+ start.point = training.length
+ lds1 = lds - 1
+ reb.seq = seq(start.point, lds1, by = rebalance.periods)
+ reb.dates <- dates[reb.seq]
+ train.start.dates <- dates[reb.seq - training.length + 1]
+ train.end.dates <- dates[reb.seq]
+ list(train.start.dates = train.start.dates,
+ train.end.dates = train.end.dates, reb.dates = reb.dates)
+}
+
+#' BackTesting Portfolio Weights Function
+#'
+#' Calculates rebalance dates
+#'
+#' @param returns an xts object of asset returns
+#' @rebalance.periods frequency of rebalancing periods
+#' @training.length length of training data
+#' @return returns an xts object of portfolio weights
+#' @author Doug Martin
+#' @authoer James Hobbs
+#' @export
+BackTestWeights = function(returns, rebalance.periods, training.length, FUN, ...)
+{
+ times <- BackTestTimes(index(returns),rebalance.periods,training.length)
+ npts <- length(times$reb.dates)
+ weight <- xts(matrix(NA, ncol = ncol(returns), nrow = npts), order.by = times$reb.dates)
+
+ pb=txtProgressBar(min = 0, max = npts, style = 3)
+ for (i in 1:npts) {
+ # set key dates
+ train.start.date = times$train.start.dates[i]
+ train.end.date = times$train.end.dates[i]
+
+ # fetch data
+ ret.data = window(returns, start = train.start.date, end = train.end.date)
+
+ FUN <- match.fun(FUN)
+ port <- FUN(ret.data, ...=...)
+ w <- port$w
+ weight[i,] <- w
+
+ setTxtProgressBar(pb, i)
+ }
+ close(pb)
+ return(weight)
+}
+
+
+
Added: pkg/MPO/R/ProportionalCostOpt.R
===================================================================
--- pkg/MPO/R/ProportionalCostOpt.R (rev 0)
+++ pkg/MPO/R/ProportionalCostOpt.R 2012-08-05 22:11:32 UTC (rev 2222)
@@ -0,0 +1,87 @@
+#' Proportional cost portfolio optimization
+#'
+#' Calculate portfolio weights, variance, and mean return, given a set of
+#' returns and a value for proportional transaction costs
+#'
+#'
+#' @param returns an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' asset returns
+#' @param mu.target target portfolio return
+#' @param w.initial initial vector of portfolio weights. Length of the vector
+#' must be equal to ncol(returns)
+#' @param tc proportional transaction cost
+#' @param long.only optional long only constraint. Defaults to FALSE
+#' @return returns a list with initial weights, buys, sells, and
+#' the aggregate of all three. Also returns the portfolio's expected
+#' return and variance
+#' @author James Hobbs
+#' @seealso \code{\link{TurnoverFrontier}}
+#' @seealso \code{\link{solve.QP}}
+#'
+#' data(Returns)
+#' opt <- ProportionalCostOpt(large.cap.returns,mu.target=0.004,
+#' w.initial = rep(1/100,100),tc=.01)
+#' opt$w.total
+#' opt$port.var
+#' opt$port.mu
+#' @export
+ProportionalCostOpt <- function(returns,mu.target,w.initial,tc,long.only = FALSE){
+ nassets <- ncol(returns)
+ if(length(tc)==1){
+ tc = rep(tc,nassets)
+ }
+ if(length(tc)!=nassets){
+ stop("tc must either be a single value, or the same length as the number of assets")
+ }
+ #using 3 sets of variabes...w.initial, w.buy, and w.sell
+ returns <- cbind(returns,returns,returns)
+ #The covariance matrix will be 3Nx3N rather than NxN
+ cov.mat <- cov(returns)
+ Dmat <- 2*cov.mat
+ #Make covariance positive definite
+ #This should barely change the covariance matrix, as
+ #the last few eigen values are very small negative numbers
+ Dmat <- make.positive.definite(Dmat)
+ mu <- apply(returns,2,mean)
+ dvec <- rep(0,nassets*3) #no linear part in this problem
+
+ #left hand side of constraints
+ constraint.sum <- c(rep(1,nassets),1+tc,(1-tc))
+ #constraint.sum <- c(rep(1,2*nassets),rep(1,nassets))
+ constraint.mu.target <- (1+mu)
+ constraint.weights.initial <- rbind(diag(nassets),matrix(0,ncol=nassets,nrow=nassets*2))
+ constraint.weights.positive <-
+ rbind(matrix(0,ncol=2*nassets,nrow=nassets),diag(2*nassets))
+ temp.index <- (nassets*3-nassets+1):(nassets*3)
+ #need to flip sign for w_sell
+ constraint.weights.positive[temp.index,]<-
+ constraint.weights.positive[temp.index,]*-1
+ #put left hand side of constraints into constraint matrix
+ Amat <- cbind(constraint.sum, constraint.mu.target, constraint.weights.initial,
+ constraint.weights.positive)
+
+ #right hand side of constraints in this vector
+ bvec <- c(1,(1+mu.target),w.initial,rep(0,2*nassets))
+
+ #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 <- rbind(diag(nassets),diag(nassets),diag(nassets))
+ Amat <- cbind(Amat, constraint.long.only)
+ bvec <- c(bvec,rep(0,nassets))
+ }
+
+ solution <- solve.QP(Dmat,dvec,Amat,bvec,meq=(2+nassets))
+
+ port.var <- solution$value
+ w.buy <- solution$solution[(nassets+1):(2*nassets)]
+ w.sell <- solution$solution[(2*nassets+1):(3*nassets)]
+ w.total <- w.initial + w.buy + w.sell
+ port.mu <- w.total%*%(mu[1:nassets])
+ list(w.initial = w.initial, w.buy = w.buy,w.sell=w.sell,
+ w.total=w.total, port.var=port.var,port.mu=port.mu)
+}
+
+
Modified: pkg/MPO/R/TurnoverOpt.R
===================================================================
--- pkg/MPO/R/TurnoverOpt.R 2012-08-04 01:36:01 UTC (rev 2221)
+++ pkg/MPO/R/TurnoverOpt.R 2012-08-05 22:11:32 UTC (rev 2222)
@@ -25,7 +25,7 @@
#' opt$port.var
#' opt$port.mu
#' @export
-TurnoverOpt <- function(returns,mu.target,w.initial,turnover, long.only = FALSE){
+TurnoverOpt <- function(returns,mu.target = NULL,w.initial,turnover, long.only = FALSE){
nassets <- ncol(returns)
#using 3 sets of variabes...w.initial, w.buy, and w.sell
returns <- cbind(returns,returns,returns)
@@ -52,11 +52,19 @@
constraint.weights.positive[temp.index,]<-
constraint.weights.positive[temp.index,]*-1
- #put left hand side of constraints into constraint matrix
- Amat <- cbind(constraint.sum, constraint.mu.target, constraint.weights.initial,
+
+ if(!is.null(mu.target)){
+ #put left hand side of constraints into constraint matrix
+ Amat <- cbind(constraint.sum, constraint.mu.target, constraint.weights.initial,
constraint.turnover, constraint.weights.positive)
- #right hand side of constraints in this vector
- bvec <- c(1,mu.target,w.initial,-turnover,rep(0,2*nassets))
+ #right hand side of constraints in this vector
+ bvec <- c(1,mu.target,w.initial,-turnover,rep(0,2*nassets))
+ } else {
+ #min variance, no target mu
+ Amat <- cbind(constraint.sum, constraint.weights.initial,
+ constraint.turnover, constraint.weights.positive)
+ bvec <- c(1,w.initial,-turnover,rep(0,2*nassets))
+ }
#optional long only constraint
if(long.only == TRUE){
@@ -68,10 +76,15 @@
bvec <- c(bvec,rep(0,nassets))
}
+ if(!is.null(mu.target)){
+ n.eq = 2+nassets
+ } else {
+ n.eq = 1 + nassets
+ }
#Note that the first 5 constraints are equality constraints
#The rest are >= constraints, so if you want <= you have to flip
#signs as done above
- solution <- solve.QP(Dmat,dvec,Amat,bvec,meq=(2+nassets))
+ solution <- solve.QP(Dmat,dvec,Amat,bvec,meq=(n.eq))
port.var <- solution$value
w.buy <- solution$solution[(nassets+1):(2*nassets)]
@@ -80,7 +93,7 @@
achieved.turnover <- sum(abs(w.buy),abs(w.sell))
port.mu <- w.total%*%(mu[1:nassets])
list(w.initial = w.initial, w.buy = w.buy,w.sell=w.sell,
- w.total=w.total,achieved.turnover = achieved.turnover,
+ w=w.total,achieved.turnover = achieved.turnover,
port.var=port.var,port.mu=port.mu)
}
@@ -128,4 +141,3 @@
}
-
Added: pkg/MPO/examples/BackTestingExamples.R
===================================================================
--- pkg/MPO/examples/BackTestingExamples.R (rev 0)
+++ pkg/MPO/examples/BackTestingExamples.R 2012-08-05 22:11:32 UTC (rev 2222)
@@ -0,0 +1,7 @@
+
+##backtesting turnover example
+wt.to <- BackTestWeights(large.cap.returns,12,36,FUN=TurnoverOpt,w.initial=rep(1/100,100),turnover=2)
+class(wt.to)
+ret.to <- Return.rebalancing(large.cap.returns, wt.to2)
+charts.PerformanceSummary(ret.to2,main="MV Portfolio, turnover constrained")
+
Modified: pkg/MPO/examples/Examples.R
===================================================================
--- pkg/MPO/examples/Examples.R 2012-08-04 01:36:01 UTC (rev 2221)
+++ pkg/MPO/examples/Examples.R 2012-08-05 22:11:32 UTC (rev 2222)
@@ -2,6 +2,7 @@
source("TransactionOpt.R")
source("ClassicMV.R")
+data(Returns)
pdf("Charts.pdf")
#verify 3 methods are equal with no transaction cost/turnover
Added: pkg/MPO/man/BackTestTimes.Rd
===================================================================
--- pkg/MPO/man/BackTestTimes.Rd (rev 0)
+++ pkg/MPO/man/BackTestTimes.Rd 2012-08-05 22:11:32 UTC (rev 2222)
@@ -0,0 +1,21 @@
+\name{BackTestTimes}
+\alias{BackTestTimes}
+\title{BackTesting Time Period Function}
+\usage{
+ BackTestTimes(dates, rebalance.periods, training.length)
+}
+\arguments{
+ \item{dates}{A date object, such as calling index() on an
+ xts object}
+}
+\value{
+ returns a list training start and end dates, and
+ rebalancing dates
+}
+\description{
+ Calculates rebalance dates
+}
+\author{
+ Doug Martin
+}
+
Added: pkg/MPO/man/BackTestWeights.Rd
===================================================================
--- pkg/MPO/man/BackTestWeights.Rd (rev 0)
+++ pkg/MPO/man/BackTestWeights.Rd 2012-08-05 22:11:32 UTC (rev 2222)
@@ -0,0 +1,20 @@
+\name{BackTestWeights}
+\alias{BackTestWeights}
+\title{BackTesting Portfolio Weights Function}
+\usage{
+ BackTestWeights(returns, rebalance.periods,
+ training.length, FUN, ...)
+}
+\arguments{
+ \item{returns}{an xts object of asset returns}
+}
+\value{
+ returns an xts object of portfolio weights
+}
+\description{
+ Calculates rebalance dates
+}
+\author{
+ Doug Martin
+}
+
Modified: pkg/MPO/man/TurnoverOpt.Rd
===================================================================
--- pkg/MPO/man/TurnoverOpt.Rd 2012-08-04 01:36:01 UTC (rev 2221)
+++ pkg/MPO/man/TurnoverOpt.Rd 2012-08-05 22:11:32 UTC (rev 2222)
@@ -2,8 +2,8 @@
\alias{TurnoverOpt}
\title{Turnover constrained portfolio optimization}
\usage{
- TurnoverOpt(returns, mu.target, w.initial, turnover,
- long.only = FALSE)
+ TurnoverOpt(returns, mu.target = NULL, w.initial,
+ turnover, long.only = FALSE)
}
\arguments{
\item{returns}{an xts, vector, matrix, data frame,
More information about the Returnanalytics-commits
mailing list