[Returnanalytics-commits] r2180 - in pkg/MPO: . R examples man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jul 19 03:28:21 CEST 2012
Author: jamesleehobbs
Date: 2012-07-19 03:28:20 +0200 (Thu, 19 Jul 2012)
New Revision: 2180
Added:
pkg/MPO/examples/
pkg/MPO/examples/Examples.R
pkg/MPO/examples/buildDataSet.R
pkg/MPO/man/TurnoverOpt.Rd
Modified:
pkg/MPO/R/TurnoverOpt.R
Log:
-added examples directory
-added documentation for Turnover
Modified: pkg/MPO/R/TurnoverOpt.R
===================================================================
--- pkg/MPO/R/TurnoverOpt.R 2012-07-19 00:20:02 UTC (rev 2179)
+++ pkg/MPO/R/TurnoverOpt.R 2012-07-19 01:28:20 UTC (rev 2180)
@@ -1,9 +1,27 @@
-library(xts)
-library(quadprog)
-library(corpcor)
+#' Turnover constrained portfolio optimization
+#'
+#' Calculate portfolio weights, variance, and mean return, given a set of
+#' returns and a constraint on overall turnover
+#'
-#todo: documentation with Roxygen2 and updating package dependecies
-
+#'
+#' @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 turnover constraint on turnover from intial weights
+#' @param long.only optional long only constraint. Defaults to FALSE
+#' @author James Hobbs
+#' @seealso \code{\link{solve.QP}}
+#'
+#' data(Returns)
+#' opt <- TurnoverOpt(large.cap.returns,mu.target=0.01,
+#' w.initial = rep(1/100,100),turnover=5)
+#' opt$w.total
+#' opt$port.var
+#' opt$port.mu
+#' @export
TurnoverOpt <- function(returns,mu.target,w.initial,turnover, long.only = FALSE){
nassets <- ncol(returns)
#using 3 sets of variabes...w.initial, w.buy, and w.sell
Added: pkg/MPO/examples/Examples.R
===================================================================
--- pkg/MPO/examples/Examples.R (rev 0)
+++ pkg/MPO/examples/Examples.R 2012-07-19 01:28:20 UTC (rev 2180)
@@ -0,0 +1,101 @@
+source("TurnoverOpt.R")
+source("TransactionOpt.R")
+source("ClassicMV.R")
+
+
+pdf("Charts.pdf")
+#verify 3 methods are equal with no transaction cost/turnover
+classicMV <- UnconstrainedFrontier(large.cap.returns,npoints=50)
+trans.cost.front <- TransCostFrontier(large.cap.returns,npoints=50,min.lambda=5,max.lambda=1000,
+ w.initial=rep(1/100,100),c=0)
+turnover.front <- TurnoverFrontier(large.cap.returns,npoints=50,minmu=0.001,maxmu=.1,
+ w.initial=rep(1/100,100),turnover=1000)
+
+plot(x=classicMV[,"SD"],y=classicMV[,"MU"],type="l",col="black",main="Comparison with no Turnover/TC constraints"
+ ,xlab="SD",ylab="MU")
+lines(x=trans.cost.front[,"SD"],y=trans.cost.front[,"MU"],lwd=2,lty=2,col="blue")
+lines(x=turnover.front[,"SD"],y=turnover.front[,"MU"],lwd=3,lty=2,col="red")
+legend("topleft",legend = c("Classic MV","Trans Cost Penalty", "Turnover Constraint"),
+ col=c("black","blue","red"),lty=1:3,bty="n")
+
+#low penalty
+trans.cost.front.low <- TransCostFrontier(large.cap.returns,npoints=50,min.lambda=5,max.lambda=1000,
+ w.initial=rep(1/100,100),c=0.0005)
+turnover.front.low <- TurnoverFrontier(large.cap.returns,npoints=50,minmu=0.001,maxmu=.05,
+ w.initial=rep(1/100,100),turnover=5)
+plot(x=classicMV[,"SD"],y=classicMV[,"MU"],type="l",col="black",main="Comparison with low Turnover/TC constraints"
+ ,xlab="SD",ylab="MU")
+lines(x=trans.cost.front.low[,"SD"],y=trans.cost.front.low[,"MU"],lwd=2,lty=2,col="blue")
+lines(x=turnover.front.low[,"SD"],y=turnover.front.low[,"MU"],lwd=3,lty=2,col="red")
+legend("topleft",legend = c("Classic MV","Trans Cost Penalty: 0.0005", "Turnover Constraint: 5"),
+ col=c("black","blue","red"),lty=1:3,bty="n")
+
+
+#med penalty
+trans.cost.front.med <- TransCostFrontier(large.cap.returns,npoints=50,min.lambda=5,max.lambda=1000,
+ w.initial=rep(1/100,100),c=0.001)
+turnover.front.med <- TurnoverFrontier(large.cap.returns,npoints=50,minmu=0.001,maxmu=.05,
+ w.initial=rep(1/100,100),turnover=4)
+plot(x=classicMV[,"SD"],y=classicMV[,"MU"],type="l",col="black",main="Comparison with med Turnover/TC constraints",
+ xlab="SD",ylab="MU")
+lines(x=trans.cost.front.med[,"SD"],y=trans.cost.front.med[,"MU"],lwd=2,lty=2,col="blue")
+lines(x=turnover.front.med[,"SD"],y=turnover.front.med[,"MU"],lwd=3,lty=2,col="red")
+legend("topleft",legend = c("Classic MV","Trans Cost Penalty: 0.0010", "Turnover Constraint: 4"),
+ col=c("black","blue","red"),lty=1:3,bty="n")
+
+#high penalty
+
+trans.cost.front.high <- TransCostFrontier(large.cap.returns,npoints=50,min.lambda=5,max.lambda=1000,
+ w.initial=rep(1/100,100),c=0.005)
+turnover.front.high <- TurnoverFrontier(large.cap.returns,npoints=50,minmu=0.001,maxmu=.05,
+ w.initial=rep(1/100,100),turnover=3)
+plot(x=classicMV[,"SD"],y=classicMV[,"MU"],type="l",col="black",main="Comparison with high Turnover/TC constraints",
+ xlab="SD",ylab="MU")
+lines(x=trans.cost.front.high[,"SD"],y=trans.cost.front.high[,"MU"],lwd=2,lty=2,col="blue")
+lines(x=turnover.front.high[,"SD"],y=turnover.front.high[,"MU"],lwd=3,lty=2,col="red")
+legend("topleft",legend = c("Classic MV","Trans Cost Penalty: 0.0050", "Turnover Constraint: 3"),
+ col=c("black","blue","red"),lty=1:3,bty="n")
+dev.off()
+
+
+###############turnover##########
+
+#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)
+##############################
\ No newline at end of file
Added: pkg/MPO/examples/buildDataSet.R
===================================================================
--- pkg/MPO/examples/buildDataSet.R (rev 0)
+++ pkg/MPO/examples/buildDataSet.R 2012-07-19 01:28:20 UTC (rev 2180)
@@ -0,0 +1,94 @@
+### get data
+library(xts)
+library(quantmod)
+library(PerformanceAnalytics)
+
+###TODO load from package
+### market cap data from: http://pages.stern.nyu.edu/~adamodar/New_Home_Page/data.html
+
+#yahoo is missing data from DF and DFG
+mktCap <- read.csv("N:\\School\\Summer 2012\\Data Set\\Market Cap Data\\mktCapSummary.csv",as.is=TRUE)
+classifiers <- c("class.2011","class.12yrAvg","class.2yrAvg")
+large <- 10000
+mid <- 2000
+small <- 250
+
+
+### Classify tickers into market cap classes
+# mktCap > 10,000 large
+# > 2,000 and <10,000 mid
+# > 250 and <2,000 small
+# < 250 micro
+for (i in 1:length(classifiers)){
+ mktCap[mktCap[,1+i] >= large,classifiers[i]] <- "large"
+ mktCap[mktCap[,1+i] >= mid & mktCap[,1+i] < large ,classifiers[i]] <- "mid"
+ mktCap[mktCap[,1+i] >= small & mktCap[,1+i] < mid ,classifiers[i]] <- "small"
+ mktCap[mktCap[,1+i] <= small,classifiers[i]] <- "micro"
+}
+
+### Get 100 tickers by group
+groupSize <- 100
+large.tickers <- mktCap[mktCap[,"class.2011"]=="large","Ticker"][1:groupSize]
+mid.tickers <- mktCap[mktCap[,"class.2011"]=="mid","Ticker"][1:groupSize]
+small.tickers <- mktCap[mktCap[,"class.2011"]=="small","Ticker"][1:groupSize]
+micro.tickers <- mktCap[mktCap[,"class.2011"]=="micro","Ticker"][1:groupSize]
+micro.tickers <- mktCap[mktCap[,"class.2011"]=="micro","Ticker"][201:301]
+
+### Download Data
+start.date <- as.Date("2000-01-01")
+end.date <- as.Date("2012-06-29")
+
+
+###get symbols wrapper function
+###add documentation and option for daily or weekly returns
+getReturns <- function(symbols,from,to){
+ nSymbols <- length(symbols)
+ #check to see if data exists far back enough
+ time <- paste(start.date,end.date,sep="/")
+ dates <- timeBasedSeq(time)
+ dates <- to.monthly(dates)
+ ndates <- nrow(dates)
+ check.df <- cbind(as.data.frame(symbols),valid=rep(FALSE,nSymbols))
+ price.list <- list()
+ for (i in 1:nSymbols){
+ #download adjusted close
+ currentSymbol <- getSymbols(symbols[i],auto.assign = FALSE
+ ,from=from,to=to)[,6]
+ currentSymbol <- to.monthly(currentSymbol,indexAt="Date")[,4]
+ if(nrow(currentSymbol) == ndates){
+ #keep month end price
+ price.list[[length(price.list)+1]] <- currentSymbol #not optimal but this loop is slow anyways
+ check.df[i,"valid"] <- TRUE
+ print("TRUE")
+ }else{
+ check.df[i,"valid"] <- FALSE #redundant
+ print("FALSE")
+ }
+ }
+ price.df = as.data.frame(price.list)
+ price.xts = as.xts(price.df, order.by=as.Date(rownames(price.df)))
+ returns <- Return.calculate(price.xts,method="compound")
+ returns <- returns[-1]
+ names(returns) <- check.df[check.df[,"valid"]==TRUE,1]
+ list(returns=returns,check.df=check.df)
+
+}
+
+large.cap.returns <- getReturns(large.tickers,from = start.date, to = end.date)
+mid.cap.returns <- getReturns(mid.tickers,from = start.date, to = end.date)
+small.cap.returns <- getReturns(small.tickers,from = start.date, to = end.date)
+micro.cap.returns <- getReturns(micro.tickers[11:20],from = start.date, to = end.date)
+ micro.cap.returns$returns
+
+time = paste(start.date,end.date,sep="/")
+time
+a=timeBasedSeq(time)
+b=to.monthly(a)
+nrow(b)
+length(a)
+
+a=getSymbols("HOOK",auto.assign = FALSE,from=start.date,to=end.date)[,6]
+
+micro.tickers[17]
+head(a)
+
Added: pkg/MPO/man/TurnoverOpt.Rd
===================================================================
--- pkg/MPO/man/TurnoverOpt.Rd (rev 0)
+++ pkg/MPO/man/TurnoverOpt.Rd 2012-07-19 01:28:20 UTC (rev 2180)
@@ -0,0 +1,39 @@
+\name{TurnoverOpt}
+\alias{TurnoverOpt}
+\title{Turnover constrained portfolio optimization}
+\usage{
+ TurnoverOpt(returns, mu.target, w.initial, turnover,
+ long.only = FALSE)
+}
+\arguments{
+ \item{returns}{an xts, vector, matrix, data frame,
+ timeSeries or zoo object of asset returns}
+
+ \item{mu.target}{target portfolio return}
+
+ \item{w.initial}{initial vector of portfolio weights.
+ Length of the vector must be equal to ncol(returns)}
+
+ \item{turnover}{constraint on turnover from intial
+ weights}
+
+ \item{long.only}{optional long only constraint. Defaults
+ to FALSE}
+}
+\description{
+ Calculate portfolio weights, variance, and mean return,
+ given a set of returns and a constraint on overall
+ turnover
+}
+\author{
+ James Hobbs
+}
+\seealso{
+ \code{\link{solve.QP}}
+
+ data(Returns) opt <-
+ TurnoverOpt(large.cap.returns,mu.target=0.01, w.initial =
+ rep(1/100,100),turnover=5) opt$w.total opt$port.var
+ opt$port.mu
+}
+
More information about the Returnanalytics-commits
mailing list