From noreply at r-forge.r-project.org Wed Oct 2 21:46:18 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 2 Oct 2013 21:46:18 +0200 (CEST) Subject: [Returnanalytics-commits] r3197 - in pkg/PortfolioAnalytics/sandbox/symposium2013: . docs Message-ID: <20131002194618.A2744185566@r-forge.r-project.org> Author: peter_carl Date: 2013-10-02 21:46:18 +0200 (Wed, 02 Oct 2013) New Revision: 3197 Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/analyze.HFindexes.R pkg/PortfolioAnalytics/sandbox/symposium2013/docs/symposium-slides-2013.Rmd pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R Log: - new charts - tweaks to old charts - added HHI charts - added hull to HHI Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/analyze.HFindexes.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/symposium2013/analyze.HFindexes.R 2013-09-30 18:42:44 UTC (rev 3196) +++ pkg/PortfolioAnalytics/sandbox/symposium2013/analyze.HFindexes.R 2013-10-02 19:46:18 UTC (rev 3197) @@ -58,6 +58,7 @@ # Drop some indexes and reorder R = edhec[,c("Convertible Arbitrage", "Equity Market Neutral","Fixed Income Arbitrage", "Event Driven", "CTA Global", "Global Macro", "Long/Short Equity")] R.names = colnames(R) +R.foldednames = sapply(colnames(R), function(x) paste(strwrap(x,10), collapse = "\n"), USE.NAMES=FALSE) ######################################################################## # Returns-based performance analysis @@ -79,15 +80,23 @@ # -------------------------------------------------------------------- # Monthly Returns and Risk # -------------------------------------------------------------------- -# @TODO: Too small: break this into two graphics? Directional, non-directional? +# Done png(filename=paste(resultsdir, dataname, "-BarVaR.png", sep=""), units="in", height=5.5, width=9, res=96) # Generate charts of returns with ETL and VaR through time par(mar=c(3, 4, 0, 2) + 0.1) #c(bottom, left, top, right) -charts.BarVaR(R, p=p, gap=36, main="", show.greenredbars=TRUE, +charts.BarVaR(R[,1:4], p=p, gap=36, main="", show.greenredbars=TRUE, methods=c("ModifiedES", "ModifiedVaR"), show.endvalue=TRUE, colorset=rep("Black",7), ylim=c(-.1,.15)) par(op) dev.off() +png(filename=paste(resultsdir, dataname, "-BarVaR2.png", sep=""), units="in", height=5.5, width=9, res=96) +# Generate charts of returns with ETL and VaR through time +par(mar=c(3, 4, 0, 2) + 0.1) #c(bottom, left, top, right) +charts.BarVaR(R[,5:7], p=p, gap=36, main="", show.greenredbars=TRUE, + methods=c("ModifiedES", "ModifiedVaR"), show.endvalue=TRUE, + colorset=rep("Black",7), ylim=c(-.1,.15)) +par(op) +dev.off() # -------------------------------------------------------------------- # Rolling Performance @@ -114,7 +123,7 @@ # -------------------------------------------------------------------- # @TODO: Too small, break into two panels? require(Hmisc) -source(paste(functionsdir,'table.RiskStats.R', sep="") +source(paste(functionsdir,'table.RiskStats.R', sep="")) incept.stats = t(table.RiskStats(R=R, p=p, Rf=Rf)) write.csv(incept.stats, file=paste(resultsdir, dataname, "-inception-stats.csv", sep="")) png(filename=paste(resultsdir, dataname, "-InceptionStats.png", sep=""), units="in", height=5.5, width=9, res=96) @@ -124,12 +133,17 @@ # -------------------------------------------------------------------- # Compare Distributions # -------------------------------------------------------------------- -# @TODO: too small? +# png(filename=paste(resultsdir, dataname, "-Distributions.png", sep=""), units="in", height=5.5, width=9, res=96) -source(paste(functionsdir, "/page.Distributions", sep="")) -page.Distributions(R) +#source(paste(functionsdir, "/page.Distributions", sep="")) +page.Distributions(R[,1:4]) dev.off() +png(filename=paste(resultsdir, dataname, "-Distributions2.png", sep=""), units="in", height=5.5, width=9, res=96) +#source(paste(functionsdir, "/page.Distributions", sep="")) +page.Distributions(R[,5:7]) +dev.off() + # -------------------------------------------------------------------- # Correlation Panels # -------------------------------------------------------------------- @@ -161,7 +175,11 @@ # -------------------------------------------------------------------- write.csv(M, file=paste(resultsdir, dataname, "-inception-cor.csv", sep="")) - + colnames(M)=R.foldednames +# write(print(xtable(M, digits=1, align=rep("c",8)), type="html", html.table.attributes = "border = '0', align = 'center'"), file=paste(resultsdir, dataname, "-inception-cor.html", sep="")) +# write(print(xtable(M, digits=1, align=rep("c",8))), file=paste(resultsdir, dataname, "-inception-cor.latex", sep="")) +write(pandoc.table.return(M, digits=1, split.tables=Inf), file=paste(resultsdir, dataname, "-inception-cor.md", sep="")) + # -------------------------------------------------------------------- # Rolling Correlation to S&P500 TR # -------------------------------------------------------------------- Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/docs/symposium-slides-2013.Rmd =================================================================== --- pkg/PortfolioAnalytics/sandbox/symposium2013/docs/symposium-slides-2013.Rmd 2013-09-30 18:42:44 UTC (rev 3196) +++ pkg/PortfolioAnalytics/sandbox/symposium2013/docs/symposium-slides-2013.Rmd 2013-10-02 19:46:18 UTC (rev 3197) @@ -2,6 +2,10 @@ % Peter Carl, Hedge Fund Strategies, William Blair & Co. % November 11, 2013 +```{r} +# R code here +``` + # Sampled portfolios -scatter chart with equal weight portfolio +\includegraphics[width=1.0\textwidth]{../results/RP-EqWgt-MeanSD-ExAnte.png} -# Turnover from equal-weight -scatter chart colored by degree of turnover - # Sampled portfolios -add assets to scatter - overconstrained? +\includegraphics[width=1.0\textwidth]{../results/RP-Assets-MeanSD-ExAnte.png} -# Constrain by contribution to mETL -Add a constraint +# Sampled portfolios with multiple objectives +\includegraphics[width=1.0\textwidth]{../results/RP-BUOY-MeanSD-ExAnte.png} -# Ex-ante results -scatter plot with multiple objectives +# Modified ETL instead of volatility +\includegraphics[width=1.0\textwidth]{../results/RP-BUOYS-mETL-ExAnte.png} # Ex-ante results -scatter plot with multiple objectives, but in ETL space rather than variance +\includegraphics[width=1.0\textwidth]{../results/Weights-Buoys.png} -# Ex-ante results -Unstacked bar chart comparing allocations across objectives - -# Out-of-sample results -timeseries charts for cumulative return and drawdown - # Risk contribution -stacked bar chart of risk contribution through time (ex ante and ex post) +\includegraphics[width=1.0\textwidth]{../results/mETL-CumulPerc-Contrib-Buoys.png} # Conclusions As a framework for strategic allocation: @@ -510,5 +507,11 @@ scatter plot with both overlaid +# Turnover from equal-weight +scatter chart colored by degree of turnover + +# Degree of Concentration +scatter chart of RP colored by degree of concentration (HHI) + # Scratch Slides likely to be deleted after this point \ No newline at end of file Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R 2013-09-30 18:42:44 UTC (rev 3196) +++ pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R 2013-10-02 19:46:18 UTC (rev 3197) @@ -21,7 +21,7 @@ ### Set script constants runname='historical.moments' #rebalance_period = 'quarters' # uses endpoints identifiers from xts; how to do semi-annual? -clean = "boudt" # "none" +clean = "none" #"boudt" # "none" permutations = 2000 p=1-1/12 # set confidence for VaR/mETL for monthly data @@ -175,8 +175,8 @@ multiplier=0, # calculate it but don't use it in the objective arguments=list(clean=clean) ) -EqmETL.portf$constraints[[1]]$min_sum = 0.99 # set to speed up RP -EqmETL.portf$constraints[[1]]$max_sum = 1.01 +# EqmETL.portf$constraints[[1]]$min_sum = 0.99 # set to speed up RP +# EqmETL.portf$constraints[[1]]$max_sum = 1.01 ### Construct BUOY 7: Equal Weight Portfolio # There's only one, so create a portfolio object with all the objectives we want calculated. @@ -357,7 +357,7 @@ RiskBudget.DE<-optimize.portfolio(R=R, portfolio=RiskBudget.portf, optimize_method='DEoptim', - search_size=1000 #, trace=TRUE + search_size=1000, trace=TRUE ) plot(RiskBudget.DE, risk.col="StdDev", return.col="mean") plot(RiskBudget.DE, risk.col="ES", return.col="mean") # several outlier portfolios Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R 2013-09-30 18:42:44 UTC (rev 3196) +++ pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R 2013-10-02 19:46:18 UTC (rev 3197) @@ -6,7 +6,7 @@ # Plot Ex Ante scatter of RP and ONLY Equal Weight portfolio in StdDev space # -------------------------------------------------------------------- # Done -png(filename="RP-EqWgt-MeanSD-ExAnte.png", units="in", height=5.5, width=9, res=96) +png(filename=paste(resultsdir, "RP-EqWgt-MeanSD-ExAnte.png", sep=""), units="in", height=5.5, width=9, res=96) par(mar=c(5, 4, 1, 2) + 0.1) #c(bottom, left, top, right) # Calculate chart bounds to unify with the charts below xlim.StdDev=c(min(c(xtract[,"StdDev"], buoys.portfmeas[,"StdDev"])), max(c(xtract[,"StdDev"], buoys.portfmeas[,"StdDev"]))) @@ -28,7 +28,7 @@ # Plot Ex Ante scatter of RP and ASSET portfolios in StdDev space # -------------------------------------------------------------------- # @TODO: add the assets to this chart -png(filename="RP-Assets-MeanSD-ExAnte.png", units="in", height=5.5, width=9, res=96) +png(filename=paste(resultsdir, "RP-Assets-MeanSD-ExAnte.png", sep=""), units="in", height=5.5, width=9, res=96) xlim.StdDev.assets =c(min(c(xtract[,"StdDev"], assets.portfmeas[,"StdDev"], 0)), max(c(xtract[,"StdDev"], assets.portfmeas[,"StdDev"],0.03))) ylim.mean.assets =c(min(c(xtract[,"mean"], assets.portfmeas[,"Mean"], 0)), max(c(xtract[,"mean"], assets.portfmeas[,"Mean"]))) par(mar=c(5, 4, 1, 2) + 0.1) #c(bottom, left, top, right) @@ -53,7 +53,7 @@ # Plot Ex Ante scatter of RP and BUOY portfolios in StdDev space # -------------------------------------------------------------------- # Done -png(filename="RP-BUOY-MeanSD-ExAnte.png", units="in", height=5.5, width=9, res=96) +png(filename=paste(resultsdir, "RP-BUOY-MeanSD-ExAnte.png", sep=""), units="in", height=5.5, width=9, res=96) par(mar=c(5, 4, 1, 2) + 0.1) #c(bottom, left, top, right) plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante Std Dev", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.7, xlim=xlim.StdDev, ylim=ylim.mean) grid(col = "darkgray") @@ -71,7 +71,7 @@ # Plot Ex Ante scatter of RP and BUOY portfolios in mETL space # -------------------------------------------------------------------- # Done -png(filename="RP-BUOYS-mETL-ExAnte.png", units="in", height=5.5, width=9, res=96) +png(filename=paste(resultsdir, "RP-BUOYS-mETL-ExAnte.png", sep=""), units="in", height=5.5, width=9, res=96) par(mar=c(5, 4, 1, 2) + 0.1) #c(bottom, left, top, right) xlim.ES=c(min(c(xtract[,"ES"], buoys.portfmeas[,"mETL"])), max(c(xtract[,"ES"], buoys.portfmeas[,"mETL"]))) plot(xtract[,"ES"],xtract[,"mean"], xlab="Ex Ante mETL", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.7, xlim=xlim.ES, ylim=ylim.mean) @@ -136,6 +136,14 @@ par(op) dev.off() +# -------------------------------------------------------------------- +# Scatter chart with DE trail +# -------------------------------------------------------------------- +png(filename=paste(resultsdir, "DE-MeanSD-ExAnte.png", sep=""), units="in", height=5.5, width=9, res=96) +# chart in same coordinates as RP; will leave some of the dots outside the chart bounds +chart.RiskReward(RiskBudget.DE, risk.col="StdDev", return.col="mean", xlim=xlim.StdDev, ylim=ylim.mean) +par(op) +dev.off() # -------------------------------------------------------------------- # Plot contribution of risk in EqWgt portfolio @@ -274,6 +282,148 @@ dev.off() # -------------------------------------------------------------------- -# Show CONCENTRATION of the RP portfolios? +# Show CONCENTRATION of the RP portfolios # -------------------------------------------------------------------- -# Basically the same chart as above but use HHI instead of turnover calc \ No newline at end of file +# Basically the same chart as above but use HHI instead of turnover calc + +png(filename="ConcPercESContrib.png", units="in", height=5.5, width=9, res=96) +WB20 = c(colorpanel(1, "#008566","#E1E56D"), colorpanel(20, "#E1E56D", "#742414")[-1]) +op <- par(no.readonly=TRUE) +layout(matrix(c(1,2)),height=c(4,1.25),width=1) +par(mar=c(4,4,1,2)+.1, cex=1) # c(bottom, left, top, right) +## Draw the Scatter chart of combined results +### Get the random portfolios from one of the result sets +x.hhi=apply(xtract[,10:16], FUN='HHI', MARGIN=1) +y=(x.hhi-min(x.hhi))/(max(x.hhi)-min(x.hhi)) # normalized HHI between 0 and 1 +plot(xtract[order(y,decreasing=TRUE),"StdDev"],xtract[order(y,decreasing=TRUE),"mean"], xlab="Ex Ante StdDev", ylab="Ex Ante Mean", col=WB20[floor(y[order(y,decreasing=TRUE)]*19)+1], axes=FALSE, main="", cex=.7, pch=16) +grid(col = "darkgray") +# points(RND.objectives[1,2],RND.objectives[1,1], col="blue", pch=19, cex=1.5) +axis(1, cex.axis = 0.8, col = "darkgray") +axis(2, cex.axis = 0.8, col = "darkgray") +box(col = "darkgray") + +# Add legend to bottom panel +par(mar=c(5,5.5,1,3)+.1, cex=0.7) +## Create a histogramed legend for sequential colorsets +## this next bit of code is based on heatmap.2 in gplots package +x=x.hhi +scale01 <- function(x, low = min(x), high = max(x)) { + return((x - low)/(high - low)) +} +breaks <- seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length = length(WB20)+1) +min.raw <- min(x, na.rm = TRUE) +max.raw <- max(x, na.rm = TRUE) +z <- seq(min.raw, max.raw, length = length(WB20)) +image(z = matrix(z, ncol = 1), col = WB20, breaks = breaks, xaxt = "n", yaxt = "n") +par(usr = c(0, 1, 0, 1)) # needed to draw the histogram correctly +lv <- pretty(breaks) +xv <- scale01(as.numeric(lv), min.raw, max.raw) +axis(1, at = xv, labels=sprintf("%s%%", pretty(lv))) +h <- hist(x, plot = FALSE, breaks=breaks) +hx <- scale01(breaks, min(x), max(x)) +hy <- c(h$counts, h$counts[length(h$counts)]) +lines(hx, hy/max(hy)*.95, lwd = 2, type = "s", col = "blue") +axis(2, at = pretty(hy)/max(hy)*.95, pretty(hy)) +title(ylab="Count") +title(xlab="Degree of Concentration from Equal Contribution Portfolio") +par(op) +dev.off() + +# -------------------------------------------------------------------- +# Show CONCENTRATION of the RP portfolios in HHI space +# -------------------------------------------------------------------- +png(filename="ConcPercESContrib-HHI-wHull.png", units="in", height=5.5, width=9, res=96) +WB20 = c(colorpanel(1, "#008566","#E1E56D"), colorpanel(20, "#E1E56D", "#742414")[-1]) +op <- par(no.readonly=TRUE) +layout(matrix(c(1,2)),height=c(4,1.25),width=1) +par(mar=c(4,4,1,2)+.1, cex=1) # c(bottom, left, top, right) +seq.col = heat.colors(11) +## Draw the Scatter chart of combined results +### Get the random portfolios from one of the result sets +x.hhi=apply(xtract[,10:16], FUN='HHI', MARGIN=1) +y=(x.hhi-min(x.hhi))/(max(x.hhi)-min(x.hhi)) # normalized HHI between 0 and 1 +plot(x.hhi[order(y,decreasing=TRUE)],xtract[order(y,decreasing=TRUE),"mean"], xlab="Degree of ex ante Risk Contribution", ylab="Ex Ante Mean", col=WB20[floor(y[order(y,decreasing=TRUE)]*19)+1], axes=FALSE, main="", cex=.7, pch=16) +grid(col = "darkgray") +# points(RND.objectives[1,2],RND.objectives[1,1], col="blue", pch=19, cex=1.5) +axis(1, cex.axis = 0.8, col = "darkgray") +axis(2, cex.axis = 0.8, col = "darkgray") +box(col = "darkgray") + +# HOWTO add a hull to this diagram +# Make a data.frame out of your vectors +dat <- data.frame(X = x.hhi[order(y,decreasing=TRUE)], Y = xtract[order(y,decreasing=TRUE),"mean"]) +dat <- data.frame(X = x.hhi, Y = xtract[,"mean"]) +# Compute the convex hull. This returns the index for the X and Y coordinates +c.hull <- chull(dat) +#Extract the coordinate points from the convex hull with the index. +z=dat[c.hull,] +# Plot the full hull +# with(dat, plot(X,Y)) +# lines(z, col = "pink", lwd = 3) + +# Or just do the ascending hull in Y +z[,3] <- c(diff(as.numeric(z[,1])),z[1,1]-tail(z[,1],1)) # calculate whether the line segment is ascending in X +z[,4] <- c(tail(z[,2],1)-z[1,2],diff(as.numeric(z[,2]))) # calculate whether the line segment is ascending in Y +lines(z[z[,3]>0 & z[,4]>0,1:2], col = "darkgrey", lwd = 2, type="b") +z=cbind(z,c.hull) +# Here are the portfolios on the hull +hull.portfolios=z[which(z[,3]>0 & z[,4]>0),5] + +# Add legend to bottom panel +par(mar=c(5,5.5,1,3)+.1, cex=0.7) +## Create a histogramed legend for sequential colorsets +## this next bit of code is based on heatmap.2 in gplots package +x=x.hhi +scale01 <- function(x, low = min(x), high = max(x)) { + return((x - low)/(high - low)) +} +breaks <- seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length = length(WB20)+1) +min.raw <- min(x, na.rm = TRUE) +max.raw <- max(x, na.rm = TRUE) +z <- seq(min.raw, max.raw, length = length(WB20)) +image(z = matrix(z, ncol = 1), col = WB20, breaks = breaks, xaxt = "n", yaxt = "n") +par(usr = c(0, 1, 0, 1)) # needed to draw the histogram correctly +lv <- pretty(breaks) +xv <- scale01(as.numeric(lv), min.raw, max.raw) +axis(1, at = xv, labels=sprintf("%s%%", pretty(lv))) +h <- hist(x, plot = FALSE, breaks=breaks) +hx <- scale01(breaks, min(x), max(x)) +hy <- c(h$counts, h$counts[length(h$counts)]) +lines(hx, hy/max(hy)*.95, lwd = 2, type = "s", col = "blue") +axis(2, at = pretty(hy)/max(hy)*.95, pretty(hy)) +title(ylab="Count") +title(xlab="Degree of Concentration from Equal Contribution Portfolio") +par(op) +dev.off() + + + +# Again, in Std Dev space with hull outlined +png(filename="ConcPercESContrib-SD-wHull.png", units="in", height=5.5, width=9, res=96) +WB20 = c(colorpanel(1, "#008566","#E1E56D"), colorpanel(20, "#E1E56D", "#742414")[-1]) +op <- par(no.readonly=TRUE) +layout(matrix(c(1,2)),height=c(4,1.25),width=1) +par(mar=c(4,4,1,2)+.1, cex=1) # c(bottom, left, top, right) +plot(xtract[order(y,decreasing=TRUE),"StdDev"],xtract[order(y,decreasing=TRUE),"mean"], xlab="Ex Ante StdDev", ylab="Ex Ante Mean", col=WB20[floor(y[order(y,decreasing=TRUE)]*19)+1], axes=FALSE, main="", cex=.7, pch=16) +points(xtract[hull.portfolios,"StdDev"], xtract[hull.portfolios,"mean"], col='blue') +lines(xtract[hull.portfolios,"StdDev"], xtract[hull.portfolios,"mean"], type="b", col='blue') +grid(col = "darkgray") +axis(1, cex.axis = 0.8, col = "darkgray") +axis(2, cex.axis = 0.8, col = "darkgray") +box(col = "darkgray") +dev.off() + +# Again, in ES space with hull outlined +png(filename="ConcPercESContrib-mETL-wHull.png", units="in", height=5.5, width=9, res=96) +WB20 = c(colorpanel(1, "#008566","#E1E56D"), colorpanel(20, "#E1E56D", "#742414")[-1]) +op <- par(no.readonly=TRUE) +layout(matrix(c(1,2)),height=c(4,1.25),width=1) +par(mar=c(4,4,1,2)+.1, cex=1) # c(bottom, left, top, right) +plot(xtract[order(y,decreasing=TRUE),"ES"],xtract[order(y,decreasing=TRUE),"mean"], xlab="Ex Ante mETL", ylab="Ex Ante Mean", col=WB20[floor(y[order(y,decreasing=TRUE)]*19)+1], axes=FALSE, main="", cex=.7, pch=16) +points(xtract[hull.portfolios,"ES"], xtract[hull.portfolios,"mean"], col='blue') +lines(xtract[hull.portfolios,"ES"], xtract[hull.portfolios,"mean"], type="b", col='blue') +grid(col = "darkgray") +axis(1, cex.axis = 0.8, col = "darkgray") +axis(2, cex.axis = 0.8, col = "darkgray") +box(col = "darkgray") +dev.off() \ No newline at end of file From noreply at r-forge.r-project.org Thu Oct 3 15:27:37 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 3 Oct 2013 15:27:37 +0200 (CEST) Subject: [Returnanalytics-commits] r3198 - pkg/PerformanceAnalytics/R Message-ID: <20131003132737.2018C185F8C@r-forge.r-project.org> Author: peter_carl Date: 2013-10-03 15:27:36 +0200 (Thu, 03 Oct 2013) New Revision: 3198 Modified: pkg/PerformanceAnalytics/R/chart.TimeSeries.R Log: - added correct las handling for axis labels Modified: pkg/PerformanceAnalytics/R/chart.TimeSeries.R =================================================================== --- pkg/PerformanceAnalytics/R/chart.TimeSeries.R 2013-10-02 19:46:18 UTC (rev 3197) +++ pkg/PerformanceAnalytics/R/chart.TimeSeries.R 2013-10-03 13:27:36 UTC (rev 3198) @@ -20,6 +20,7 @@ #' @param type set the chart type, same as in \code{\link{plot}} #' @param lty set the line type, same as in \code{\link{plot}} #' @param lwd set the line width, same as in \code{\link{plot}} +#' @param las set the axis label rotation, same as in \code{\link{plot}} #' @param main set the chart title, same as in \code{\link{plot}} #' @param ylab set the y-axis label, same as in \code{\link{plot}} #' @param xlab set the x-axis label, same as in \code{\link{plot}} @@ -146,9 +147,10 @@ type = "l", lty = 1, lwd = 2, + las = par("las"), main = NULL, ylab=NULL, - xlab="Date", + xlab="", date.format.in="%Y-%m-%d", date.format = NULL, xlim = NULL, @@ -319,13 +321,13 @@ if (xaxis) { if(minor.ticks) - axis(1, at=1:NROW(y), labels=FALSE, col='#BBBBBB') + axis(1, at=1:NROW(y), labels=FALSE, col='#BBBBBB', las=las) label.height = cex.axis *(.5 + apply(t(names(ep)),1, function(X) max(strheight(X, units="in")/par('cin')[2]) )) if(is.null(xaxis.labels)) xaxis.labels = names(ep) else ep = 1:length(xaxis.labels) - axis(1, at=ep, labels=xaxis.labels, las=1, lwd=1, mgp=c(3,label.height,0), cex.axis = cex.axis) + axis(1, at=ep, labels=xaxis.labels, las=1, lwd=1, mgp=c(3,label.height,0), cex.axis = cex.axis, las=las) # axis(1, at=ep, labels=xaxis.labels, las=1, lwd=1, mgp=c(3,2,0), cex.axis = cex.axis) #axis(1, at = lab.ind, lab=rownames[lab.ind], cex.axis = cex.axis, col = elementcolor) title(xlab = xlab, cex = cex.lab) @@ -335,9 +337,9 @@ # set up y-axis if (yaxis) if(yaxis.right) - axis(4, cex.axis = cex.axis, col=element.color, ylog=ylog) + axis(4, cex.axis = cex.axis, col=element.color, ylog=ylog, las=las) else - axis(2, cex.axis = cex.axis, col=element.color, ylog=ylog) + axis(2, cex.axis = cex.axis, col=element.color, ylog=ylog, las=las) box(col = element.color) if(!is.null(legend.loc)){ From noreply at r-forge.r-project.org Thu Oct 3 15:38:17 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 3 Oct 2013 15:38:17 +0200 (CEST) Subject: [Returnanalytics-commits] r3199 - pkg/PerformanceAnalytics/R Message-ID: <20131003133817.8EF1D1858DC@r-forge.r-project.org> Author: peter_carl Date: 2013-10-03 15:38:17 +0200 (Thu, 03 Oct 2013) New Revision: 3199 Modified: pkg/PerformanceAnalytics/R/chart.RiskReturnScatter.R Log: - added no.readonly=TRUE to par Modified: pkg/PerformanceAnalytics/R/chart.RiskReturnScatter.R =================================================================== --- pkg/PerformanceAnalytics/R/chart.RiskReturnScatter.R 2013-10-03 13:27:36 UTC (rev 3198) +++ pkg/PerformanceAnalytics/R/chart.RiskReturnScatter.R 2013-10-03 13:38:17 UTC (rev 3199) @@ -137,7 +137,7 @@ ylim = c(min(c(0,returns)), max(returns) + 0.02) if(add.boxplots){ - original.layout <- par() + original.layout <- par(no.readonly=TRUE) layout( matrix( c(2,1,0,3), 2, 2, byrow=TRUE ), c(1,6), c(4,1), ) From noreply at r-forge.r-project.org Thu Oct 3 16:19:32 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 3 Oct 2013 16:19:32 +0200 (CEST) Subject: [Returnanalytics-commits] r3200 - pkg/PortfolioAnalytics/sandbox/symposium2013/src Message-ID: <20131003141932.C7CC018590F@r-forge.r-project.org> Author: peter_carl Date: 2013-10-03 16:19:32 +0200 (Thu, 03 Oct 2013) New Revision: 3200 Added: pkg/PortfolioAnalytics/sandbox/symposium2013/src/pdf2png.sh Log: - automates file conversion from pdf to png using Imagemagick's convert Added: pkg/PortfolioAnalytics/sandbox/symposium2013/src/pdf2png.sh =================================================================== --- pkg/PortfolioAnalytics/sandbox/symposium2013/src/pdf2png.sh (rev 0) +++ pkg/PortfolioAnalytics/sandbox/symposium2013/src/pdf2png.sh 2013-10-03 14:19:32 UTC (rev 3200) @@ -0,0 +1,21 @@ +# #! /bin/bash +# Automate file conversion in bash +if [ "$1" == "" ]; then + inputdir="../results" + destdir="../docs/symposium-slides-2013-figure" +else + inputdir=$1 + destdir=$2 +fi +n=0; +echo " "; +echo "Converting:" +echo " "; +for file in $inputdir/*.pdf + do + pngfile=${file%%.pdf}.png + echo "$((++n)): $file to $destdir/$pngfile." + convert -density 300 $file -quality 100 -sharpen 0x1.0 $destdir/$pngfile + echo " "; + echo "$((n)) files were converted from PDF to PNG format." +done \ No newline at end of file Property changes on: pkg/PortfolioAnalytics/sandbox/symposium2013/src/pdf2png.sh ___________________________________________________________________ Added: svn:executable + * From noreply at r-forge.r-project.org Thu Oct 3 16:28:16 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 3 Oct 2013 16:28:16 +0200 (CEST) Subject: [Returnanalytics-commits] r3201 - pkg/PortfolioAnalytics/sandbox/symposium2013/src Message-ID: <20131003142816.C6A9A184633@r-forge.r-project.org> Author: peter_carl Date: 2013-10-03 16:28:16 +0200 (Thu, 03 Oct 2013) New Revision: 3201 Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/src/pdf2png.sh Log: - small modifications to output Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/src/pdf2png.sh =================================================================== --- pkg/PortfolioAnalytics/sandbox/symposium2013/src/pdf2png.sh 2013-10-03 14:19:32 UTC (rev 3200) +++ pkg/PortfolioAnalytics/sandbox/symposium2013/src/pdf2png.sh 2013-10-03 14:28:16 UTC (rev 3201) @@ -7,15 +7,16 @@ inputdir=$1 destdir=$2 fi +cd $inputdir n=0; echo " "; echo "Converting:" echo " "; -for file in $inputdir/*.pdf +for file in *.pdf do pngfile=${file%%.pdf}.png - echo "$((++n)): $file to $destdir/$pngfile." + echo "$((++n)): $file to $destdir/$pngfile" convert -density 300 $file -quality 100 -sharpen 0x1.0 $destdir/$pngfile - echo " "; - echo "$((n)) files were converted from PDF to PNG format." -done \ No newline at end of file +done +echo " "; +echo "$((n)) files were converted from PDF to PNG format." From noreply at r-forge.r-project.org Thu Oct 3 17:17:33 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 3 Oct 2013 17:17:33 +0200 (CEST) Subject: [Returnanalytics-commits] r3202 - in pkg/PortfolioAnalytics: R demo Message-ID: <20131003151733.134FD18591B@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-03 17:17:32 +0200 (Thu, 03 Oct 2013) New Revision: 3202 Modified: pkg/PortfolioAnalytics/R/charts.risk.R pkg/PortfolioAnalytics/R/extractstats.R pkg/PortfolioAnalytics/demo/demo_opt_combine.R Log: Modifying extractObjectiveMeasures for opt.list objects to evaluate each portfolio at all objectives. Modified barplot for risk budgets. Modified demo_opt_combine for more complete demo. Modified: pkg/PortfolioAnalytics/R/charts.risk.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.risk.R 2013-10-03 14:28:16 UTC (rev 3201) +++ pkg/PortfolioAnalytics/R/charts.risk.R 2013-10-03 15:17:32 UTC (rev 3202) @@ -406,7 +406,7 @@ if(is.null(colorset)) colorset <- 1:nrow(dat) # plot the data - barplot(dat, names.arg=columnnames, las=las, cex.names=cex.axis, col=colorset, main=main, ylab=paste(match.col, "% Contribution", sep=" "), cex.lab=cex.lab, cex.axis=cex.axis, ...) + barplot(dat, names.arg=columnnames, las=las, cex.names=cex.axis, col=colorset, main=main, ylab=paste(match.col, "% Contribution", sep=" "), cex.lab=cex.lab, cex.axis=cex.axis, beside=TRUE, ...) #axis(2, cex.axis=cex.axis, col=element.color) #axis(1, labels=columnnames, at=1:numassets, las=las, cex.axis=cex.axis, col=element.color) Modified: pkg/PortfolioAnalytics/R/extractstats.R =================================================================== --- pkg/PortfolioAnalytics/R/extractstats.R 2013-10-03 14:28:16 UTC (rev 3201) +++ pkg/PortfolioAnalytics/R/extractstats.R 2013-10-03 15:17:32 UTC (rev 3202) @@ -407,28 +407,73 @@ #' @method extractObjectiveMeasures opt.list #' @S3method extractObjectiveMeasures opt.list extractObjectiveMeasures.opt.list <- function(object){ + # The idea is that these portfolios in all have different objectives. + # Need a function to evaluate *all* objective measures for each portfolio. + # Challenges: + # - allow for different R objects across portfolios + # - Done + # - detect and remove duplicate objectives + # - Done based on name and objective type + # - handle duplicate objective names, but different arguments (i.e. different p for ES) + # - TODO + # - risk budget objectives need to be entered last + # - Done if(!inherits(object, "opt.list")) stop("object must be of class 'opt.list'") - # get/set the names in the object - opt_names <- names(object) - if(is.null(opt_names)) opt_names <- paste("opt", 1:length(object)) + # Get the names of the list + opt.names <- names(object) + if(is.null(opt.names)) opt.names <- paste("portfolio", 1:length(object)) - obj_list <- list() + # Initialize a tmp.obj list to store all of the objectives from each + tmp.obj <- list() + tmp.budget <- list() + + # Step 1: Loop through object and get the objectives from each portfolio for(i in 1:length(object)){ - tmp <- unlist(object[[i]]$objective_measures) - names(tmp) <- PortfolioAnalytics:::name.replace(names(tmp)) - obj_list[[opt_names[i]]] <- tmp - } - obj_list + tmp.portf <- object[[i]]$portfolio + for(j in 1:length(tmp.portf$objectives)){ + if(inherits(tmp.portf$objectives[[j]], "risk_budget_objective")){ + # tmp.budget <- c(tmp.budget, tmp.portf$objectives[[j]]) + num.budget <- length(tmp.budget) + 1 + tmp.budget[[num.budget]] <- tmp.portf$objectives[[j]] + } else { + # tmp.obj <- c(tmp.obj, tmp.portf$objectives[[j]]) + num.obj <- length(tmp.obj) + 1 + tmp.obj[[num.obj]] <- tmp.portf$objectives[[j]] + } + } # end inner loop of objectives + } # end outer loop of object - obj_names <- unique(unlist(lapply(obj_list, names))) + # This will make sure that "risk_budget_objectives" are entered last, but doesn't + # address duplicate names with different arguments in the arguments list + # e.g. different arguments for p, clean, etc. + tmp.obj <- c(tmp.obj, tmp.budget) - obj_mat <- matrix(NA, nrow=length(obj_list), ncol=length(obj_names), - dimnames=list(opt_names, obj_names)) + # Remove any duplicates + # The last objective will be the one that is kept + out.obj <- list() + obj.names <- sapply(tmp.obj, function(x) paste(x$name, class(x)[1], sep=".")) + if(any(duplicated(obj.names))){ + idx <- which(!duplicated(obj.names, fromLast=TRUE)) + for(i in 1:length(idx)){ + out.obj[[i]] <- tmp.obj[[idx[i]]] + } + } + out.obj - for(i in 1:length(obj_list)){ - pm <- pmatch(x=names(obj_list[[i]]), table=obj_names) - obj_mat[i, pm] <- obj_list[[i]] + # Loop through object and insert the new objectives list into each portfolio + # and run constrained_objective on each portfolio to extract the + # objective_measures for each portfolio + out <- list() + for(i in 1:length(object)){ + object[[i]]$portfolio$objectives <- tmp.obj + tmp.weights <- object[[i]]$weights + tmp.R <- object[[i]]$R + tmp.portf <- object[[i]]$portfolio + tmp <- unlist(constrained_objective(w=tmp.weights, R=tmp.R, portfolio=tmp.portf, trace=TRUE)$objective_measures) + names(tmp) <- PortfolioAnalytics:::name.replace(names(tmp)) + out[[opt.names[i]]] <- tmp } - return(obj_mat) + out <- do.call(rbind, out) + return(out) } Modified: pkg/PortfolioAnalytics/demo/demo_opt_combine.R =================================================================== --- pkg/PortfolioAnalytics/demo/demo_opt_combine.R 2013-10-03 14:28:16 UTC (rev 3201) +++ pkg/PortfolioAnalytics/demo/demo_opt_combine.R 2013-10-03 15:17:32 UTC (rev 3202) @@ -1,47 +1,58 @@ - library(PortfolioAnalytics) -library(ROI) -library(ROI.plugin.glpk) -library(ROI.plugin.quadprog) - -# We should be able to compare portfolios with different constraints, -# objectives, and number of assets - +library(DEoptim) data(edhec) -R <- edhec[, 1:4] +R <- edhec[, 1:5] funds <- colnames(R) -##### Construct Portfolios ##### -# GMV long only -port.gmv.lo <- portfolio.spec(assets=funds) -port.gmv.lo <- add.constraint(portfolio=port.gmv.lo, type="full_investment") -port.gmv.lo <- add.constraint(portfolio=port.gmv.lo, type="long_only") -port.gmv.lo <- add.objective(portfolio=port.gmv.lo, type="risk", name="var") +# Test different portfolios to test combining optimizations -# GMV with shorting -port.gmv.short <- portfolio.spec(assets=funds) -port.gmv.short <- add.constraint(portfolio=port.gmv.short, type="full_investment") -port.gmv.short <- add.constraint(portfolio=port.gmv.short, type="box", min=-0.3, max=1) -port.gmv.short <- add.objective(portfolio=port.gmv.short, type="risk", name="var") +# Add some basic constraints +init.portf <- portfolio.spec(assets=funds) +init.portf <- add.constraint(portfolio=init.portf, type="leverage", min_sum=0.99, max_sum=1.01) +init.portf <- add.constraint(portfolio=init.portf, type="long_only") -# QU box constraints -port.qu <- portfolio.spec(assets=funds) -port.qu <- add.constraint(portfolio=port.qu, type="full_investment") -port.qu <- add.constraint(portfolio=port.qu, type="box", min=0.05, max=0.6) -port.qu <- add.objective(portfolio=port.qu, type="risk", name="var", risk_aversion=0.25) -port.qu <- add.objective(portfolio=port.qu, type="return", name="mean") +# Objective to maximize portfolio mean return per unit ES +MeanES.portf <- add.objective(portfolio=init.portf, type="return", name="mean") +MeanES.portf <- add.objective(portfolio=MeanES.portf, type="risk", name="ES") -##### Run Optimizations ##### -opt.gmv.lo <- optimize.portfolio(R=R, portfolio=port.gmv.lo, optimize_method="ROI", trace=TRUE) -opt.gmv.short <- optimize.portfolio(R=R, portfolio=port.gmv.short, optimize_method="ROI", trace=TRUE) -opt.qu <- optimize.portfolio(R=R, portfolio=port.qu, optimize_method="ROI", trace=TRUE) +# Objective to maximize mean with risk budget percent contribution limit +MeanSD.portf <- add.objective(portfolio=init.portf, type="return", name="mean") +MeanSD.portf <- add.objective(portfolio=MeanSD.portf, type="risk_budget", name="StdDev", max_prisk=0.35) +# Objective to minimize portfolio expected shortfall with equal ES component contribution +ESRB.portf <- add.objective(portfolio=init.portf, type="risk", name="ES") +ESRB.portf <- add.objective(portfolio=ESRB.portf, type="risk_budget", name="ES", min_concentration=TRUE) -opt <- combine.optimizations(list(GMV.LO=opt.gmv.lo, GMV.SHORT=opt.gmv.short, QU=opt.qu)) -class(opt) -chart.Weights(opt, legend.loc="topleft", cex.legend=0.8, ylim=c(-0.3, 1)) +# MeanES optimization +MeanES.opt <- optimize.portfolio(R=R, portfolio=MeanES.portf, optimize_method="DEoptim", search_size=2000,, trace=TRUE) -chart.Weights(opt, plot.type="bar", cex.lab=0.8, legend.loc="topleft", cex.legend=0.8, ylim=c(-0.3, 1)) +# MeanSD optimization +MeanSD.opt <- optimize.portfolio(R=R, portfolio=MeanSD.portf, optimize_method="DEoptim", search_size=2000, trace=TRUE) -extractWeights(opt) +# ESRB optimization +ESRB.opt <- optimize.portfolio(R=R, portfolio=ESRB.portf, optimize_method="DEoptim", search_size=2000, trace=TRUE) + +# Combine the optimizations +opt <- combine.optimizations(list(MeanES=MeanES.opt, MeanSD=MeanSD.opt, ESRB=ESRB.opt)) + +# Extract the objective measures from each optimize.portfolio object evaluated at all objectives +obj <- extractObjectiveMeasures(opt) + +# Extract the optimal weights from each optimize.portfolio object +weights <- extractWeights(opt) + +# Chart the risk contributions for StdDev and ES +chart.RiskBudget(opt, match.col="StdDev", risk.type="percentage", ylim=c(0,1), legend.loc="topright") +chart.RiskBudget(opt, match.col="ES", risk.type="percentage", ylim=c(-0.2,1), legend.loc="topright") +chart.RiskBudget(opt, match.col="ES", risk.type="percentage", plot.type="bar", ylim=c(-0.2,1), legend.loc="topright") + +# Chart the optimal weights from each optimize.portfolio object +chart.Weights(opt, ylim=c(0,1)) +chart.Weights(opt, plot.type="bar", ylim=c(0,1)) + +# Chart the optimal portfolios in risk-reward space +chart.RiskReward(opt, main="Optimal Portfolios") +chart.RiskReward(opt, risk.col="StdDev", main="Optimal Portfolios") + + From noreply at r-forge.r-project.org Fri Oct 4 02:04:22 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 4 Oct 2013 02:04:22 +0200 (CEST) Subject: [Returnanalytics-commits] r3203 - pkg/PortfolioAnalytics/R Message-ID: <20131004000422.E7EF7185F91@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-04 02:04:21 +0200 (Fri, 04 Oct 2013) New Revision: 3203 Modified: pkg/PortfolioAnalytics/R/charts.multiple.R Log: Adding ability to plot assets in chart.RiskReward.opt.list. Modified: pkg/PortfolioAnalytics/R/charts.multiple.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.multiple.R 2013-10-03 15:17:32 UTC (rev 3202) +++ pkg/PortfolioAnalytics/R/charts.multiple.R 2013-10-04 00:04:21 UTC (rev 3203) @@ -67,7 +67,7 @@ #' @rdname chart.RiskReward #' @method chart.RiskReward opt.list #' @S3method chart.RiskReward opt.list -chart.RiskReward.opt.list <- function(object, ..., risk.col="ES", return.col="mean", main="", ylim=NULL, xlim=NULL, labels.assets=TRUE, pch.assets=1, cex.assets=0.8, cex.axis=0.8, cex.lab=0.8, colorset=NULL, element.color="darkgray"){ +chart.RiskReward.opt.list <- function(object, ..., risk.col="ES", return.col="mean", main="", ylim=NULL, xlim=NULL, labels.assets=TRUE, chart.assets=FALSE, pch.assets=1, cex.assets=0.8, cex.axis=0.8, cex.lab=0.8, colorset=NULL, element.color="darkgray"){ if(!inherits(object, "opt.list")) stop("object must be of class 'opt.list'") # Get the objective measures obj <- extractObjectiveMeasures(object) @@ -77,6 +77,39 @@ if(!(risk.col %in% columnnames)) stop(paste(risk.col, "not in column names")) if(!(return.col %in% columnnames)) stop(paste(return.col, "not in column names")) + if(chart.assets){ + # Get the returns from the firts opt.list object + R <- object[[1]]$R + if(is.null(R)) stop("Returns object not detected, must run optimize.portfolio with trace=TRUE") + if(!all(sapply(X=object, FUN=function(x) identical(x=R, y=x$R)))){ + message("Not all returns objects are identical, using returns object from first optimize.portfolio object") + } + # Get the arguments from the optimize.portfolio objects + # to calculate the risk and return metrics for the scatter plot. + # (e.g. arguments=list(p=0.925, clean="boudt") + arguments <- NULL # maybe an option to let the user pass in an arguments list? + if(is.null(arguments)){ + # get all the arguments from the portfolio in each optimize.portfolio object + tmp <- lapply(X=object, function(x) { + lapply(x$portfolio$objectives, function(u) u$arguments) + }) + # Flatten the nested lists + tmp.args <- do.call(c, unlist(tmp, recursive=FALSE)) + # Remove the name that gets added with unlist + names(tmp.args) <- gsub("^.*\\.", replacement="", names(tmp.args)) + # Remove any duplicate arguments + # if(any(duplicated(names(tmp.args)))) message("Multiple duplicate arguments, using first valid argument") + tmp.args <- tmp.args[!duplicated(names(tmp.args))] + if(!is.null(tmp.args$portfolio_method)) tmp.args$portfolio_method <- "single" + arguments <- tmp.args + } + asset_ret <- scatterFUN(R=R, FUN=return.col, arguments) + asset_risk <- scatterFUN(R=R, FUN=risk.col, arguments) + } else { + asset_ret <- NULL + asset_risk <- NULL + } + # data to plot dat <- na.omit(obj[, c(risk.col, return.col)]) if(ncol(dat) < 1) stop("No data to plot after na.omit") @@ -89,13 +122,13 @@ # set xlim and ylim if(is.null(xlim)){ - xlim <- range(dat[, risk.col]) + xlim <- range(c(dat[, risk.col], asset_risk)) xlim[1] <- 0 xlim[2] <- xlim[2] * 1.25 } if(is.null(ylim)){ - ylim <- range(dat[, return.col]) + ylim <- range(c(dat[, return.col], asset_ret)) ylim[1] <- 0 ylim[2] <- ylim[2] * 1.15 } @@ -104,6 +137,12 @@ plot(x=dat[, risk.col], y=dat[, return.col], cex.lab=cex.lab, main=main, ylab=return.col, xlab=risk.col, xlim=xlim, ylim=ylim, pch=pch.assets, col=colorset, ..., axes=FALSE) if(labels.assets) text(x=dat[, risk.col], y=dat[, return.col], labels=dat_names, pos=4, cex=cex.assets, col=colorset) + # plot the risk-reward scatter of the assets + if(chart.assets){ + points(x=asset_risk, y=asset_ret) + text(x=asset_risk, y=asset_ret, labels=colnames(R), pos=4, cex=0.8) + } + # add the axis axis(2, cex.axis=cex.axis, col=element.color) axis(1, cex.axis=cex.axis, col=element.color) From noreply at r-forge.r-project.org Fri Oct 4 02:57:54 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 4 Oct 2013 02:57:54 +0200 (CEST) Subject: [Returnanalytics-commits] r3204 - pkg/PortfolioAnalytics/R Message-ID: <20131004005754.BAD44185DA6@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-04 02:57:54 +0200 (Fri, 04 Oct 2013) New Revision: 3204 Modified: pkg/PortfolioAnalytics/R/charts.DE.R pkg/PortfolioAnalytics/R/charts.GenSA.R pkg/PortfolioAnalytics/R/charts.PSO.R pkg/PortfolioAnalytics/R/charts.ROI.R pkg/PortfolioAnalytics/R/charts.RP.R Log: Modifying chart.Scatter.* to use the arguments from the portfolio slot to calculate risk and return metrics for the assets. Modified: pkg/PortfolioAnalytics/R/charts.DE.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.DE.R 2013-10-04 00:04:21 UTC (rev 3203) +++ pkg/PortfolioAnalytics/R/charts.DE.R 2013-10-04 00:57:54 UTC (rev 3204) @@ -155,10 +155,19 @@ # print(colnames(head(xtract))) if(chart.assets){ + # Get the arguments from the optimize.portfolio$portfolio object + # to calculate the risk and return metrics for the scatter plot. + # (e.g. arguments=list(p=0.925, clean="boudt") + arguments <- NULL # maybe an option to let the user pass in an arguments list? + if(is.null(arguments)){ + tmp.args <- unlist(lapply(object$portfolio$objectives, function(x) x$arguments), recursive=FALSE) + tmp.args <- tmp.args[!duplicated(names(tmp.args))] + if(!is.null(tmp.args$portfolio_method)) tmp.args$portfolio_method <- "single" + arguments <- tmp.args + } # Include risk reward scatter of asset returns - asset_ret <- scatterFUN(R=R, FUN=return.col, ...=...) - asset_risk <- scatterFUN(R=R, FUN=risk.col, ...=...) - rnames <- colnames(R) + asset_ret <- scatterFUN(R=R, FUN=return.col, arguments) + asset_risk <- scatterFUN(R=R, FUN=risk.col, arguments) xlim <- range(c(xtract[,risk.column], asset_risk)) ylim <- range(c(xtract[,return.column], asset_ret)) } else { Modified: pkg/PortfolioAnalytics/R/charts.GenSA.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.GenSA.R 2013-10-04 00:04:21 UTC (rev 3203) +++ pkg/PortfolioAnalytics/R/charts.GenSA.R 2013-10-04 00:57:54 UTC (rev 3204) @@ -99,14 +99,20 @@ # cbind the optimal weights and random portfolio weights rp <- rbind(wts, rp) - returnpoints <- applyFUN(R=R, weights=rp, FUN=return.col, ...=...) - riskpoints <- applyFUN(R=R, weights=rp, FUN=risk.col, ...=...) + # Get the arguments from the optimize.portfolio$portfolio object + # to calculate the risk and return metrics for the scatter plot + tmp.args <- unlist(lapply(object$portfolio$objectives, function(x) x$arguments), recursive=FALSE) + tmp.args <- tmp.args[!duplicated(names(tmp.args))] + if(!is.null(tmp.args$portfolio_method)) tmp.args$portfolio_method <- "single" + arguments <- tmp.args + returnpoints <- applyFUN(R=R, weights=rp, FUN=return.col, arguments) + riskpoints <- applyFUN(R=R, weights=rp, FUN=risk.col, arguments) + if(chart.assets){ # Include risk reward scatter of asset returns - asset_ret <- scatterFUN(R=R, FUN=return.col, ...=...) - asset_risk <- scatterFUN(R=R, FUN=risk.col, ...=...) - rnames <- colnames(R) + asset_ret <- scatterFUN(R=R, FUN=return.col, arguments) + asset_risk <- scatterFUN(R=R, FUN=risk.col, arguments) } else { asset_ret <- NULL asset_risk <- NULL Modified: pkg/PortfolioAnalytics/R/charts.PSO.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.PSO.R 2013-10-04 00:04:21 UTC (rev 3203) +++ pkg/PortfolioAnalytics/R/charts.PSO.R 2013-10-04 00:57:54 UTC (rev 3204) @@ -135,10 +135,19 @@ } } if(chart.assets){ + # Get the arguments from the optimize.portfolio$portfolio object + # to calculate the risk and return metrics for the scatter plot. + # (e.g. arguments=list(p=0.925, clean="boudt") + arguments <- NULL # maybe an option to let the user pass in an arguments list? + if(is.null(arguments)){ + tmp.args <- unlist(lapply(object$portfolio$objectives, function(x) x$arguments), recursive=FALSE) + tmp.args <- tmp.args[!duplicated(names(tmp.args))] + if(!is.null(tmp.args$portfolio_method)) tmp.args$portfolio_method <- "single" + arguments <- tmp.args + } # Include risk reward scatter of asset returns - asset_ret <- scatterFUN(R=R, FUN=return.col, ...=...) - asset_risk <- scatterFUN(R=R, FUN=risk.col, ...=...) - rnames <- colnames(R) + asset_ret <- scatterFUN(R=R, FUN=return.col, arguments) + asset_risk <- scatterFUN(R=R, FUN=risk.col, arguments) xlim <- range(c(xtract[,risk.column], asset_risk)) ylim <- range(c(xtract[,return.column], asset_ret)) } else { Modified: pkg/PortfolioAnalytics/R/charts.ROI.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.ROI.R 2013-10-04 00:04:21 UTC (rev 3203) +++ pkg/PortfolioAnalytics/R/charts.ROI.R 2013-10-04 00:57:54 UTC (rev 3204) @@ -100,14 +100,20 @@ # cbind the optimal weights and random portfolio weights rp <- rbind(wts, rp) - returnpoints <- applyFUN(R=R, weights=rp, FUN=return.col, ...=...) - riskpoints <- applyFUN(R=R, weights=rp, FUN=risk.col, ...=...) + # Get the arguments from the optimize.portfolio$portfolio object + # to calculate the risk and return metrics for the scatter plot + tmp.args <- unlist(lapply(object$portfolio$objectives, function(x) x$arguments), recursive=FALSE) + tmp.args <- tmp.args[!duplicated(names(tmp.args))] + if(!is.null(tmp.args$portfolio_method)) tmp.args$portfolio_method <- "single" + arguments <- tmp.args + returnpoints <- applyFUN(R=R, weights=rp, FUN=return.col, arguments) + riskpoints <- applyFUN(R=R, weights=rp, FUN=risk.col, arguments) + if(chart.assets){ # Include risk reward scatter of asset returns - asset_ret <- scatterFUN(R=R, FUN=return.col, ...=...) - asset_risk <- scatterFUN(R=R, FUN=risk.col, ...=...) - rnames <- colnames(R) + asset_ret <- scatterFUN(R=R, FUN=return.col, arguments) + asset_risk <- scatterFUN(R=R, FUN=risk.col, arguments) } else { asset_ret <- NULL asset_risk <- NULL Modified: pkg/PortfolioAnalytics/R/charts.RP.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.RP.R 2013-10-04 00:04:21 UTC (rev 3203) +++ pkg/PortfolioAnalytics/R/charts.RP.R 2013-10-04 00:57:54 UTC (rev 3204) @@ -155,10 +155,19 @@ # print(colnames(head(xtract))) if(chart.assets){ + # Get the arguments from the optimize.portfolio$portfolio object + # to calculate the risk and return metrics for the scatter plot. + # (e.g. arguments=list(p=0.925, clean="boudt") + arguments <- NULL # maybe an option to let the user pass in an arguments list? + if(is.null(arguments)){ + tmp.args <- unlist(lapply(object$portfolio$objectives, function(x) x$arguments), recursive=FALSE) + tmp.args <- tmp.args[!duplicated(names(tmp.args))] + if(!is.null(tmp.args$portfolio_method)) tmp.args$portfolio_method <- "single" + arguments <- tmp.args + } # Include risk reward scatter of asset returns - asset_ret <- scatterFUN(R=R, FUN=return.col, ...=...) - asset_risk <- scatterFUN(R=R, FUN=risk.col, ...=...) - rnames <- colnames(R) + asset_ret <- scatterFUN(R=R, FUN=return.col, arguments) + asset_risk <- scatterFUN(R=R, FUN=risk.col, arguments) xlim <- range(c(xtract[,risk.column], asset_risk)) ylim <- range(c(xtract[,return.column], asset_ret)) } else { From noreply at r-forge.r-project.org Fri Oct 4 06:34:02 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 4 Oct 2013 06:34:02 +0200 (CEST) Subject: [Returnanalytics-commits] r3205 - pkg/PortfolioAnalytics/vignettes Message-ID: <20131004043402.44A4F183E10@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-04 06:34:01 +0200 (Fri, 04 Oct 2013) New Revision: 3205 Modified: pkg/PortfolioAnalytics/vignettes/portfolio_vignette.Rnw pkg/PortfolioAnalytics/vignettes/portfolio_vignette.pdf Log: Changing title for portfolio-vignette.pdf. Modified: pkg/PortfolioAnalytics/vignettes/portfolio_vignette.Rnw =================================================================== --- pkg/PortfolioAnalytics/vignettes/portfolio_vignette.Rnw 2013-10-04 00:57:54 UTC (rev 3204) +++ pkg/PortfolioAnalytics/vignettes/portfolio_vignette.Rnw 2013-10-04 04:34:01 UTC (rev 3205) @@ -39,7 +39,7 @@ \SweaveOpts{concordance=TRUE} -\title{Creating a Portfolio Object with PortfolioAnalytics} +\title{Introduction to PortfolioAnalytics} \author{Ross Bennett} \maketitle Modified: pkg/PortfolioAnalytics/vignettes/portfolio_vignette.pdf =================================================================== (Binary files differ) From noreply at r-forge.r-project.org Sat Oct 5 06:15:16 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 5 Oct 2013 06:15:16 +0200 (CEST) Subject: [Returnanalytics-commits] r3206 - pkg/PortfolioAnalytics/R Message-ID: <20131005041517.0DBE1184888@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-05 06:15:16 +0200 (Sat, 05 Oct 2013) New Revision: 3206 Modified: pkg/PortfolioAnalytics/R/extractstats.R Log: adding block of code to extractObjectiveMeasures.opt.list to extract the objective_measures as is if all objectives are identical. Modified: pkg/PortfolioAnalytics/R/extractstats.R =================================================================== --- pkg/PortfolioAnalytics/R/extractstats.R 2013-10-04 04:34:01 UTC (rev 3205) +++ pkg/PortfolioAnalytics/R/extractstats.R 2013-10-05 04:15:16 UTC (rev 3206) @@ -407,7 +407,7 @@ #' @method extractObjectiveMeasures opt.list #' @S3method extractObjectiveMeasures opt.list extractObjectiveMeasures.opt.list <- function(object){ - # The idea is that these portfolios in all have different objectives. + # The idea is that these portfolios opt.list may have different objectives. # Need a function to evaluate *all* objective measures for each portfolio. # Challenges: # - allow for different R objects across portfolios @@ -423,57 +423,85 @@ opt.names <- names(object) if(is.null(opt.names)) opt.names <- paste("portfolio", 1:length(object)) - # Initialize a tmp.obj list to store all of the objectives from each - tmp.obj <- list() - tmp.budget <- list() + # Use the objectives from the first element and use as the basis for comparison + base <- sapply(object[[1]]$portfolio$objectives, function(x) paste(class(x)[1], x$name, sep=".")) - # Step 1: Loop through object and get the objectives from each portfolio - for(i in 1:length(object)){ - tmp.portf <- object[[i]]$portfolio - for(j in 1:length(tmp.portf$objectives)){ - if(inherits(tmp.portf$objectives[[j]], "risk_budget_objective")){ - # tmp.budget <- c(tmp.budget, tmp.portf$objectives[[j]]) - num.budget <- length(tmp.budget) + 1 - tmp.budget[[num.budget]] <- tmp.portf$objectives[[j]] - } else { - # tmp.obj <- c(tmp.obj, tmp.portf$objectives[[j]]) - num.obj <- length(tmp.obj) + 1 - tmp.obj[[num.obj]] <- tmp.portf$objectives[[j]] - } - } # end inner loop of objectives - } # end outer loop of object + # Get the objective name and type from each portfolio + obj_list <- lapply(object, function(x) sapply(x$portfolio$objectives, function(u) paste(class(u)[1], u$name, sep="."))) - # This will make sure that "risk_budget_objectives" are entered last, but doesn't - # address duplicate names with different arguments in the arguments list - # e.g. different arguments for p, clean, etc. - tmp.obj <- c(tmp.obj, tmp.budget) - - # Remove any duplicates - # The last objective will be the one that is kept - out.obj <- list() - obj.names <- sapply(tmp.obj, function(x) paste(x$name, class(x)[1], sep=".")) - if(any(duplicated(obj.names))){ - idx <- which(!duplicated(obj.names, fromLast=TRUE)) - for(i in 1:length(idx)){ - out.obj[[i]] <- tmp.obj[[idx[i]]] + # If all the objective names are identical, simply extract the objective measures + # and build the objective_measures matrix + if(all(sapply(obj_list, function(u) identical(x=base, y=u)))){ + obj_list <- list() + # Get the objective_measures from each element + for(i in 1:length(object)){ + tmp <- unlist(object[[i]]$objective_measures) + names(tmp) <- PortfolioAnalytics:::name.replace(names(tmp)) + obj_list[[opt.names[i]]] <- tmp } + obj_names <- unique(unlist(lapply(obj_list, names))) + obj_mat <- matrix(NA, nrow=length(obj_list), ncol=length(obj_names), + dimnames=list(opt.names, obj_names)) + for(i in 1:length(obj_list)){ + pm <- pmatch(x=names(obj_list[[i]]), table=obj_names) + obj_mat[i, pm] <- obj_list[[i]] + } + out <- obj_mat + } else { + # The objectives across portfolios are not identical, we will build an + # objectives list with *all* the objectives and recalculate the objective_measures + + # Initialize a tmp.obj list to store all of the objectives from each + tmp.obj <- list() + tmp.budget <- list() + + # Step 1: Loop through object and get the objectives from each portfolio + for(i in 1:length(object)){ + tmp.portf <- object[[i]]$portfolio + for(j in 1:length(tmp.portf$objectives)){ + if(inherits(tmp.portf$objectives[[j]], "risk_budget_objective")){ + # tmp.budget <- c(tmp.budget, tmp.portf$objectives[[j]]) + num.budget <- length(tmp.budget) + 1 + tmp.budget[[num.budget]] <- tmp.portf$objectives[[j]] + } else { + # tmp.obj <- c(tmp.obj, tmp.portf$objectives[[j]]) + num.obj <- length(tmp.obj) + 1 + tmp.obj[[num.obj]] <- tmp.portf$objectives[[j]] + } + } # end inner loop of objectives + } # end outer loop of object + + # This will make sure that "risk_budget_objectives" are entered last, but doesn't + # address duplicate names with different arguments in the arguments list + # e.g. different arguments for p, clean, etc. + tmp.obj <- c(tmp.obj, tmp.budget) + + # Remove any duplicates + # The last objective will be the one that is kept + out.obj <- list() + obj.names <- sapply(tmp.obj, function(x) paste(x$name, class(x)[1], sep=".")) + if(any(duplicated(obj.names))){ + idx <- which(!duplicated(obj.names, fromLast=TRUE)) + for(i in 1:length(idx)){ + out.obj[[i]] <- tmp.obj[[idx[i]]] + } + } + + # Loop through object and insert the new objectives list into each portfolio + # and run constrained_objective on each portfolio to extract the + # objective_measures for each portfolio + out <- list() + for(i in 1:length(object)){ + object[[i]]$portfolio$objectives <- tmp.obj + tmp.weights <- object[[i]]$weights + tmp.R <- object[[i]]$R + tmp.portf <- object[[i]]$portfolio + tmp <- unlist(constrained_objective(w=tmp.weights, R=tmp.R, portfolio=tmp.portf, trace=TRUE)$objective_measures) + names(tmp) <- PortfolioAnalytics:::name.replace(names(tmp)) + out[[opt.names[i]]] <- tmp + } + out <- do.call(rbind, out) } - out.obj - - # Loop through object and insert the new objectives list into each portfolio - # and run constrained_objective on each portfolio to extract the - # objective_measures for each portfolio - out <- list() - for(i in 1:length(object)){ - object[[i]]$portfolio$objectives <- tmp.obj - tmp.weights <- object[[i]]$weights - tmp.R <- object[[i]]$R - tmp.portf <- object[[i]]$portfolio - tmp <- unlist(constrained_objective(w=tmp.weights, R=tmp.R, portfolio=tmp.portf, trace=TRUE)$objective_measures) - names(tmp) <- PortfolioAnalytics:::name.replace(names(tmp)) - out[[opt.names[i]]] <- tmp - } - out <- do.call(rbind, out) return(out) } From noreply at r-forge.r-project.org Sat Oct 5 15:36:19 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 5 Oct 2013 15:36:19 +0200 (CEST) Subject: [Returnanalytics-commits] r3207 - in pkg/PortfolioAnalytics/sandbox/symposium2013: . R Message-ID: <20131005133619.C1164185077@r-forge.r-project.org> Author: peter_carl Date: 2013-10-05 15:36:19 +0200 (Sat, 05 Oct 2013) New Revision: 3207 Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/R/chart.UnStackedBar.R pkg/PortfolioAnalytics/sandbox/symposium2013/R/page.Distributions.R pkg/PortfolioAnalytics/sandbox/symposium2013/analyze.HFindexes.R pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R Log: - checkpoint commits across the board Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/R/chart.UnStackedBar.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/symposium2013/R/chart.UnStackedBar.R 2013-10-05 04:15:16 UTC (rev 3206) +++ pkg/PortfolioAnalytics/sandbox/symposium2013/R/chart.UnStackedBar.R 2013-10-05 13:36:19 UTC (rev 3207) @@ -1,4 +1,4 @@ -chart.UnStackedBar <- function(w, colorset=1:NROW(w), rotate=c("vertical", "horizontal"), yaxis=TRUE, equal.line=FALSE) +chart.UnStackedBar <- function(w, colorset=1:NROW(w), rotate=c("vertical", "horizontal"), yaxis=TRUE, equal.line=FALSE, las=par(las), ...) { # Weights should come in as: # Convertible Arbitrage CTA Global Distressed Securities @@ -16,20 +16,20 @@ layout(matrix(c(1:NCOL(w)), nr = 1, byrow = TRUE)) for(i in 1:NCOL(w)){ if(i==1){ - barplot(w[,i], col=colorset[i], horiz=TRUE, xlim=c(0,max(w)), axes=FALSE, names.arg=row.names, las=2, cex.names=1) + barplot(w[,i], col=colorset[i], horiz=TRUE, xlim=c(0,max(w)), axes=FALSE, names.arg=row.names, las=las,...) abline(v=0, col="darkgray") if(equal.line) abline(v=1/NROW(w), col="darkgray", lty=2) - axis(1, cex.axis = 1, col = "darkgray", las=1) + axis(1, cex.axis = 1, col = "darkgray", las=las) mtext(colnames(w)[i], side= 3, cex=0.8, adj=0.5) } else{ - barplot(w[,i], col=colorset[i], horiz=TRUE, xlim=c(0,max(w)), axes=FALSE, names.arg="", ylab=colnames(w)[i]) + barplot(w[,i], col=colorset[i], horiz=TRUE, xlim=c(0,max(w)), axes=FALSE, names.arg="", ylab=colnames(w)[i], ...) abline(v=0, col="darkgray") if(equal.line) abline(v=1/NROW(w), col="darkgray", lty=2) if(yaxis) - axis(1, cex.axis = 1, col = "darkgray", las=1) + axis(1, cex.axis = 1, col = "darkgray", las=las) mtext(colnames(w)[i], side= 3, cex=0.8, adj=0.5) } } @@ -39,20 +39,20 @@ layout(matrix(c(1:NCOL(w)), nr = NCOL(w), byrow = FALSE)) for(i in 1:NCOL(w)){ if(i==NCOL(w)){ - barplot(w[,i], col=colorset[i], horiz=FALSE, ylim=c(0,max(w)), axes=FALSE, names.arg=row.names, las=2, cex.names=1.5) + barplot(w[,i], col=colorset[i], horiz=FALSE, ylim=c(0,max(w)), axes=FALSE, names.arg=row.names, las=las, cex.names=1.5, ...) abline(h=0, col="darkgray") if(equal.line) abline(h=1/NROW(w), col="darkgray", lty=2) - axis(2, cex.axis = 1, col = "darkgray", las=1) + axis(2, cex.axis = 1, col = "darkgray", las=las) mtext(colnames(w)[i], side= 3, cex=1, adj=0) } else{ - barplot(w[,i], col=colorset[i], horiz=FALSE, ylim=c(0,max(w)), axes=FALSE, names.arg="", ylab=colnames(w)[i]) + barplot(w[,i], col=colorset[i], horiz=FALSE, ylim=c(0,max(w)), axes=FALSE, names.arg="", ylab=colnames(w)[i], ...) abline(h=0, col="darkgray") if(equal.line) abline(h=1/NROW(w), col="darkgray", lty=2) if(yaxis) - axis(2, cex.axis = 1, col = "darkgray", las=1) + axis(2, cex.axis = 1, col = "darkgray", las=las) mtext(colnames(w)[i], side= 3, cex=1, adj=0) } } Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/R/page.Distributions.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/symposium2013/R/page.Distributions.R 2013-10-05 04:15:16 UTC (rev 3206) +++ pkg/PortfolioAnalytics/sandbox/symposium2013/R/page.Distributions.R 2013-10-05 13:36:19 UTC (rev 3207) @@ -1,6 +1,6 @@ # Histogram, QQPlot and ECDF plots aligned by scale for comparison -page.Distributions <- function (R, ...) { +page.Distributions <- function (R, colorset = c("black", "#00008F", "#005AFF", "#23FFDC", "#ECFF13", "#FF4A00", "#800000"), ...) { require(PerformanceAnalytics) op <- par(no.readonly = TRUE) # c(bottom, left, top, right) @@ -16,26 +16,25 @@ plot.new() text(x=1, y=0.5, adj=c(1,0.5), labels=row.names[i], cex=1.1) chart.Histogram(R[,i], main="", xlim=c(chart.mins, chart.maxs), - breaks=seq(round(chart.mins, digits=2)-0.01, round(chart.maxs, digits=2)+0.01, by=0.01), note.lines=boxplot.stats(as.vector(R[,i]))$stats, note.color="#005AFF", - show.outliers=TRUE, methods=c("add.normal"), colorset = - c("black", "#00008F", "#005AFF", "#23FFDC", "#ECFF13", "#FF4A00", "#800000")) + breaks=seq(round(chart.mins, digits=3)-0.005, round(chart.maxs, digits=3)+0.005, by=0.005), note.lines=boxplot.stats(as.vector(R[,i]))$stats, note.color=colorset[2], + show.outliers=TRUE, methods=c("add.normal"), colorset = colorset) abline(v=0, col="darkgray", lty=2) - chart.QQPlot(R[,i], main="", pch=20, envelope=0.95, col=c(1,"#005AFF"), ylim=c(chart.mins, chart.maxs)) + chart.QQPlot(R[,i], main="", pch=20, envelope=0.95, col=colorset, ylim=c(chart.mins, chart.maxs), cex=0.5) abline(v=0, col="darkgray", lty=2) - chart.ECDF(R[,i], main="", xlim=c(chart.mins, chart.maxs), lwd=2) + chart.ECDF(R[,i], main="", xlim=c(chart.mins, chart.maxs), lwd=2, colorset=colorset) abline(v=0, col="darkgray", lty=2) } else{ plot.new() text(x=1, y=0.5, adj=c(1,0.5), labels=row.names[i], cex=1.1) chart.Histogram(R[,i], main="", xlim=c(chart.mins, chart.maxs), - breaks=seq(round(chart.mins, digits=2)-0.01, round(chart.maxs, digits=2)+0.01, by=0.01), note.lines=boxplot.stats(as.vector(R[,i]))$stats, note.color="#005AFF", - xaxis=FALSE, yaxis=FALSE, show.outliers=TRUE, methods=c("add.normal"), colorset = - c("black", "#00008F", "#005AFF", "#23FFDC", "#ECFF13", "#FF4A00", "#800000")) + breaks=seq(round(chart.mins, digits=3)-0.005, round(chart.maxs, digits=3)+0.005, by=0.005), note.lines=boxplot.stats(as.vector(R[,i]))$stats, note.color=colorset[2], + xaxis=FALSE, yaxis=FALSE, show.outliers=TRUE, methods=c("add.normal"), colorset = colorset + ) abline(v=0, col="darkgray", lty=2) - chart.QQPlot(R[,i], main="", xaxis=FALSE, yaxis=FALSE, pch=20, envelope=0.95, col=c(1,"#005AFF"), ylim=c(chart.mins, chart.maxs)) + chart.QQPlot(R[,i], main="", xaxis=FALSE, yaxis=FALSE, pch=20, envelope=0.95, col=c(colorset), ylim=c(chart.mins, chart.maxs), cex=0.5) abline(v=0, col="darkgray", lty=2) - chart.ECDF(R[,i], main="", xlim=c(chart.mins, chart.maxs), xaxis=FALSE, yaxis=FALSE, lwd=2) + chart.ECDF(R[,i], main="", xlim=c(chart.mins, chart.maxs), xaxis=FALSE, yaxis=FALSE, lwd=2, colorset=colorset) abline(v=0, col="darkgray", lty=2) } } Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/analyze.HFindexes.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/symposium2013/analyze.HFindexes.R 2013-10-05 04:15:16 UTC (rev 3206) +++ pkg/PortfolioAnalytics/sandbox/symposium2013/analyze.HFindexes.R 2013-10-05 13:36:19 UTC (rev 3207) @@ -13,12 +13,53 @@ functionsdir = "./R/" ### Load the necessary packages +require(PerformanceAnalytics) require(vcd) # for color palates require(corrplot) # for correlation charts +require(gplots) +require(extrafont) +require(Cairo) +require(Hmisc) -# This may be useful for PCA analysis of index data -# require(FactorAnalytics) # development version > build +### Graphics +# To insert in Powerpoint 2007 (gah!), graphics should be rendered as pdf objects using the Cario package for better font handling: +# > CairoPDF(file="ConcPercESContrib-mETL-wHull.pdf", height=5.5, width=9, family="Cambria") +# then, do post-processing with ImageMagick on Linux: +# $ convert -density 300 ConcPercESContrib-mETL-wHull.pdf -quality 100 -sharpen 0x1.0 ConcPercESContrib-mETL-wHull.png +# That appears to give a sharp, dense picture that shows well on slides. Use the pdf directly if possible, of course. +# Corporate colors and fonts +wb13color = c( + rgb(0,65,101, max=255), # Blair Blue + rgb(129,147,219, max=255), # Light Purple + rgb(0,133,102, max=255), # Dark Green + rgb(0,0,0, max=255), # Black + rgb(154,155,156, max=255), # Light Grey + rgb(0,122,201, max=255), # Dark Cyan + rgb(240,171,0, max=255), # Bright Orange + rgb(72,72,74, max=255), # Dark Grey + rgb(122,184,0, max=255), # Bright Green + rgb(87,6,140, max=255), # Dark Purple + rgb(220,80,52, max=255), # Dark Orange + rgb(243,211,17, max=255), # Yellow + rgb(61,183,228, max=255) # Bright Cyan + ) + +# Skewed-scale GrYlRd in WmB colors for correlation charts +skewedWB20 = c(colorpanel(16, "#008566","#E1E56D"), colorpanel(5, "#E1E56D", "#742414")[-1]) + +CairoFonts( + regular="Cambria:style=Regular", + bold="Cambria:style=Bold", + italic="Cambria:style=Italic", + bolditalic="Cambria:style=Bold Italic,BoldItalic", + symbol="Symbol" +) + +par(las=1) # axis labels all horizontal +par(cex.lab=.8) # shrink axis labels +op <- par(no.readonly = TRUE) + ### Set up color palates pal <- function(col, border = "light gray", ...){ n <- length(col) @@ -42,7 +83,7 @@ # Constants p=1-(1/12) # Rf=.03/12 # Monthly risk free rate -colorset = rich8equal +colorset = wb13color dataname="EDHEC" ######################################################################## @@ -66,14 +107,12 @@ # -------------------------------------------------------------------- # Returns through time # -------------------------------------------------------------------- -png(filename=paste(resultsdir, dataname, "-Cumulative-Returns.png", sep=""), units="in", height=5.5, width=9, res=96) -par(cex.lab=.8) # should set these parameters once at the top -op <- par(no.readonly = TRUE) +CairoPDF(file=paste(resultsdir, dataname, "-Cumulative-Returns.pdf", sep=""), height=5.5, width=9) layout(matrix(c(1, 2)), height = c(2, 1.3), width = 1) par(mar = c(1, 4, 1, 2)) #c(bottom, left, top, right) -chart.CumReturns(R, main = "", xaxis = FALSE, legend.loc = "topleft", ylab = "Cumulative Return", colorset= rainbow8equal, ylog=TRUE, wealth.index=TRUE, cex.legend=.7, cex.axis=.6, cex.lab=.7) +chart.CumReturns(R, main = "", xaxis = FALSE, legend.loc = "topleft", ylab = "Cumulative Return", colorset= wb13color, ylog=TRUE, wealth.index=TRUE, cex.legend=.7, cex.axis=.6, cex.lab=.7, las=1, pch="") par(mar = c(4, 4, 0, 2)) -chart.Drawdown(edhec.R, main = "", ylab = "Drawdown", colorset = rainbow8equal, cex.axis=.6, cex.lab=.7) +chart.Drawdown(edhec.R, main = "", ylab = "Drawdown", colorset = wb13color, cex.axis=.6, cex.lab=.7, las=1) par(op) dev.off() @@ -81,52 +120,51 @@ # Monthly Returns and Risk # -------------------------------------------------------------------- # Done -png(filename=paste(resultsdir, dataname, "-BarVaR.png", sep=""), units="in", height=5.5, width=9, res=96) +CairoPDF(file=paste(resultsdir, dataname, "-BarVaR.pdf", sep=""), height=5.5, width=9) # Generate charts of returns with ETL and VaR through time par(mar=c(3, 4, 0, 2) + 0.1) #c(bottom, left, top, right) charts.BarVaR(R[,1:4], p=p, gap=36, main="", show.greenredbars=TRUE, methods=c("ModifiedES", "ModifiedVaR"), show.endvalue=TRUE, - colorset=rep("Black",7), ylim=c(-.1,.15)) + colorset=rep("Black",7), ylim=c(-.1,.15), las=1, clean="boudt") par(op) dev.off() -png(filename=paste(resultsdir, dataname, "-BarVaR2.png", sep=""), units="in", height=5.5, width=9, res=96) +CairoPDF(file=paste(resultsdir, dataname, "-BarVaR2.pdf", sep=""), height=5.5, width=9) # Generate charts of returns with ETL and VaR through time par(mar=c(3, 4, 0, 2) + 0.1) #c(bottom, left, top, right) charts.BarVaR(R[,5:7], p=p, gap=36, main="", show.greenredbars=TRUE, methods=c("ModifiedES", "ModifiedVaR"), show.endvalue=TRUE, - colorset=rep("Black",7), ylim=c(-.1,.15)) + colorset=rep("Black",7), ylim=c(-.1,.15), las=1, clean="boudt") par(op) dev.off() # -------------------------------------------------------------------- # Rolling Performance # -------------------------------------------------------------------- -png(filename=paste(resultsdir, dataname, "-RollPerf.png", sep=""), units="in", height=5.5, width=9, res=96) +CairoPDF(file=paste(resultsdir, dataname, "-RollPerf.pdf", sep=""), height=5.5, width=9) # Generate charts of EDHEC index returns with ETL and VaR through time par(mar=c(5, 4, 0, 2) + 0.1) #c(bottom, left, top, right) -charts.RollingPerformance(R, width=36, main="", colorset=rainbow8equal, legend.loc="topleft") +charts.RollingPerformance(R, width=36, main="", pch="", colorset=wb13color, legend.loc="topleft", las=1) par(op) dev.off() # -------------------------------------------------------------------- # Returns and Risk Scatter # -------------------------------------------------------------------- -png(filename=paste(resultsdir, dataname, "-Scatter36m.png", sep=""), units="in", height=5.5, width=4.5, res=96) -chart.RiskReturnScatter(last(edhec.R,36), main="EDHEC Index Trailing 36-Month Performance", colorset=rainbow8equal, ylim=c(0,.2), xlim=c(0,.12)) +CairoPDF(file=paste(resultsdir, dataname, "-Scatter36m.pdf", sep=""), height=5.5, width=4.5) +chart.RiskReturnScatter(last(edhec.R,36), main="EDHEC Index Trailing 36-Month Performance", colorset=wb13color, ylim=c(0,.2), xlim=c(0,.12), las=1) dev.off() -png(filename=paste(resultsdir, dataname, "-ScatterSinceIncept.png", sep=""), units="in", height=5.5, width=4.5, res=96) -chart.RiskReturnScatter(edhec.R, main="EDHEC Index Since Inception Performance", colorset=rainbow8equal, ylim=c(0,.2), xlim=c(0,.12)) +CairoPDF(file=paste(resultsdir, dataname, "-ScatterSinceIncept.pdf", sep=""), height=5.5, width=4.5) +chart.RiskReturnScatter(edhec.R, main="EDHEC Index Since Inception Performance", colorset=wb13color, ylim=c(0,.2), xlim=c(0,.12), las=1) dev.off() # -------------------------------------------------------------------- # Table of Return and Risk Statistics # -------------------------------------------------------------------- # @TODO: Too small, break into two panels? -require(Hmisc) source(paste(functionsdir,'table.RiskStats.R', sep="")) incept.stats = t(table.RiskStats(R=R, p=p, Rf=Rf)) write.csv(incept.stats, file=paste(resultsdir, dataname, "-inception-stats.csv", sep="")) -png(filename=paste(resultsdir, dataname, "-InceptionStats.png", sep=""), units="in", height=5.5, width=9, res=96) +CairoPDF(file=paste(resultsdir, dataname, "-InceptionStats.pdf", sep=""), height=5.5, width=4.5) textplot(format.df(incept.stats, na.blank=TRUE, numeric.dollar=FALSE, cdec=c(3,3,1,3,1,3,3,1,3,3,1,1,3,3,1,0), rmar = 0.8, cmar = 1, max.cex=.9, halign = "center", valign = "top", row.valign="center", wrap.rownames=20, wrap.colnames=10, mar = c(0,0,4,0)+0.1)) dev.off() @@ -134,38 +172,34 @@ # Compare Distributions # -------------------------------------------------------------------- # -png(filename=paste(resultsdir, dataname, "-Distributions.png", sep=""), units="in", height=5.5, width=9, res=96) +CairoPDF(file=paste(resultsdir, dataname, "-Distributions.pdf", sep=""), height=5.5, width=9) #source(paste(functionsdir, "/page.Distributions", sep="")) -page.Distributions(R[,1:4]) +page.Distributions(R[,1:4], colorset=wb13color, las=1) dev.off() -png(filename=paste(resultsdir, dataname, "-Distributions2.png", sep=""), units="in", height=5.5, width=9, res=96) +CairoPDF(file=paste(resultsdir, dataname, "-Distributions2.pdf", sep=""), height=5.5, width=9) #source(paste(functionsdir, "/page.Distributions", sep="")) -page.Distributions(R[,5:7]) +page.Distributions(R[,5:7], colorset=wb13color, las=1) dev.off() # -------------------------------------------------------------------- # Correlation Panels # -------------------------------------------------------------------- -# col3 <- colorRampPalette(c("darkgreen", "white", "darkred")) -library(gplots) -# Generate some color choices for the scale -skewedWB20 = c(colorpanel(16, "#008566","#E1E56D"), colorpanel(5, "#E1E56D", "#742414")[-1]) - +# col3 <- colorRampPalette(c("darkgreen", "white", "darkred")) M <- cor(R) colnames(M) = rownames(M) order.hc2 <- corrMatOrder(M, order="hclust", hclust.method="complete") M.hc2 <- M[order.hc2,order.hc2] -png(filename=paste(resultsdir, dataname, "-cor-inception.png", sep=""), units="in", height=5.5, width=4.5, res=96) +CairoPDF(file=paste(resultsdir, dataname, "-cor-inception.pdf", sep=""), height=5.5, width=4.5) corrplot(M.hc2, tl.col="black", tl.cex=0.8, method="shade", col=skewedWB20, cl.offset=.75, cl.cex=.7, cl.align.text="l", cl.ratio=.25, shade.lwd=0, cl.length=11) corrRect.hclust(M.hc2, k=3, method="complete", col="blue") dev.off() M36 <- cor(last(R,36)) -colnames(M36) = rownames(M36) = row.names +colnames(M36) = rownames(M36) = rownames(M) order36.hc2 <- corrMatOrder(M36, order="hclust", hclust.method="complete") M36.hc2 <- M36[order36.hc2,order36.hc2] -png(filename=paste(resultsdir, dataname, "-cor-tr36m.png", sep=""), units="in", height=5.5, width=4.5, res=96) +CairoPDF(file=paste(resultsdir, dataname, "-cor-tr36m.pdf", sep=""), height=5.5, width=4.5) corrplot(M36.hc2, tl.col="black", tl.cex=0.8, method="shade", col=skewedWB20, cl.offset=.75, cl.cex=.7, cl.align.text="l", cl.ratio=.25, shade.lwd=0, cl.length=11) corrRect.hclust(M36.hc2, k=3, method="complete", col="blue") dev.off() @@ -178,14 +212,15 @@ colnames(M)=R.foldednames # write(print(xtable(M, digits=1, align=rep("c",8)), type="html", html.table.attributes = "border = '0', align = 'center'"), file=paste(resultsdir, dataname, "-inception-cor.html", sep="")) # write(print(xtable(M, digits=1, align=rep("c",8))), file=paste(resultsdir, dataname, "-inception-cor.latex", sep="")) -write(pandoc.table.return(M, digits=1, split.tables=Inf), file=paste(resultsdir, dataname, "-inception-cor.md", sep="")) +# write(pandoc.table.return(M, digits=1, split.tables=Inf), file=paste(resultsdir, dataname, "-inception-cor.md", sep="")) # -------------------------------------------------------------------- # Rolling Correlation to S&P500 TR # -------------------------------------------------------------------- -png(filename=paste(resultsdir, dataname, "-RollCorr.png", sep=""), units="in", height=5.5, width=9, res=96) -chart.RollingCorrelation(R,SP500.TR, width=24, legend.loc="bottomleft", colorset=rainbow8equal, main="Rolling 24-Month Correlations") +CairoPDF(file=paste(resultsdir, dataname, "-RollCorr.pdf", sep=""), height=5.5, width=9) +chart.RollingCorrelation(R,SP500.TR, width=24, legend.loc=NULL, colorset=wb13color, main="Rolling 24-Month Correlation to S&P500 TR", las=1) +legend("bottomleft", legend=colnames(R), inset = 0.02, border.col="darkgrey", lwd=3, col=wb13color, cex=0.7, y.intersp=1.1) dev.off() # -------------------------------------------------------------------- @@ -195,15 +230,15 @@ # require(Hmisc) AC.stats = t(table.Autocorrelation(R=R)) write.csv(AC.stats, file=paste(resultsdir, dataname, "-AC-stats.csv", sep="")) -png(filename=paste(resultsdir, dataname, "-ACStats.png", sep=""), units="in", height=5.5, width=9, res=96) +CairoPDF(file=paste(resultsdir, dataname, "-ACStats.pdf", sep=""), height=5.5, width=4.5) # sort by p-value AC.order = order(AC.stats[,7], decreasing=FALSE) textplot(format.df(AC.stats[AC.order,], na.blank=TRUE, numeric.dollar=FALSE, rdec=c(rep(4,dim(AC.stats)[1])), col.just=rep("nc",dim(AC.stats)[2])), rmar = 0.7, cmar = 0.9, max.cex=1, halign = "center", valign = "center", row.valign="center", wrap.rownames=50, wrap.colnames=10) dev.off() -png(filename=paste(resultsdir, dataname, "-ACStackedBars.png", sep=""), units="in", height=5.5, width=9, res=96) +CairoPDF(file=paste(resultsdir, dataname, "-ACStackedBars.pdf", sep=""), height=5.5, width=9) rownames(AC.stats)= sapply(colnames(R), function(x) paste(strwrap(x,10), collapse = "\n"), USE.NAMES=FALSE) -chart.StackedBar(as.matrix(AC.stats[,1:6]), colorset=bluemono, main="Observed Autocorrelation") +chart.StackedBar(as.matrix(AC.stats[,1:6]), colorset=bluemono, main="Observed Autocorrelation", las=1) dev.off() # -------------------------------------------------------------------- @@ -211,16 +246,15 @@ # -------------------------------------------------------------------- # Requires a recent modification to the chart in PerformanceAnalytics to make the y-axes match; in revision 3191 source('./R/chart.VaRSensitivity.R') -png(filename=paste(resultsdir, dataname, "-ETL-sensitivity.png", sep=""), units="in", height=5.5, width=9, res=96) -op <- par(no.readonly = TRUE) +CairoPDF(file=paste(resultsdir, dataname, "-ETL-sensitivity.pdf", sep=""), height=5.5, width=9) layout(matrix(c(1:8), nrow=2)) par(mar = c(4, 4, 5, 2)+0.1) #c(bottom, left, top, right) for(i in 1:NCOL(R)){ - chart.VaRSensitivity(R[,i], methods=c("ModifiedES","HistoricalES", "GaussianES"), legend.loc=NULL, clean=clean, colorset=c("orange", "black", "darkgray"), lty=c(2,1,2), lwd=3, main=R.names[i], ylim=c(-0.09,0), ylab="Expected Tail Loss") - abline(v = 1-1/12, col = "red", lty = 2, lwd=1) + chart.VaRSensitivity(R[,i], methods=c("ModifiedES","HistoricalES", "GaussianES"), legend.loc=NULL, clean="boudt", colorset=wb13color, lty=c(2,1,2), lwd=3, main=R.names[i], ylim=c(-0.09,0), ylab="Expected Tail Loss", las=1) #c("orange", "black", "darkgray") + abline(v = 1-1/12, col = wb13color[11], lty = 2, lwd=1) } plot.new() - legend("center", legend=c("Modified \nETL","Historical \nETL", "Gaussian \nETL"), lty=c(2,1,2), lwd=3, col=c("orange", "black", "darkgray"), cex=1.2, y.intersp=2) + legend("center", legend=c("Modified \nETL","Historical \nETL", "Gaussian \nETL"), lty=c(2,1,2), lwd=3, col=wb13color, cex=1.2, y.intersp=2, box.col="darkgrey") par(op) dev.off() Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R 2013-10-05 04:15:16 UTC (rev 3206) +++ pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R 2013-10-05 13:36:19 UTC (rev 3207) @@ -104,6 +104,7 @@ MeanmETL.portf <- add.objective(portfolio=init.portf, type="return", # the kind of objective this is name="mean" # name of the function + , multiplier=-12 ) MeanmETL.portf <- add.objective(portfolio=MeanmETL.portf, type="risk", # the kind of objective this is @@ -239,9 +240,25 @@ # Modify the init.portf specification to get RP running rp.portf <- init.portf -# rp.portf$constraints[[1]]$min_sum = 0.99 # set to speed up RP -# rp.portf$constraints[[1]]$max_sum = 1.01 +rp.portf$constraints[[1]]$min_sum = 0.99 # set to speed up RP +rp.portf$constraints[[1]]$max_sum = 1.01 # rp = random_portfolios(portfolio=rp.portf, permutations=10000, max_permutations=400) +rp1 = random_portfolios(portfolio=rp.portf, permutations=10000, max_permutations=400, rp_method="sample") +rp1.mean = apply(rp1, 1, function(w) mean(R %*% w)) +rp1.sd = apply(rp1, 1, function(x) StdDev(R=R, weights=x, p=p)) +rp1.etl=NULL; for(i in 1:NROW(rp1)) {rp1.etl[i]=ETL(R=R, weights=as.vector(rp1[i,]), p=p, portfolio_method="component")[[1]]} +plot(rp1.sd, rp1.mean, col="gray", cex=0.5) + +rp2 = random_portfolios(portfolio=rp.portf, permutations=10000, max_permutations=400, rp_method="simplex", fev=2) +rp2.mean = apply(rp2, 1, function(w) mean(R %*% w)) +rp2.sd = apply(rp2, 1, function(x) StdDev(R=R, weights=x, p=p)) +points(rp2.sd,rp2.mean, col="blue", cex=0.5) + +rp3 = random_portfolios(portfolio=rp.portf, permutations=10000, max_permutations=400, rp_method="grid") +rp3.mean = apply(rp3, 1, function(w) mean(R %*% w)) +rp3.sd = apply(rp3, 1, function(x) StdDev(R=R, weights=x, p=p)) +points(rp3.sd,rp3.mean, col="green", cex=0.5) + # print(paste('done constructing random portfolios at',Sys.time())) # save(rp,file=paste(resultsdir, 'random-portfolios-', Sys.Date(), '-', runname, '.rda',sep='')) load(file=paste(resultsdir,'random-portfolios-2013-09-28.historical.moments.rda')) @@ -277,6 +294,13 @@ # rp=rp, # trace=TRUE # ) +# OR with random portfolios +MeanmETL.DE<-optimize.portfolio(R=R, + portfolio=MeanmETL.portf, + optimize_method='DEoptim', + search_size=20000 +) + # plot(MeanmETL.RND, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Mean-mETL Portfolio") # plot(MeanmETL.RND, risk.col="ES", return.col="mean", chart.assets=TRUE, main="Mean-mETL Portfolio") @@ -316,18 +340,25 @@ rp=rp, trace=TRUE ) + +EqSD.DE<-optimize.portfolio(R=R, + portfolio=EqSD.portf, + optimize_method='DEoptim', + search_size=20000, + trace=FALSE + ) plot(EqSD.RND, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Equal Volatility Contribution Portfolio") chart.RiskBudget(EqSD.RND, risk.type="percentage", neighbors=25) save(EqSD.RND,file=paste(resultsdir, 'EqSD.RND-', Sys.Date(), '-', runname, '.rda',sep='')) # or with DE -# EqSD.DE<-optimize.portfolio(R=R, -# portfolio=EqSD.portf, -# optimize_method='DEoptim', -# search_size=1000, -# trace=TRUE, verbose=TRUE -# ) +EqSD.DE<-optimize.portfolio(R=R, + portfolio=EqSD.portf, + optimize_method='DEoptim', + search_size=1000#, + #trace=TRUE, verbose=TRUE +) # plot(EqSD.DE, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Equal Volatility Contribution Portfolio") # chart.RiskBudget(EqSD.DE, risk.type="percentage") # save(EqSD.DE,file=paste(resultsdir, 'EqSD.DE-', Sys.Date(), '-', runname, '.rda',sep='')) Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R 2013-10-05 04:15:16 UTC (rev 3206) +++ pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R 2013-10-05 13:36:19 UTC (rev 3207) @@ -6,19 +6,19 @@ # Plot Ex Ante scatter of RP and ONLY Equal Weight portfolio in StdDev space # -------------------------------------------------------------------- # Done -png(filename=paste(resultsdir, "RP-EqWgt-MeanSD-ExAnte.png", sep=""), units="in", height=5.5, width=9, res=96) -par(mar=c(5, 4, 1, 2) + 0.1) #c(bottom, left, top, right) +CairoPDF(file=paste(resultsdir, dataname, "-RP-EqWgt-MeanSD-ExAnte.pdf", sep=""), height=6, width=9) +par(mar=c(5, 5, 1, 2) + 0.1) #c(bottom, left, top, right) # Calculate chart bounds to unify with the charts below xlim.StdDev=c(min(c(xtract[,"StdDev"], buoys.portfmeas[,"StdDev"])), max(c(xtract[,"StdDev"], buoys.portfmeas[,"StdDev"]))) ylim.mean=c(min(c(xtract[,"mean"], buoys.portfmeas[,"Mean"])), max(c(xtract[,"mean"], buoys.portfmeas[,"Mean"]))) -plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante Std Dev", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.7, xlim=xlim.StdDev, ylim=ylim.mean) +plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante Std Dev", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.6, xlim=xlim.StdDev, ylim=ylim.mean) grid(col = "darkgray") abline(h = 0, col = "darkgray") # Overplot the equal weight portfolio points(buoys.portfmeas[8,"StdDev"],buoys.portfmeas[8,"Mean"], col=tol8qualitative[8], pch=16, cex=1.5) # watch the order in portfmeas -axis(1, cex.axis = 0.8, col = "darkgray") -axis(2, cex.axis = 0.8, col = "darkgray") +axis(1, cex.axis = 0.8, col = "darkgray", las=1) +axis(2, cex.axis = 0.8, col = "darkgray", las=1) box(col = "darkgray") legend("bottomright",legend=results.names[8], col=tol8qualitative[8], pch=16, ncol=1, border.col="darkgray", y.intersp=1.2, cex=0.8, inset=.02) par(op) @@ -28,12 +28,12 @@ # Plot Ex Ante scatter of RP and ASSET portfolios in StdDev space # -------------------------------------------------------------------- # @TODO: add the assets to this chart -png(filename=paste(resultsdir, "RP-Assets-MeanSD-ExAnte.png", sep=""), units="in", height=5.5, width=9, res=96) +CairoPDF(file=paste(resultsdir, dataname, "-RP-Assets-MeanSD-ExAnte.pdf", sep=""), height=6, width=9) xlim.StdDev.assets =c(min(c(xtract[,"StdDev"], assets.portfmeas[,"StdDev"], 0)), max(c(xtract[,"StdDev"], assets.portfmeas[,"StdDev"],0.03))) ylim.mean.assets =c(min(c(xtract[,"mean"], assets.portfmeas[,"Mean"], 0)), max(c(xtract[,"mean"], assets.portfmeas[,"Mean"]))) -par(mar=c(5, 4, 1, 2) + 0.1) #c(bottom, left, top, right) +par(mar=c(5, 5, 1, 2) + 0.1) #c(bottom, left, top, right) # Revise the chart bounds to include the asssets -plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante mETL", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.7, xlim=xlim.StdDev.assets, ylim=ylim.mean.assets) +plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante mETL", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.6, xlim=xlim.StdDev.assets, ylim=ylim.mean.assets) grid(col = "darkgray") abline(h = 0, col = "darkgray") abline(v = 0, col = "darkgray") @@ -42,8 +42,8 @@ text(x=buoys.portfmeas[8,"StdDev"], y=buoys.portfmeas[8,"Mean"], labels=rownames(buoys.portfmeas)[8], pos=4, cex=1) points(assets.portfmeas[,"StdDev"],assets.portfmeas[,"Mean"], col=rich8equal, pch=18, cex=1.5) # watch the order in portfmeas text(x=assets.portfmeas[,"StdDev"], y=assets.portfmeas[,"Mean"], labels=rownames(assets.portfmeas), pos=4, cex=1) -axis(1, cex.axis = 0.8, col = "darkgray") -axis(2, cex.axis = 0.8, col = "darkgray") +axis(1, cex.axis = 0.7, col = "darkgray") +axis(2, cex.axis = 0.7, col = "darkgray") box(col = "darkgray") #legend("right",legend=rownames(assets.portfmeas), col=rich8equal, pch=16, ncol=1, border.col="darkgray", y.intersp=1.2, cex=0.8, inset=.02) par(op) @@ -53,15 +53,15 @@ # Plot Ex Ante scatter of RP and BUOY portfolios in StdDev space # -------------------------------------------------------------------- # Done -png(filename=paste(resultsdir, "RP-BUOY-MeanSD-ExAnte.png", sep=""), units="in", height=5.5, width=9, res=96) -par(mar=c(5, 4, 1, 2) + 0.1) #c(bottom, left, top, right) -plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante Std Dev", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.7, xlim=xlim.StdDev, ylim=ylim.mean) +CairoPDF(file=paste(resultsdir, dataname, "-RP-BUOY-MeanSD-ExAnte.pdf", sep=""), height=6, width=9) +par(mar=c(5, 5, 1, 2) + 0.1) #c(bottom, left, top, right) +plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante Std Dev", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.6, xlim=xlim.StdDev, ylim=ylim.mean) grid(col = "darkgray") abline(h = 0, col = "darkgray") # Overplot the buoy portfolios points(buoys.portfmeas[,"StdDev"],buoys.portfmeas[,"Mean"], col=tol8qualitative, pch=16, cex=1.5) # watch the order in portfmeas -axis(1, cex.axis = 0.8, col = "darkgray") -axis(2, cex.axis = 0.8, col = "darkgray") +axis(1, cex.axis = 0.7, col = "darkgray") +axis(2, cex.axis = 0.7, col = "darkgray") box(col = "darkgray") legend("bottomright",legend=results.names, col=tol8qualitative, pch=16, ncol=1, border.col="darkgray", y.intersp=1.2, cex=0.8, inset=.02) par(op) @@ -71,15 +71,15 @@ # Plot Ex Ante scatter of RP and BUOY portfolios in mETL space # -------------------------------------------------------------------- # Done -png(filename=paste(resultsdir, "RP-BUOYS-mETL-ExAnte.png", sep=""), units="in", height=5.5, width=9, res=96) -par(mar=c(5, 4, 1, 2) + 0.1) #c(bottom, left, top, right) +CairoPDF(file=paste(resultsdir, dataname, "-RP-BUOYS-mETL-ExAnte.pdf", sep=""), height=6, width=9) +par(mar=c(5, 5, 1, 2) + 0.1) #c(bottom, left, top, right) xlim.ES=c(min(c(xtract[,"ES"], buoys.portfmeas[,"mETL"])), max(c(xtract[,"ES"], buoys.portfmeas[,"mETL"]))) -plot(xtract[,"ES"],xtract[,"mean"], xlab="Ex Ante mETL", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.7, xlim=xlim.ES, ylim=ylim.mean) +plot(xtract[,"ES"],xtract[,"mean"], xlab="Ex Ante mETL", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.6, xlim=xlim.ES, ylim=ylim.mean) grid(col = "darkgray") # Overplot the buoy portfolios points(buoys.portfmeas[,"mETL"],buoys.portfmeas[,"Mean"], col=tol8qualitative, pch=16, cex=1.5) # watch the order in portfmeas -axis(1, cex.axis = 0.8, col = "darkgray") -axis(2, cex.axis = 0.8, col = "darkgray") +axis(1, cex.axis = 0.7, col = "darkgray") +axis(2, cex.axis = 0.7, col = "darkgray") box(col = "darkgray") legend("bottomright",legend=results.names, col=tol8qualitative, pch=16, ncol=1, border.col="darkgray", y.intersp=1.2, cex=0.8, inset=.02) par(op) @@ -91,7 +91,7 @@ # Done source('./R/chart.UnStackedBar.R') # Wgts = extractWeights(buoys) -png(filename=paste(resultsdir, "Weights-Buoys.png", sep=""), units="in", height=5.5, width=9, res=96) +CairoPDF(file=paste(resultsdir, dataname, "-Weights-Buoys.png", sep=""), units="in", height=6, width=9, res=96) chart.UnStackedBar(t(Wgts), colorset=tol8qualitative, equal.line=TRUE) dev.off() [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 3207 From noreply at r-forge.r-project.org Mon Oct 7 03:53:34 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 7 Oct 2013 03:53:34 +0200 (CEST) Subject: [Returnanalytics-commits] r3208 - pkg/PortfolioAnalytics/sandbox/symposium2013 Message-ID: <20131007015334.6959C184D49@r-forge.r-project.org> Author: peter_carl Date: 2013-10-07 03:53:33 +0200 (Mon, 07 Oct 2013) New Revision: 3208 Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R Log: - checkpoint changes to optimizations - added volatility weighted benchmark - modifications to DE parameters - changes to risk budget portfolio Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R 2013-10-05 13:36:19 UTC (rev 3207) +++ pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R 2013-10-07 01:53:33 UTC (rev 3208) @@ -20,7 +20,7 @@ ### Set script constants runname='historical.moments' -#rebalance_period = 'quarters' # uses endpoints identifiers from xts; how to do semi-annual? +rebalance_period = 'quarters' # uses endpoints identifiers from xts; how to do semi-annual? clean = "none" #"boudt" # "none" permutations = 2000 p=1-1/12 # set confidence for VaR/mETL for monthly data @@ -66,7 +66,7 @@ ) # Add leverage constraint init.portf <- add.constraint(portfolio=init.portf, - type="full_investment" + type="leverage" ) # Add box constraint init.portf <- add.constraint(portfolio=init.portf, @@ -102,15 +102,15 @@ #@ random portfolios or DEoptim. - RB # Add the return and mETL objectives MeanmETL.portf <- add.objective(portfolio=init.portf, - type="return", # the kind of objective this is - name="mean" # name of the function + type="return", # the kind of objective this is + name="mean" # name of the function , multiplier=-12 - ) + ) MeanmETL.portf <- add.objective(portfolio=MeanmETL.portf, - type="risk", # the kind of objective this is - name="ES", # the function to minimize - arguments=list(p=p) - ) + type="risk", # the kind of objective this is + name="ES", # the function to minimize + arguments=list(p=p) + ) ### Construct BUOY 3: Constrained Minimum Variance Portfolio - using ROI # Add the variance objective @@ -136,15 +136,15 @@ # name="StdDev" # ) # OR EqSD.portf <- add.objective(portfolio=init.portf, - type="return", - name="mean" + type="return", + name="mean" ) EqSD.portf <- add.objective(portfolio=EqSD.portf, - type="risk_budget", - name="StdDev", - min_concentration=TRUE, - arguments = list(clean=clean) - ) + type="risk_budget", + name="StdDev", + min_concentration=TRUE, + arguments = list(clean=clean) + ) # EqSD.portf$constraints[[1]]$min_sum = 0.99 # set to speed up RP # EqSD.portf$constraints[[1]]$max_sum = 1.01 @@ -187,81 +187,98 @@ EqWt.portf <- add.objective(portfolio=EqWt.portf, type="risk_budget", name="ES", arguments=list(p=p, clean=clean)) EqWt.portf <- add.objective(portfolio=EqWt.portf, type="risk_budget", name="StdDev", arguments=list(clean=clean)) +### Construct BUOY 8: Inverse Volatility Portfolio +# There's only one, so create a portfolio object with all the objectives we want calculated. +VolWgt.portf <- portfolio.spec(assets=colnames(R)) +VolWgt.portf <- add.constraint(portfolio=VolWgt.portf, type="leverage", min_sum=0.99, max_sum=1.01) +VolWgt.portf <- add.objective(portfolio=VolWgt.portf, type="return", name="mean") +VolWgt.portf <- add.objective(portfolio=VolWgt.portf, type="risk_budget", name="ES", arguments=list(p=p, clean=clean)) +VolWgt.portf <- add.objective(portfolio=VolWgt.portf, type="risk_budget", name="StdDev", arguments=list(clean=clean)) + ### Construct RISK BUDGET Portfolio -RiskBudget.portf <- portfolio.spec(assets=colnames(R), - weight_seq=generatesequence(by=0.005) +ConstrConcmETL.portf <- portfolio.spec(assets=colnames(R), + weight_seq=generatesequence(by=0.005) ) # Add leverage constraint -RiskBudget.portf <- add.constraint(portfolio=RiskBudget.portf, - type="leverage", - min_sum=0.99, # set to speed up RP - max_sum=1.01 +ConstrConcmETL.portf <- add.constraint(portfolio=RiskBudget.portf, + type="leverage", + min_sum=0.99, # set to speed up RP, DE + max_sum=1.01 ) # Establish position bounds -RiskBudget.portf <- add.constraint(portfolio=RiskBudget.portf, - type="box", - min=0.05, - max=1.0 +ConstrConcmETL.portf <- add.constraint(portfolio=ConstrConcmETL.portf, + type="box", + min=0.01, # leave relatively unconstrained + max=1.0 ) # Maximize mean return -RiskBudget.portf <- add.objective(portfolio=RiskBudget.portf, - type="return", - name="mean" - ) +ConstrConcmETL.portf <- add.objective(portfolio=ConstrConcmETL.portf, + type="return", # maximize return + name="mean", + multiplier=12 +) # Add a risk measure # Use ES to be consistent with risk measures in other BUOY portfolios -# RiskBudget.portf <- add.objective(portfolio=RiskBudget.portf, -# type="risk", -# name="ES", -# multiplier=1, -# arguments = list(p=(1-1/12), clean=clean) -# ) +ConstrConcmETL.portf <- add.objective(portfolio=ConstrConcmETL.portf, + type="risk", + name="ETL", # using a different name to avoid clobbering slot below, workaround for bug + multiplier=1, + arguments = list(p=p, clean=clean) +) -# Set risk budget limits -RiskBudget.portf <- add.objective(portfolio=RiskBudget.portf, - type="risk_budget", - name="ES", - max_prisk=0.3, - arguments = list(p=(1-1/12), clean=clean) - ) +# Set contribution limits +ConstrConcmETL.portf <- add.objective(portfolio=ConstrConcmETL.portf, + type="risk_budget", + name="ES", + max_prisk=0.3, # Sets the maximum percentage contribution to risk + arguments = list(p=p, clean=clean) +) # Calculate portfolio variance, but don't use it in the objective; used only for plots -RiskBudget.portf <- add.objective(portfolio=RiskBudget.portf, - type="risk", # the kind of objective this is - name="StdDev", # the function to minimize - enabled=TRUE, # enable or disable the objective - multiplier=0, # calculate it but don't use it in the objective - arguments=list(clean=clean) -) +# ConstrConcmETL.portf <- add.objective(portfolio=ConstrConcmETL.portf, +# type="risk", # the kind of objective this is +# name="StdDev", # the function to minimize +# enabled=TRUE, # enable or disable the objective +# multiplier=0, # calculate it but don't use it in the objective +# arguments=list(clean=clean) +# ) #------------------------------------------------------------------------ ### Evaluate portfolio objective objects +#------------------------------------------------------------------------ # Generate a single set of random portfolios to evaluate against all RP constraint sets print(paste('constructing random portfolios at',Sys.time())) # Modify the init.portf specification to get RP running rp.portf <- init.portf -rp.portf$constraints[[1]]$min_sum = 0.99 # set to speed up RP -rp.portf$constraints[[1]]$max_sum = 1.01 -# rp = random_portfolios(portfolio=rp.portf, permutations=10000, max_permutations=400) -rp1 = random_portfolios(portfolio=rp.portf, permutations=10000, max_permutations=400, rp_method="sample") -rp1.mean = apply(rp1, 1, function(w) mean(R %*% w)) -rp1.sd = apply(rp1, 1, function(x) StdDev(R=R, weights=x, p=p)) -rp1.etl=NULL; for(i in 1:NROW(rp1)) {rp1.etl[i]=ETL(R=R, weights=as.vector(rp1[i,]), p=p, portfolio_method="component")[[1]]} -plot(rp1.sd, rp1.mean, col="gray", cex=0.5) +# rp.portf$constraints[[1]]$min_sum = 0.99 # set to speed up RP +# rp.portf$constraints[[1]]$max_sum = 1.01 +rp.portf$constraints[[1]]$min_sum = 1.00 # for more accuracy +rp.portf$constraints[[1]]$max_sum = 1.00 +# rp = random_portfolios(portfolio=rp.portf, permutations=30000, max_permutations=400) # will get fewer with less accuracy +rp.mean = apply(rp1, 1, function(w) mean(R %*% w)) +rp.sd = apply(rp1, 1, function(x) StdDev(R=R, weights=x, p=p, clean=clean)) +plot(rp.sd, rp.mean, col="darkgray", cex=0.5) -rp2 = random_portfolios(portfolio=rp.portf, permutations=10000, max_permutations=400, rp_method="simplex", fev=2) -rp2.mean = apply(rp2, 1, function(w) mean(R %*% w)) -rp2.sd = apply(rp2, 1, function(x) StdDev(R=R, weights=x, p=p)) -points(rp2.sd,rp2.mean, col="blue", cex=0.5) +# This was fruitless: +# rp1 = random_portfolios(portfolio=rp.portf, permutations=10000, max_permutations=400, rp_method="sample") +# rp1.mean = apply(rp1, 1, function(w) mean(R %*% w)) +# rp1.sd = apply(rp1, 1, function(x) StdDev(R=R, weights=x, p=p)) +# rp1.etl=NULL; for(i in 1:NROW(rp1)) {rp1.etl[i]=ETL(R=R, weights=as.vector(rp1[i,]), p=p, portfolio_method="component")[[1]]} +# plot(rp1.sd, rp1.mean, col="gray", cex=0.5) +# +# rp2 = random_portfolios(portfolio=rp.portf, permutations=10000, max_permutations=400, rp_method="simplex", fev=2) +# rp2.mean = apply(rp2, 1, function(w) mean(R %*% w)) +# rp2.sd = apply(rp2, 1, function(x) StdDev(R=R, weights=x, p=p)) +# points(rp2.sd,rp2.mean, col="blue", cex=0.5) +# +# rp3 = random_portfolios(portfolio=rp.portf, permutations=10000, max_permutations=400, rp_method="grid") +# rp3.mean = apply(rp3, 1, function(w) mean(R %*% w)) +# rp3.sd = apply(rp3, 1, function(x) StdDev(R=R, weights=x, p=p)) +# points(rp3.sd,rp3.mean, col="green", cex=0.5) -rp3 = random_portfolios(portfolio=rp.portf, permutations=10000, max_permutations=400, rp_method="grid") -rp3.mean = apply(rp3, 1, function(w) mean(R %*% w)) -rp3.sd = apply(rp3, 1, function(x) StdDev(R=R, weights=x, p=p)) -points(rp3.sd,rp3.mean, col="green", cex=0.5) - # print(paste('done constructing random portfolios at',Sys.time())) # save(rp,file=paste(resultsdir, 'random-portfolios-', Sys.Date(), '-', runname, '.rda',sep='')) -load(file=paste(resultsdir,'random-portfolios-2013-09-28.historical.moments.rda')) +load(file=paste(resultsdir,'random-portfolios-2013-10-05.historical.moments.rda')) start_time<-Sys.time() print(paste('Starting optimization at',Sys.time())) @@ -276,33 +293,39 @@ save(MeanSD.ROI,file=paste(resultsdir, 'MeanSD-', Sys.Date(), '-', runname, '.rda',sep='')) # Save the results print(paste('Completed meanSD optimization at',Sys.time(),'moving on to meanmETL')) -### Evaluate BUOY 2: Constrained Mean-mETL Portfolio - with ROI -MeanmETL.ROI<-optimize.portfolio(R=R, - portfolio=MeanmETL.portf, - optimize_method='ROI', - trace=TRUE, verbose=TRUE - ) -plot(MeanmETL.ROI, risk.col="StdDev", return.col="mean", rp=permutations, chart.assets=TRUE, main="Mean-mETL Portfolio") -plot(MeanmETL.ROI, risk.col="ES", return.col="mean", rp=permutations, chart.assets=TRUE, main="Mean-mETL Portfolio") -save(MeanmETL.ROI,file=paste(resultsdir, 'MeanETL-', Sys.Date(), '-', runname, '.rda',sep='')) +### Evaluate BUOY 2: Constrained Mean-mETL Portfolio - with DE or RND +# Not possible with ROI - RB +# MeanmETL.ROI<-optimize.portfolio(R=R, +# portfolio=MeanmETL.portf, +# optimize_method='ROI', +# trace=TRUE, verbose=TRUE +# ) +# + +# So use random portfolios instead +MeanmETL.RND<-optimize.portfolio(R=R, + portfolio=MeanmETL.portf, + optimize_method='random', + rp=rp, + trace=TRUE +) +plot(MeanmETL.RND, risk.col="StdDev", return.col="mean", rp=permutations, chart.assets=TRUE, main="Mean-mETL Portfolio") +plot(MeanmETL.RND, risk.col="ES", return.col="mean", rp=permutations, chart.assets=TRUE, main="Mean-mETL Portfolio") +save(MeanmETL.RND,file=paste(resultsdir, 'MeanETL-RP-', Sys.Date(), '-', runname, '.rda',sep='')) chart.EfficientFrontier(MeanmETL.RND) -print(paste('Completed meanmETL optimization at',Sys.time(),'moving on to MinSD')) -# OR with random portfolios -# MeanmETL.RND<-optimize.portfolio(R=R, -# portfolio=MeanmETL.portf, -# optimize_method='random', -# rp=rp, -# trace=TRUE -# ) -# OR with random portfolios + +# OR with DE optim MeanmETL.DE<-optimize.portfolio(R=R, - portfolio=MeanmETL.portf, - optimize_method='DEoptim', - search_size=20000 + portfolio=MeanmETL.portf, + optimize_method='DEoptim', + search_size=20000, + initialpop=rp[1:50,] # seed with a starting population that we know fits the constraint space ) +plot(MeanmETL.DE, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Mean-mETL Portfolio") +plot(MeanmETL.DE, risk.col="ES", return.col="mean", chart.assets=TRUE, main="Mean-mETL Portfolio") +save(MeanmETL.DE,file=paste(resultsdir, 'MeanETL-DE-', Sys.Date(), '-', runname, '.rda',sep='')) +print(paste('Completed meanmETL optimization at',Sys.time(),'moving on to MinSD')) -# plot(MeanmETL.RND, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Mean-mETL Portfolio") -# plot(MeanmETL.RND, risk.col="ES", return.col="mean", chart.assets=TRUE, main="Mean-mETL Portfolio") ### Evaluate BUOY 3: Constrained Minimum Variance Portfolio - with ROI MinSD.ROI<-optimize.portfolio(R=R, @@ -334,35 +357,29 @@ print(paste('Completed MinmETL optimization at',Sys.time(),'moving on to EqSD')) ### Evaluate BUOY 5: Constrained Equal Variance Contribution Portfolio - with RP -EqSD.RND<-optimize.portfolio(R=R, - portfolio=EqSD.portf, - optimize_method='random', - rp=rp, - trace=TRUE - ) +# EqSD.RND<-optimize.portfolio(R=R, +# portfolio=EqSD.portf, +# optimize_method='random', +# rp=rp, +# trace=TRUE +# ) +# plot(EqSD.RND, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Equal Volatility Contribution Portfolio") +# chart.RiskBudget(EqSD.RND, risk.type="percentage", neighbors=25) +# save(EqSD.RND,file=paste(resultsdir, 'EqSD.RND-', Sys.Date(), '-', runname, '.rda',sep='')) +# ... not a very satisfying solution +# OR DE optim - this gets very close (a nice, straight line), so use it EqSD.DE<-optimize.portfolio(R=R, portfolio=EqSD.portf, optimize_method='DEoptim', search_size=20000, + initialpop=rp[1:50,], # seed with a starting population that we know fits the constraint space trace=FALSE ) -plot(EqSD.RND, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Equal Volatility Contribution Portfolio") -chart.RiskBudget(EqSD.RND, risk.type="percentage", neighbors=25) -save(EqSD.RND,file=paste(resultsdir, 'EqSD.RND-', Sys.Date(), '-', runname, '.rda',sep='')) +plot(EqSD.DE, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Equal Volatility Contribution Portfolio") +chart.RiskBudget(EqSD.DE, risk.type="percentage", neighbors=25) +save(EqSD.DE,file=paste(resultsdir, 'EqSD.DE-', Sys.Date(), '-', runname, '.rda',sep='')) - -# or with DE -EqSD.DE<-optimize.portfolio(R=R, - portfolio=EqSD.portf, - optimize_method='DEoptim', - search_size=1000#, - #trace=TRUE, verbose=TRUE -) -# plot(EqSD.DE, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Equal Volatility Contribution Portfolio") -# chart.RiskBudget(EqSD.DE, risk.type="percentage") -# save(EqSD.DE,file=paste(resultsdir, 'EqSD.DE-', Sys.Date(), '-', runname, '.rda',sep='')) - print(paste('Completed EqSD optimization at',Sys.time(),'moving on to EqmETL')) ### Evaluate BUOY 6: Constrained Equal mETL Contribution Portfolio - with RP @@ -376,32 +393,113 @@ plot(EqmETL.RND, risk.col="ES", return.col="mean", chart.assets=TRUE, main="Equal mETL Contribution Portfolio") chart.RiskBudget(EqmETL.RND, neighbors=25) save(EqmETL.RND,file=paste(resultsdir, 'EqmETL-', Sys.Date(), '-', runname, '.rda',sep='')) + +# OR DE optim - +EqmETL.DE<-optimize.portfolio(R=R, + portfolio=EqmETL.portf, + optimize_method='DEoptim', + search_size=20000, + NP=200, + initialpop=rp[1:50,], # seed with a starting population that we know fits the constraint space + trace=FALSE + ) +plot(EqmETL.DE, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Equal Volatility Contribution Portfolio") +chart.RiskBudget(EqmETL.DE, risk.type="percentage", neighbors=25) +save(EqmETL.DE,file=paste(resultsdir, 'EqmETL.DE-', Sys.Date(), '-', runname, '.rda',sep='')) + +# test it unconstrained: +unconstr.portf <- portfolio.spec(assets=colnames(R), + weight_seq=generatesequence(by=0.005) +) +unconstr.portf <- add.constraint(portfolio=unconstr.portf, + type="leverage", + min_sum=0.99, # set to speed up RP + max_sum=1.01 +) +# Establish position bounds +unconstr.portf <- add.constraint(portfolio=unconstr.portf, + type="box", + min=0.01, + max=1.0 +) +EqmETLun.portf <- add.objective(portfolio=unconstr.portf, + type="return", + name="mean" +) +EqmETLun.portf <- add.objective(EqmETL.portf, + type="risk_budget", + name="ES", + min_concentration=TRUE, + arguments = list(p=p, clean=clean) +) + +# ...in DE optim - +EqmETLun.DE<-optimize.portfolio(R=R, + portfolio=EqmETLun.portf, + optimize_method='DEoptim', + search_size=20000, + NP=200, + initialpop=rp[1:50,], # seed with a starting population that we know fits the constraint space + trace=FALSE + ) + print(paste('Completed EqmETL optimization at',Sys.time(),'moving on to RiskBudget')) ### Evaluate BUOY 7: Equal Weight Portfolio # Calculate the objective measures for the equal weight portfolio EqWt.opt <- equal.weight(R=R, portfolio=EqWt.portf) +### Evaluate BUOY 8: Inverse Volatility Portfolio +volatility.weight <- function (R, portfolio, ...) +{ + if (!is.portfolio(portfolio)) + stop("portfolio object passed in must be of class 'portfolio'") + assets <- portfolio$assets + nassets <- length(assets) + weights <- as.vector((1/StdDev(R))/sum(1/StdDev(R))) + names(weights) <- names(assets) + if (ncol(R) != nassets) { + if (ncol(R) > nassets) { + R <- R[, 1:nassets] + warning("number of assets is less than number of columns in returns object, subsetting returns object.") + } + else { + stop("number of assets is greater than number of columns in returns object") + } + } + out <- constrained_objective(w = weights, R = R, portfolio = portfolio, + trace = TRUE, ...)$objective_measures + return(structure(list(R = R, weights = weights, objective_measures = out, + call = match.call(), portfolio = portfolio), class = c("optimize.portfolio.invol", + "optimize.portfolio"))) +} +# Calculate the objective measures for the vol weight portfolio +VolWgt.opt <- volatility.weight(R=R, portfolio=VolWgt.portf) -### Evaluate Risk Budget Portfolio - with DE +### Evaluate Constrained Concentration to mETL Portfolio - with DE # registerDoSEQ() # turn off parallelization to keep the trace data -RiskBudget.DE<-optimize.portfolio(R=R, - portfolio=RiskBudget.portf, - optimize_method='DEoptim', - search_size=1000, trace=TRUE - ) -plot(RiskBudget.DE, risk.col="StdDev", return.col="mean") -plot(RiskBudget.DE, risk.col="ES", return.col="mean") # several outlier portfolios -chart.RiskBudget(RiskBudget.DE) -chart.RiskBudget(RiskBudget.DE, risk.type="percentage") +ConstrConcmETL.DE<-optimize.portfolio(R=R, + portfolio=ConstrConcmETL.portf, + optimize_method='DEoptim', + search_size=40000, + NP=4000, + itermax=400, + trace=FALSE +) +# list(c=0.25, # speed of crossover adaption (0,1] +# CR=0.75) # crossover probability [0,1] +plot(ConstrConcmETL.DE, risk.col="StdDev", return.col="mean") +plot(ConstrConcmETL.DE, risk.col="ES", return.col="mean") # several outlier portfolios +chart.RiskBudget(ConstrConcmETL.DE) +chart.RiskBudget(ConstrConcmETL.DE, risk.type="percentage") -save(RiskBudget.DE,file=paste(resultsdir, 'RiskBudget-', Sys.Date(), '-', runname, '.rda',sep='')) -print(RiskBudget.DE$elapsed_time) +save(ConstrConcmETL.DE,file=paste(resultsdir, 'ConstrConcmETL-', Sys.Date(), '-', runname, '.rda',sep='')) +print(ConstrConcmETL.DE$elapsed_time) print('Done with optimizations.') #------------------------------------------------------------------------ ### Extract data from optimizations for analysis - +#------------------------------------------------------------------------ # Combine optimization objects buoys <- combine.optimizations(list(MeanSD=MeanSD.ROI, MeanmETL=MeanmETL.ROI, MinSD=MinSD.ROI, MinmETL=MinmETL.ROI, EqSD=EqSD.RND, EqmETL=EqmETL.RND, RB=RiskBudget.DE, EqWt=EqWt.opt)) chart.Weights(buoys, plot.type="bar", ylim=c(0,1)) @@ -460,6 +558,39 @@ colnames(assets.portfmeas)=c("Mean", "StdDev", "mETL") rownames(assets.portfmeas)=colnames(Wgts) + + +#------------------------------------------------------------------------ +# Run select buoy optimizations through time +#------------------------------------------------------------------------ +# + +# Equal Weight +dates=index(R[endpoints(R, on=rebalance_period)]) +EqWgt.w = xts(matrix(rep(1/NCOL(R),length(dates)*NCOL(R)), ncol=NCOL(R)), order.by=dates) +colnames(EqWgt.w)= colnames(R) +EqWgt.R=Return.rebalancing(R, EqWgt.w) +chart.StackedBar(EqWgt.w, colorset=wb13color, gap=0) + +# Equal mETL +EqmETL.DE.t = optimize.portfolio.rebalancing(R=R, + portfolio=EqmETL.portf, + optimize_method='DEoptim', + search_size=20000, + NP=200, + initialpop=rp[1:50,], # seed with a starting population that we know fits the constraint space + trace=FALSE, + rebalance_on=rebalance_period, # uses xts 'endpoints' + trailing_periods=NULL, # calculates from inception + training_period=36) # starts 3 years in to the data history +EqmETL.w = extractWeights.rebal(EqmETL.DE.t) +chart.UnStackedBar(EqmETL.w, rotate="horizontal", colorset=wb13color, space=0, las=2) +EqmETL=Return.rebalancing(edhec.R, EqmETL.w) +colnames(EqmETL) = "EqmETL" +save(EqmETL.DE.t,file=paste(resultsdir, 'EqmETL.DE.t-', Sys.Date(), '-', runname, '.rda',sep='')) + + + end_time<-Sys.time() end_time-start_time From noreply at r-forge.r-project.org Mon Oct 7 03:54:19 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 7 Oct 2013 03:54:19 +0200 (CEST) Subject: [Returnanalytics-commits] r3209 - pkg/PortfolioAnalytics/sandbox/symposium2013/R Message-ID: <20131007015419.692C9184D49@r-forge.r-project.org> Author: peter_carl Date: 2013-10-07 03:54:19 +0200 (Mon, 07 Oct 2013) New Revision: 3209 Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/R/chart.UnStackedBar.R Log: - handles xts objects correctly for xaxis labels Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/R/chart.UnStackedBar.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/symposium2013/R/chart.UnStackedBar.R 2013-10-07 01:53:33 UTC (rev 3208) +++ pkg/PortfolioAnalytics/sandbox/symposium2013/R/chart.UnStackedBar.R 2013-10-07 01:54:19 UTC (rev 3209) @@ -10,7 +10,10 @@ # if (wrap) # row.names = sapply(rownames(object), function(x) paste(strwrap(x, wrap.rownames), collapse = "\n"), USE.NAMES = FALSE) rotate = rotate[1] - row.names = sapply(rownames(w), function(x) paste(strwrap(x,10), collapse = "\n"), USE.NAMES=FALSE) + if(is(w, "xts")) + row.names=index(w) + else + row.names = sapply(rownames(w), function(x) paste(strwrap(x,10), collapse = "\n"), USE.NAMES=FALSE) if(rotate=="vertical"){ par(oma = c(4,8,2,1), mar=c(0,1,0,1)) # c(bottom, left, top, right) layout(matrix(c(1:NCOL(w)), nr = 1, byrow = TRUE)) @@ -47,7 +50,7 @@ mtext(colnames(w)[i], side= 3, cex=1, adj=0) } else{ - barplot(w[,i], col=colorset[i], horiz=FALSE, ylim=c(0,max(w)), axes=FALSE, names.arg="", ylab=colnames(w)[i], ...) + barplot(w[,i], col=colorset[i], horiz=FALSE, ylim=c(0,max(w)), axes=FALSE, names.arg=rep("",length(w[,i])), ylab=colnames(w)[i], ...) abline(h=0, col="darkgray") if(equal.line) abline(h=1/NROW(w), col="darkgray", lty=2) From noreply at r-forge.r-project.org Mon Oct 7 08:09:55 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 7 Oct 2013 08:09:55 +0200 (CEST) Subject: [Returnanalytics-commits] r3210 - pkg/PortfolioAnalytics/R Message-ID: <20131007060955.28F9B183ACF@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-07 08:09:54 +0200 (Mon, 07 Oct 2013) New Revision: 3210 Modified: pkg/PortfolioAnalytics/R/extract.efficient.frontier.R pkg/PortfolioAnalytics/R/optFUN.R pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: Adding functionality to maximize mean / ETL using ROI solvers. Modified: pkg/PortfolioAnalytics/R/extract.efficient.frontier.R =================================================================== --- pkg/PortfolioAnalytics/R/extract.efficient.frontier.R 2013-10-07 01:54:19 UTC (rev 3209) +++ pkg/PortfolioAnalytics/R/extract.efficient.frontier.R 2013-10-07 06:09:54 UTC (rev 3210) @@ -226,7 +226,7 @@ maxret <- extractObjectiveMeasures(tmp)$mean # run the optimization to get the return at the min ETL portfolio - tmp <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI") + tmp <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI", ef=TRUE) stats <- extractStats(tmp) minret <- stats["mean"] @@ -242,7 +242,7 @@ stopifnot("package:foreach" %in% search() || require("foreach",quietly = TRUE)) out <- foreach(i=1:length(ret_seq), .inorder=TRUE, .combine=rbind, .errorhandling='remove') %dopar% { portfolio$objectives[[mean_idx]]$target <- ret_seq[i] - extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI")) + extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI", ef=TRUE)) } colnames(out) <- names(stats) return(structure(out, class="frontier")) Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-10-07 01:54:19 UTC (rev 3209) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-10-07 06:09:54 UTC (rev 3210) @@ -708,3 +708,81 @@ # constraints=L_constraint(L=Amat, dir=dir, rhs=rhs)) # roi.result <- ROI_solve(x=opt.prob, solver="quadprog") } + + +mean_etl_opt <- function(R, constraints, moments, target, alpha, tol=.Machine$double.eps^0.5, maxit=50){ + # This function returns the target mean return that maximizes mean / etl (i.e. starr) + + # if all(moments$mean == 0) then the user did not specify mean as an objective, + # and we just want to return the target mean return value + if(all(moments$mean == 0)) return(target) + + fmean <- matrix(moments$mean, ncol=1) + + # can't use optimize.portfolio here, this function is called inside + # optimize.portfolio and will throw an error message about nesting too deeply + + # Find the maximum return + max_ret <- maxret_opt(R=R, moments=moments, constraints=constraints, target=NA) + max_mean <- as.numeric(-max_ret$out) + + # Find the starr at the maximum etl portfolio + ub_etl <- etl_opt(R=R, constraints=constraints, moments=moments, target=max_mean, alpha=alpha) + ub_weights <- matrix(ub_etl$weights, ncol=1) + ub_mean <- as.numeric(t(ub_weights) %*% fmean) + ub_etl <- as.numeric(ub_etl$out) + # starr at the upper bound + ub_starr <- ub_mean / ub_etl + + # Find the starr at the minimum etl portfolio + lb_etl <- etl_opt(R=R, constraints=constraints, moments=moments, target=NA, alpha=alpha) + lb_weights <- matrix(lb_etl$weights) + lb_mean <- as.numeric(t(lb_weights) %*% fmean) + lb_etl <- as.numeric(lb_etl$out) + # starr at the lower bound + lb_starr <- lb_mean / lb_etl + + # want to find the return that maximizes mean / etl + i <- 1 + while((abs(ub_starr - lb_starr) > tol) & (i < maxit)){ + # bisection method to find the maximum mean / etl + + print(i) + print(ub_starr) + print(lb_starr) + print("**********") + # Find the starr at the mean return midpoint + new_ret <- (lb_mean + ub_mean) / 2 + mid <- etl_opt(R=R, constraints=constraints, moments=moments, target=new_ret, alpha=alpha) + mid_weights <- matrix(mid$weights, ncol=1) + mid_mean <- as.numeric(t(mid_weights) %*% fmean) + mid_etl <- as.numeric(mid$out) + mid_starr <- mid_mean / mid_etl + # tmp_starr <- mid_starr + + if(mid_starr > ub_starr){ + # if mid_starr > ub_starr then mid_starr becomes the new upper bound + ub_mean <- mid_mean + ub_starr <- mid_starr + new_ret <- (lb_mean + ub_mean) / 2 + mid <- etl_opt(R=R, constraints=constraints, moments=moments, target=new_ret, alpha=alpha) + mid_weights <- matrix(mid$weights, ncol=1) + mid_mean <- as.numeric(t(mid_weights) %*% fmean) + mid_etl <- as.numeric(mid$out) + mid_starr <- mid_mean / mid_etl + } + if(mid_starr > lb_starr){ + # if mid_starr > lb_starr then mid_starr becomes the new lower bound + lb_mean <- mid_mean + lb_starr <- mid_starr + new_ret <- (lb_mean + ub_mean) / 2 + mid <- etl_opt(R=R, constraints=constraints, moments=moments, target=new_ret, alpha=alpha) + mid_weights <- matrix(mid$weights, ncol=1) + mid_mean <- as.numeric(t(mid_weights) %*% fmean) + mid_etl <- as.numeric(mid$out) + mid_starr <- mid_mean / mid_etl + } + i <- i + 1 + } + return(new_ret) +} Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-10-07 01:54:19 UTC (rev 3209) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-10-07 06:09:54 UTC (rev 3210) @@ -795,7 +795,12 @@ } } if( any(c("CVaR", "ES", "ETL") %in% names(moments)) ) { + if(hasArg(ef)) ef=match.call(expand.dots=TRUE)$ef else ef=FALSE # Minimize sample ETL/ES/CVaR if CVaR, ETL, or ES is specified as an objective + if(length(moments) == 2 & all(moments$mean != 0) & ef==FALSE){ + # This is called by meanetl.efficient.frontier and we do not want that, need to have ef==FALSE + target <- mean_etl_opt(R=R, constraints=constraints, moments=moments, target=target, alpha=alpha) + } if(!is.null(constraints$max_pos)) { # This is an MILP problem if max_pos is specified as a constraint roi_result <- etl_milp_opt(R=R, constraints=constraints, moments=moments, target=target, alpha=alpha) From noreply at r-forge.r-project.org Mon Oct 7 16:08:08 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 7 Oct 2013 16:08:08 +0200 (CEST) Subject: [Returnanalytics-commits] r3211 - pkg/PortfolioAnalytics/R Message-ID: <20131007140808.862CA185FB9@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-07 16:08:07 +0200 (Mon, 07 Oct 2013) New Revision: 3211 Modified: pkg/PortfolioAnalytics/R/optFUN.R pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: Cleaning up implementation of mean/ETL using ROI Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-10-07 06:09:54 UTC (rev 3210) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-10-07 14:08:07 UTC (rev 3211) @@ -747,10 +747,10 @@ while((abs(ub_starr - lb_starr) > tol) & (i < maxit)){ # bisection method to find the maximum mean / etl - print(i) - print(ub_starr) - print(lb_starr) - print("**********") + # print(i) + # print(ub_starr) + # print(lb_starr) + # print("**********") # Find the starr at the mean return midpoint new_ret <- (lb_mean + ub_mean) / 2 mid <- etl_opt(R=R, constraints=constraints, moments=moments, target=new_ret, alpha=alpha) Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-10-07 06:09:54 UTC (rev 3210) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-10-07 14:08:07 UTC (rev 3211) @@ -796,22 +796,34 @@ } if( any(c("CVaR", "ES", "ETL") %in% names(moments)) ) { if(hasArg(ef)) ef=match.call(expand.dots=TRUE)$ef else ef=FALSE + if(ef) meanetl <- TRUE else meanetl <- FALSE + tmpnames <- c("CVaR", "ES", "ETL") + idx <- which(tmpnames %in% names(moments)) # Minimize sample ETL/ES/CVaR if CVaR, ETL, or ES is specified as an objective if(length(moments) == 2 & all(moments$mean != 0) & ef==FALSE){ # This is called by meanetl.efficient.frontier and we do not want that, need to have ef==FALSE target <- mean_etl_opt(R=R, constraints=constraints, moments=moments, target=target, alpha=alpha) + meanetl <- TRUE } if(!is.null(constraints$max_pos)) { # This is an MILP problem if max_pos is specified as a constraint roi_result <- etl_milp_opt(R=R, constraints=constraints, moments=moments, target=target, alpha=alpha) weights <- roi_result$weights - obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures + # obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures + # calculate obj_vals based on solver output + obj_vals <- list() + if(meanetl) obj_vals$mean <- as.numeric(t(weights) %*% moments$mean) + obj_vals[[tmpnames[idx]]] <- roi_result$out out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, out=roi_result$out, call=call) } else { # Minimize sample ETL/ES/CVaR LP Problem roi_result <- etl_opt(R=R, constraints=constraints, moments=moments, target=target, alpha=alpha) weights <- roi_result$weights - obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures + # obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures + # calculate obj_vals based on solver output + obj_vals <- list() + if(meanetl) obj_vals$mean <- as.numeric(t(weights) %*% moments$mean) + obj_vals[[tmpnames[idx]]] <- roi_result$out out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, out=roi_result$out, call=call) } } From noreply at r-forge.r-project.org Mon Oct 7 16:22:25 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 7 Oct 2013 16:22:25 +0200 (CEST) Subject: [Returnanalytics-commits] r3212 - pkg/PortfolioAnalytics/R Message-ID: <20131007142225.D93EA185FEE@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-07 16:22:25 +0200 (Mon, 07 Oct 2013) New Revision: 3212 Modified: pkg/PortfolioAnalytics/R/optFUN.R Log: Adding milp optimizations to maximizing mean/etl to support position limit constraints. Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-10-07 14:08:07 UTC (rev 3211) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-10-07 14:22:25 UTC (rev 3212) @@ -723,11 +723,19 @@ # optimize.portfolio and will throw an error message about nesting too deeply # Find the maximum return - max_ret <- maxret_opt(R=R, moments=moments, constraints=constraints, target=NA) + if(!is.null(constraints$max_pos)){ + max_ret <- maxret_milp_opt(R=R, constraints=constraints, moments=moments, target=NA) + } else { + max_ret <- maxret_opt(R=R, moments=moments, constraints=constraints, target=NA) + } max_mean <- as.numeric(-max_ret$out) # Find the starr at the maximum etl portfolio - ub_etl <- etl_opt(R=R, constraints=constraints, moments=moments, target=max_mean, alpha=alpha) + if(!is.null(constraints$max_pos)){ + ub_etl <- etl_milp_opt(R=R, constraints=constraints, moments=moments, target=max_mean, alpha=alpha) + } else { + ub_etl <- etl_opt(R=R, constraints=constraints, moments=moments, target=max_mean, alpha=alpha) + } ub_weights <- matrix(ub_etl$weights, ncol=1) ub_mean <- as.numeric(t(ub_weights) %*% fmean) ub_etl <- as.numeric(ub_etl$out) @@ -735,7 +743,11 @@ ub_starr <- ub_mean / ub_etl # Find the starr at the minimum etl portfolio - lb_etl <- etl_opt(R=R, constraints=constraints, moments=moments, target=NA, alpha=alpha) + if(!is.null(constraints$max_pos)){ + lb_etl <- etl_milp_opt(R=R, constraints=constraints, moments=moments, target=NA, alpha=alpha) + } else { + lb_etl <- etl_opt(R=R, constraints=constraints, moments=moments, target=NA, alpha=alpha) + } lb_weights <- matrix(lb_etl$weights) lb_mean <- as.numeric(t(lb_weights) %*% fmean) lb_etl <- as.numeric(lb_etl$out) @@ -753,7 +765,11 @@ # print("**********") # Find the starr at the mean return midpoint new_ret <- (lb_mean + ub_mean) / 2 - mid <- etl_opt(R=R, constraints=constraints, moments=moments, target=new_ret, alpha=alpha) + if(!is.null(constraints$max_pos)){ + mid <- etl_milp_opt(R=R, constraints=constraints, moments=moments, target=new_ret, alpha=alpha) + } else { + mid <- etl_opt(R=R, constraints=constraints, moments=moments, target=new_ret, alpha=alpha) + } mid_weights <- matrix(mid$weights, ncol=1) mid_mean <- as.numeric(t(mid_weights) %*% fmean) mid_etl <- as.numeric(mid$out) @@ -765,7 +781,11 @@ ub_mean <- mid_mean ub_starr <- mid_starr new_ret <- (lb_mean + ub_mean) / 2 - mid <- etl_opt(R=R, constraints=constraints, moments=moments, target=new_ret, alpha=alpha) + if(!is.null(constraints$max_pos)){ + mid <- etl_milp_opt(R=R, constraints=constraints, moments=moments, target=new_ret, alpha=alpha) + } else { + mid <- etl_opt(R=R, constraints=constraints, moments=moments, target=new_ret, alpha=alpha) + } mid_weights <- matrix(mid$weights, ncol=1) mid_mean <- as.numeric(t(mid_weights) %*% fmean) mid_etl <- as.numeric(mid$out) @@ -776,7 +796,11 @@ lb_mean <- mid_mean lb_starr <- mid_starr new_ret <- (lb_mean + ub_mean) / 2 - mid <- etl_opt(R=R, constraints=constraints, moments=moments, target=new_ret, alpha=alpha) + if(!is.null(constraints$max_pos)){ + mid <- etl_milp_opt(R=R, constraints=constraints, moments=moments, target=new_ret, alpha=alpha) + } else { + mid <- etl_opt(R=R, constraints=constraints, moments=moments, target=new_ret, alpha=alpha) + } mid_weights <- matrix(mid$weights, ncol=1) mid_mean <- as.numeric(t(mid_weights) %*% fmean) mid_etl <- as.numeric(mid$out) From noreply at r-forge.r-project.org Mon Oct 7 20:21:03 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 7 Oct 2013 20:21:03 +0200 (CEST) Subject: [Returnanalytics-commits] r3213 - pkg/PortfolioAnalytics/R Message-ID: <20131007182103.14CF11859E0@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-07 20:21:02 +0200 (Mon, 07 Oct 2013) New Revision: 3213 Modified: pkg/PortfolioAnalytics/R/optFUN.R pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: Adding functionality for max Sharpe Ratio using ROI Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-10-07 14:22:25 UTC (rev 3212) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-10-07 18:21:02 UTC (rev 3213) @@ -790,8 +790,7 @@ mid_mean <- as.numeric(t(mid_weights) %*% fmean) mid_etl <- as.numeric(mid$out) mid_starr <- mid_mean / mid_etl - } - if(mid_starr > lb_starr){ + } else if(mid_starr > lb_starr){ # if mid_starr > lb_starr then mid_starr becomes the new lower bound lb_mean <- mid_mean lb_starr <- mid_starr @@ -810,3 +809,72 @@ } return(new_ret) } + +max_sr_opt <- function(R, constraints, moments, lambda, target, lambda_hhi, conc_groups, tol=.Machine$double.eps^0.5, maxit=50){ + # This function returns the target mean return that maximizes mean / sd (i.e. sharpe ratio) + + # get the forecast mean from moments + fmean <- matrix(moments$mean, ncol=1) + + # Find the maximum return + max_ret <- PortfolioAnalytics:::maxret_opt(R=R, moments=moments, constraints=constraints, target=NA) + max_mean <- as.numeric(-max_ret$out) + + # Calculate the sr at the maximum mean return portfolio + ub_weights <- matrix(max_ret$weights, ncol=1) + ub_mean <- max_mean + ub_sd <- as.numeric(sqrt(t(ub_weights) %*% moments$var %*% ub_weights)) + # sr at the upper bound + ub_sr <- ub_mean / ub_sd + + # Calculate the sr at the miminum var portfolio + lb_sr <- PortfolioAnalytics:::gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1e6, target=NA, lambda_hhi=lambda_hhi, conc_groups=conc_groups) + lb_weights <- matrix(lb_sr$weights) + lb_mean <- as.numeric(t(lb_weights) %*% fmean) + lb_sd <- as.numeric(sqrt(t(lb_weights) %*% moments$var %*% lb_weights)) + # sr at the lower bound + lb_sr <- lb_mean / lb_sd + + # want to find the return that maximizes mean / sd + i <- 1 + while((abs(ub_sr - lb_sr) > tol) & (i < maxit)){ + # bisection method to find the maximum mean / sd + + # Find the starr at the mean return midpoint + new_ret <- (lb_mean + ub_mean) / 2 + mid <- PortfolioAnalytics:::gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1e6, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups) + mid_weights <- matrix(mid$weights, ncol=1) + mid_mean <- as.numeric(t(mid_weights) %*% fmean) + mid_sd <- as.numeric(sqrt(t(mid_weights) %*% moments$var %*% mid_weights)) + mid_sr <- mid_mean / mid_sd + # tmp_sr <- mid_sr + + # print(i) + # print(mid_sr) + # print("**********") + + if(mid_sr > ub_sr){ + # if mid_sr > ub_sr then mid_sr becomes the new upper bound + ub_mean <- mid_mean + ub_sr <- mid_sr + new_ret <- (lb_mean + ub_mean) / 2 + mid <- PortfolioAnalytics:::gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1e6, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups) + mid_weights <- matrix(mid$weights, ncol=1) + mid_mean <- as.numeric(t(mid_weights) %*% fmean) + mid_sd <- as.numeric(sqrt(t(mid_weights) %*% moments$var %*% mid_weights)) + mid_sr <- mid_mean / mid_sd + } else if(mid_sr > lb_sr){ + # if mid_sr > lb_sr then mid_sr becomes the new lower bound + lb_mean <- mid_mean + lb_sr <- mid_sr + new_ret <- (lb_mean + ub_mean) / 2 + mid <- PortfolioAnalytics:::gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1e6, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups) + mid_weights <- matrix(mid$weights, ncol=1) + mid_mean <- as.numeric(t(mid_weights) %*% fmean) + mid_sd <- as.numeric(sqrt(t(mid_weights) %*% moments$var %*% mid_weights)) + mid_sr <- mid_mean / mid_sd + } + i <- i + 1 + } + return(new_ret) +} Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-10-07 14:22:25 UTC (rev 3212) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-10-07 18:21:02 UTC (rev 3213) @@ -772,6 +772,11 @@ out <- list(weights=weights, objective_measures=obj_vals, opt_values=obj_vals, out=qp_result$out, call=call) } } else { + # if(hasArg(ef)) ef=match.call(expand.dots=TRUE)$ef else ef=FALSE + if(hasArg(maxSR)) maxSR=match.call(expand.dots=TRUE)$maxSR else maxSR=FALSE + if(maxSR){ + target <- max_sr_opt(R=R, constraints=constraints, moments=moments, lambda=lambda, target=target, lambda_hhi=lambda_hhi, conc_groups=conc_groups) + } roi_result <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=lambda, target=target, lambda_hhi=lambda_hhi, conc_groups=conc_groups) weights <- roi_result$weights obj_vals <- constrained_objective(w=weights, R=R, portfolio, trace=TRUE, normalize=FALSE)$objective_measures @@ -796,11 +801,12 @@ } if( any(c("CVaR", "ES", "ETL") %in% names(moments)) ) { if(hasArg(ef)) ef=match.call(expand.dots=TRUE)$ef else ef=FALSE + if(hasArg(maxSTARR)) maxSTARR=match.call(expand.dots=TRUE)$maxSTARR else maxSTARR=TRUE if(ef) meanetl <- TRUE else meanetl <- FALSE tmpnames <- c("CVaR", "ES", "ETL") idx <- which(tmpnames %in% names(moments)) # Minimize sample ETL/ES/CVaR if CVaR, ETL, or ES is specified as an objective - if(length(moments) == 2 & all(moments$mean != 0) & ef==FALSE){ + if(length(moments) == 2 & all(moments$mean != 0) & ef==FALSE & maxSTARR){ # This is called by meanetl.efficient.frontier and we do not want that, need to have ef==FALSE target <- mean_etl_opt(R=R, constraints=constraints, moments=moments, target=target, alpha=alpha) meanetl <- TRUE From noreply at r-forge.r-project.org Tue Oct 8 18:39:37 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 8 Oct 2013 18:39:37 +0200 (CEST) Subject: [Returnanalytics-commits] r3214 - pkg/PerformanceAnalytics/sandbox/Shubhankit/sandbox/vignettes Message-ID: <20131008163937.9F8A1185B6B@r-forge.r-project.org> Author: shubhanm Date: 2013-10-08 18:39:37 +0200 (Tue, 08 Oct 2013) New Revision: 3214 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/sandbox/vignettes/Managers.pdf Log: Adding zipped version of work done till present as submitted to Google Inc. Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/sandbox/vignettes/Managers.pdf =================================================================== (Binary files differ) Property changes on: pkg/PerformanceAnalytics/sandbox/Shubhankit/sandbox/vignettes/Managers.pdf ___________________________________________________________________ Added: svn:mime-type + application/octet-stream From noreply at r-forge.r-project.org Tue Oct 8 18:44:15 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 8 Oct 2013 18:44:15 +0200 (CEST) Subject: [Returnanalytics-commits] r3215 - pkg/PerformanceAnalytics/sandbox/Shubhankit Message-ID: <20131008164415.5B526185B6B@r-forge.r-project.org> Author: shubhanm Date: 2013-10-08 18:44:15 +0200 (Tue, 08 Oct 2013) New Revision: 3215 Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Shubhankit.zip Log: Adding zipped version of work done till present as submitted to Google Inc. Apologies for prev message Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Shubhankit.zip =================================================================== (Binary files differ) Property changes on: pkg/PerformanceAnalytics/sandbox/Shubhankit/Shubhankit.zip ___________________________________________________________________ Added: svn:mime-type + application/octet-stream From noreply at r-forge.r-project.org Fri Oct 11 03:25:10 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 11 Oct 2013 03:25:10 +0200 (CEST) Subject: [Returnanalytics-commits] r3216 - pkg/PortfolioAnalytics/R Message-ID: <20131011012510.51A491860EA@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-11 03:25:05 +0200 (Fri, 11 Oct 2013) New Revision: 3216 Modified: pkg/PortfolioAnalytics/R/optFUN.R pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: Modifying optimize.portfolio and optFUN for optimize_method=ROI to use the arguments list for clean, p, and other arguments. Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-10-08 16:44:15 UTC (rev 3215) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-10-11 01:25:05 UTC (rev 3216) @@ -287,6 +287,9 @@ #' @author Ross Bennett etl_opt <- function(R, constraints, moments, target, alpha){ + # Check for cleaned returns in moments + if(!is.null(moments$cleanR)) R <- moments$cleanR + N <- ncol(R) T <- nrow(R) # Applying box constraints @@ -348,6 +351,9 @@ #' @author Ross Bennett etl_milp_opt <- function(R, constraints, moments, target, alpha){ + # Check for cleaned returns in moments + if(!is.null(moments$cleanR)) R <- moments$cleanR + # Number of rows n <- nrow(R) @@ -474,6 +480,9 @@ gmv_opt_toc <- function(R, constraints, moments, lambda, target, init_weights){ # function for minimum variance or max quadratic utility problems + # Check for cleaned returns in moments + if(!is.null(moments$cleanR)) R <- moments$cleanR + # Modify the returns matrix. This is done because there are 3 sets of # variables 1) w.initial, 2) w.buy, and 3) w.sell R0 <- matrix(0, ncol=ncol(R), nrow=nrow(R)) @@ -599,6 +608,9 @@ # function for minimum variance or max quadratic utility problems # modifying ProportionalCostOpt function from MPO package + # Check for cleaned returns in moments + if(!is.null(moments$cleanR)) R <- moments$cleanR + # Modify the returns matrix. This is done because there are 3 sets of # variables 1) w.initial, 2) w.buy, and 3) w.sell returns <- cbind(R, R, R) Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-10-08 16:44:15 UTC (rev 3215) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-10-11 01:25:05 UTC (rev 3216) @@ -733,19 +733,48 @@ # lambda_hhi <- 0 #} lambda <- 1 + + # list of valid objective names for ROI solvers + valid_objnames <- c("HHI", "mean", "var", "sd", "StdDev", "CVaR", "ES", "ETL") + for(objective in portfolio$objectives){ if(objective$enabled){ - if(!any(c(objective$name == "HHI", objective$name == "mean", objective$name == "var", objective$name == "CVaR", objective$name == "ES", objective$name == "ETL"))) - stop("ROI only solves mean, var, or sample ETL/ES/CVaR type business objectives, choose a different optimize_method.") + if(!(objective$name %in% valid_objnames)){ + stop("ROI only solves mean, var/StdDev, HHI, or sample ETL/ES/CVaR type business objectives, choose a different optimize_method.") + } + + # Grab the arguments list per objective + # Currently we are only getting arguments for "p" and "clean", not sure if we need others for the ROI QP/LP solvers + # if(length(objective$arguments) >= 1) arguments <- objective$arguments else arguments <- list() + arguments <- objective$arguments + if(!is.null(arguments$clean)) clean <- arguments$clean else clean <- "none" + # Note: arguments$p grabs arguments$portfolio_method if no p is specified + # so we need to be explicit with arguments[["p"]] + if(!is.null(arguments[["p"]])) alpha <- arguments$p else alpha <- alpha + if(alpha > 0.5) alpha <- (1 - alpha) + + # Some of the sub-functions for optimizations use the returns object as + # part of the constraints matrix (e.g. etl_opt and etl_milp_opt) so we + # will store the cleaned returns in the moments object. This may not + # be the most efficient way to pass around a cleaned returns object, + # but it will keep it separate from the R object passed in by the user + # and avoid "re-cleaning" already cleaned returns if specified in + # multiple objectives. + if(clean != "none") moments$cleanR <- Return.clean(R=R, method=clean) + # I'm not sure what changed, but moments$mean used to be a vector of the column means # now it is a scalar value of the mean of the entire R object if(objective$name == "mean"){ - moments[[objective$name]] <- try(as.vector(apply(R, 2, "mean", na.rm=TRUE)), silent=TRUE) + moments[[objective$name]] <- try(as.vector(apply(Return.clean(R=R, method=clean), 2, "mean", na.rm=TRUE)), silent=TRUE) + } else if(objective$name %in% c("StdDev", "sd", "var")){ + moments[["var"]] <- try(var(x=Return.clean(R=R, method=clean), na.rm=TRUE), silent=TRUE) } else { - moments[[objective$name]] <- try(eval(as.symbol(objective$name))(R), silent=TRUE) + moments[[objective$name]] <- try(eval(as.symbol(objective$name))(Return.clean(R=R, method=clean)), silent=TRUE) } target <- ifelse(!is.null(objective$target), objective$target, target) - alpha <- ifelse(!is.null(objective$alpha), objective$alpha, alpha) + # alpha <- ifelse(!is.null(objective$alpha), objective$alpha, alpha) + # only accept confidence level for ES/ETL/CVaR to come from the + # arguments list to be consistent with how this is done in other solvers. lambda <- ifelse(!is.null(objective$risk_aversion), objective$risk_aversion, lambda) if(!is.null(objective$conc_aversion)) lambda_hhi <- objective$conc_aversion else lambda_hhi <- NULL if(!is.null(objective$conc_groups)) conc_groups <- objective$conc_groups else conc_groups <- NULL @@ -807,7 +836,7 @@ idx <- which(tmpnames %in% names(moments)) # Minimize sample ETL/ES/CVaR if CVaR, ETL, or ES is specified as an objective if(length(moments) == 2 & all(moments$mean != 0) & ef==FALSE & maxSTARR){ - # This is called by meanetl.efficient.frontier and we do not want that, need to have ef==FALSE + # This is called by meanetl.efficient.frontier and we do not want that for efficient frontiers, need to have ef==FALSE target <- mean_etl_opt(R=R, constraints=constraints, moments=moments, target=target, alpha=alpha) meanetl <- TRUE } From noreply at r-forge.r-project.org Fri Oct 11 23:57:12 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 11 Oct 2013 23:57:12 +0200 (CEST) Subject: [Returnanalytics-commits] r3217 - pkg/PortfolioAnalytics/R Message-ID: <20131011215712.D2D72185F35@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-11 23:57:12 +0200 (Fri, 11 Oct 2013) New Revision: 3217 Modified: pkg/PortfolioAnalytics/R/optFUN.R Log: Adding require(package) in sub-functions where I use solve.QP or Rglpk_solve_LP directly. Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-10-11 01:25:05 UTC (rev 3216) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-10-11 21:57:12 UTC (rev 3217) @@ -255,6 +255,7 @@ types <- c(rep("C", N), rep("B", N)) # Solve directly with Rglpk... getting weird errors with ROI + stopifnot("package:Rglpk" %in% search() || require("Rglpk",quietly = TRUE)) result <- Rglpk_solve_LP(obj=objL, mat=Amat, dir=dir, rhs=rhs, types=types, bounds=bnds, max=FALSE) # The Rglpk solvers status returns an an integer with status information @@ -447,6 +448,7 @@ bounds <- list( lower = list( ind = 1L:(m + n + 2 + m), val = c(LB, -1, rep(0, n), 1, rep(0, m)) ), upper = list( ind = 1L:(m + n + 2 + m), val = c( UB, 1, rep(Inf, n), 1 , rep(1, m)) ) ) + stopifnot("package:Rglpk" %in% search() || require("Rglpk",quietly = TRUE)) result <- Rglpk_solve_LP(obj=objL, mat=tmpAmat, dir=dir, rhs=rhs, types=types, bounds=bounds) # The Rglpk solvers status returns an an integer with status information # about the solution returned: 0 if the optimal solution was found, a @@ -575,6 +577,7 @@ d <- rep(-moments$mean, 3) stopifnot("package:corpcor" %in% search() || require("corpcor",quietly = TRUE)) + stopifnot("package:quadprog" %in% search() || require("quadprog",quietly = TRUE)) qp.result <- try(solve.QP(Dmat=make.positive.definite(2*lambda*V), dvec=d, Amat=t(Amat), bvec=rhs, meq=meq), silent=TRUE) if(inherits(qp.result, "try-error")) stop("No solution found, consider adjusting constraints.") @@ -692,6 +695,7 @@ d <- rep(-moments$mean, 3) stopifnot("package:corpcor" %in% search() || require("corpcor",quietly = TRUE)) + stopifnot("package:quadprog" %in% search() || require("quadprog",quietly = TRUE)) qp.result <- try(solve.QP(Dmat=make.positive.definite(2*lambda*V), dvec=d, Amat=t(Amat), bvec=rhs, meq=meq), silent=TRUE) if(inherits(qp.result, "try-error")) stop("No solution found, consider adjusting constraints.") From noreply at r-forge.r-project.org Sat Oct 12 16:39:34 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 12 Oct 2013 16:39:34 +0200 (CEST) Subject: [Returnanalytics-commits] r3218 - pkg/PortfolioAnalytics/sandbox/symposium2013 Message-ID: <20131012143935.035CE185CDA@r-forge.r-project.org> Author: peter_carl Date: 2013-10-12 16:39:34 +0200 (Sat, 12 Oct 2013) New Revision: 3218 Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R Log: - checkpoint commit Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R 2013-10-11 21:57:12 UTC (rev 3217) +++ pkg/PortfolioAnalytics/sandbox/symposium2013/optimize.HFindexes.R 2013-10-12 14:39:34 UTC (rev 3218) @@ -13,15 +13,15 @@ # ... and multi-core packages require(foreach) require(doMC) -registerDoMC(5) +registerDoMC(6) # Available on r-forge # require(FactorAnalytics) # development version > build ### Set script constants runname='historical.moments' -rebalance_period = 'quarters' # uses endpoints identifiers from xts; how to do semi-annual? -clean = "none" #"boudt" # "none" +rebalance_period = 'years' #'quarters' # uses endpoints identifiers from xts; how to do semi-annual? +clean = "boudt" # "none" permutations = 2000 p=1-1/12 # set confidence for VaR/mETL for monthly data @@ -89,13 +89,14 @@ ### Construct BUOY 1: Constrained Mean-StdDev Portfolio - using ROI # Add the return and sd objectives to the constraints created above MeanSD.portf <- add.objective(portfolio=init.portf, - type="return", # the kind of objective this is - name="mean" # name of the function - ) + type="return", # the kind of objective this is + name="mean" # name of the function +) MeanSD.portf <- add.objective(portfolio=MeanSD.portf, - type="risk", # the kind of objective this is - name="var" # name of the function - ) + type="risk", # the kind of objective this is + name="var", # name of the function + arguments=list(clean=clean) +) ### Construct BUOY 2: Constrained Mean-mETL Portfolio - using ROI #@ Cannot maximize mean return per unit ETL with ROI, consider using @@ -109,83 +110,84 @@ MeanmETL.portf <- add.objective(portfolio=MeanmETL.portf, type="risk", # the kind of objective this is name="ES", # the function to minimize - arguments=list(p=p) + arguments=list(p=p, clean=clean) ) ### Construct BUOY 3: Constrained Minimum Variance Portfolio - using ROI # Add the variance objective MinSD.portf <- add.objective(portfolio=init.portf, - type="risk", # the kind of objective this is - name="var", # name of the function - ) + type="risk", # the kind of objective this is + name="var", # name of the function + arguments=list(p=p, clean=clean) +) ### Construct BUOY 4: Constrained Minimum mETL Portfolio - using ROI # Add the mETL objective MinmETL.portf <- add.objective(portfolio=init.portf, - type="risk", # the kind of objective this is - name="ES", # the function to minimize - arguments=list(p=p) - ) + type="risk", # the kind of objective this is + name="ES", # the function to minimize + arguments=list(p=p, clean=clean) +) ### Construct BUOY 5: Constrained Equal Variance Contribution Portfolio - using RP #@ - Add the sub-objectives first. Adding these 3 objectives means that we are #@ maximizing mean per unit StdDev with equal volatility contribution portfolios. - RB # Without a sub-objective, we get a somewhat undefined result, since there are (potentially) many Equal SD contribution portfolios. -# EqSD.portf <- add.objective(portfolio=init.portf, +# MRCSD.portf <- add.objective(portfolio=init.portf, # type="risk", # name="StdDev" # ) # OR -EqSD.portf <- add.objective(portfolio=init.portf, - type="return", - name="mean" -) -EqSD.portf <- add.objective(portfolio=EqSD.portf, +# MRCSD.portf <- add.objective(portfolio=init.portf, +# type="return", +# name="mean" +# ) +MRCSD.portf <- add.objective(portfolio=init.portf, type="risk_budget", name="StdDev", min_concentration=TRUE, arguments = list(clean=clean) - ) +) -# EqSD.portf$constraints[[1]]$min_sum = 0.99 # set to speed up RP -# EqSD.portf$constraints[[1]]$max_sum = 1.01 +# MRCSD.portf$constraints[[1]]$min_sum = 0.99 # set to speed up RP +# MRCSD.portf$constraints[[1]]$max_sum = 1.01 ### Construct BUOY 6: Constrained Equal mETL Contribution Portfolio - using RP -#@ Add the sub-objectives first. These should be added to the EqmETL portfolio. +#@ Add the sub-objectives first. These should be added to the MRCmETL portfolio. #@ All objectives below mean that we are maximizing mean return per unit ES with #@ equal ES contribution. - RB # Without a sub-objective, we get a somewhat undefined result, since there are (potentially) many Equal SD contribution portfolios. -# EqmETL.portf <- add.objective(portfolio=init.portf, +# MRCmETL.portf <- add.objective(portfolio=init.portf, # type="risk", # name="ES" # ) # OR -EqmETL.portf <- add.objective(portfolio=init.portf, +MRCmETL.portf <- add.objective(portfolio=init.portf, type="return", name="mean" ) -EqmETL.portf <- add.objective(EqmETL.portf, +MRCmETL.portf <- add.objective(MRCmETL.portf, type="risk_budget", name="ES", min_concentration=TRUE, arguments = list(p=p, clean=clean) ) # Calculate portfolio variance, but don't use it in the objective; used only for plots -EqmETL.portf <- add.objective(portfolio=EqmETL.portf, +MRCmETL.portf <- add.objective(portfolio=MRCmETL.portf, type="risk", # the kind of objective this is name="StdDev", # the function to minimize enabled=TRUE, # enable or disable the objective multiplier=0, # calculate it but don't use it in the objective arguments=list(clean=clean) ) -# EqmETL.portf$constraints[[1]]$min_sum = 0.99 # set to speed up RP -# EqmETL.portf$constraints[[1]]$max_sum = 1.01 +# MRCmETL.portf$constraints[[1]]$min_sum = 0.99 # set to speed up RP +# MRCmETL.portf$constraints[[1]]$max_sum = 1.01 ### Construct BUOY 7: Equal Weight Portfolio # There's only one, so create a portfolio object with all the objectives we want calculated. -EqWt.portf <- portfolio.spec(assets=colnames(R)) -EqWt.portf <- add.constraint(portfolio=EqWt.portf, type="leverage", min_sum=0.99, max_sum=1.01) -EqWt.portf <- add.objective(portfolio=EqWt.portf, type="return", name="mean") -EqWt.portf <- add.objective(portfolio=EqWt.portf, type="risk_budget", name="ES", arguments=list(p=p, clean=clean)) -EqWt.portf <- add.objective(portfolio=EqWt.portf, type="risk_budget", name="StdDev", arguments=list(clean=clean)) +EqWgt.portf <- portfolio.spec(assets=colnames(R)) +EqWgt.portf <- add.constraint(portfolio=EqWgt.portf, type="leverage", min_sum=1, max_sum=1) +EqWgt.portf <- add.objective(portfolio=EqWgt.portf, type="return", name="mean") +EqWgt.portf <- add.objective(portfolio=EqWgt.portf, type="risk_budget", name="ES", arguments=list(p=p, clean=clean)) +EqWgt.portf <- add.objective(portfolio=EqWgt.portf, type="risk_budget", name="StdDev", arguments=list(clean=clean)) ### Construct BUOY 8: Inverse Volatility Portfolio # There's only one, so create a portfolio object with all the objectives we want calculated. @@ -195,44 +197,45 @@ VolWgt.portf <- add.objective(portfolio=VolWgt.portf, type="risk_budget", name="ES", arguments=list(p=p, clean=clean)) VolWgt.portf <- add.objective(portfolio=VolWgt.portf, type="risk_budget", name="StdDev", arguments=list(clean=clean)) -### Construct RISK BUDGET Portfolio -ConstrConcmETL.portf <- portfolio.spec(assets=colnames(R), - weight_seq=generatesequence(by=0.005) -) -# Add leverage constraint -ConstrConcmETL.portf <- add.constraint(portfolio=RiskBudget.portf, - type="leverage", - min_sum=0.99, # set to speed up RP, DE - max_sum=1.01 -) -# Establish position bounds -ConstrConcmETL.portf <- add.constraint(portfolio=ConstrConcmETL.portf, - type="box", - min=0.01, # leave relatively unconstrained - max=1.0 -) -# Maximize mean return -ConstrConcmETL.portf <- add.objective(portfolio=ConstrConcmETL.portf, - type="return", # maximize return - name="mean", - multiplier=12 -) -# Add a risk measure -# Use ES to be consistent with risk measures in other BUOY portfolios -ConstrConcmETL.portf <- add.objective(portfolio=ConstrConcmETL.portf, - type="risk", - name="ETL", # using a different name to avoid clobbering slot below, workaround for bug - multiplier=1, - arguments = list(p=p, clean=clean) -) - -# Set contribution limits -ConstrConcmETL.portf <- add.objective(portfolio=ConstrConcmETL.portf, - type="risk_budget", - name="ES", - max_prisk=0.3, # Sets the maximum percentage contribution to risk - arguments = list(p=p, clean=clean) -) +# REMOVED - to much to show already +# ### Construct RISK BUDGET Portfolio +# ConstrConcmETL.portf <- portfolio.spec(assets=colnames(R), +# weight_seq=generatesequence(by=0.005) +# ) +# # Add leverage constraint +# ConstrConcmETL.portf <- add.constraint(portfolio=RiskBudget.portf, +# type="leverage", +# min_sum=0.99, # set to speed up RP, DE +# max_sum=1.01 +# ) +# # Establish position bounds +# ConstrConcmETL.portf <- add.constraint(portfolio=ConstrConcmETL.portf, +# type="box", +# min=0.01, # leave relatively unconstrained +# max=1.0 +# ) +# # Maximize mean return +# ConstrConcmETL.portf <- add.objective(portfolio=ConstrConcmETL.portf, +# type="return", # maximize return +# name="mean", +# multiplier=12 +# ) +# # Add a risk measure +# # Use ES to be consistent with risk measures in other BUOY portfolios +# ConstrConcmETL.portf <- add.objective(portfolio=ConstrConcmETL.portf, +# type="risk", +# name="ETL", # using a different name to avoid clobbering slot below, workaround for bug +# multiplier=1, +# arguments = list(p=p, clean=clean) +# ) +# +# # Set contribution limits +# ConstrConcmETL.portf <- add.objective(portfolio=ConstrConcmETL.portf, +# type="risk_budget", +# name="ES", +# max_prisk=0.3, # Sets the maximum percentage contribution to risk +# arguments = list(p=p, clean=clean) +# ) # Calculate portfolio variance, but don't use it in the objective; used only for plots # ConstrConcmETL.portf <- add.objective(portfolio=ConstrConcmETL.portf, # type="risk", # the kind of objective this is @@ -255,11 +258,12 @@ rp.portf$constraints[[1]]$min_sum = 1.00 # for more accuracy rp.portf$constraints[[1]]$max_sum = 1.00 # rp = random_portfolios(portfolio=rp.portf, permutations=30000, max_permutations=400) # will get fewer with less accuracy -rp.mean = apply(rp1, 1, function(w) mean(R %*% w)) -rp.sd = apply(rp1, 1, function(x) StdDev(R=R, weights=x, p=p, clean=clean)) +load(file=paste(resultsdir,'random-portfolios-2013-10-05.historical.moments.rda')) +rp.mean = apply(rp, 1, function(w) mean(R %*% w)) +rp.sd = apply(rp, 1, function(x) StdDev(R=R, weights=x, p=p, clean=clean)) plot(rp.sd, rp.mean, col="darkgray", cex=0.5) -# This was fruitless: +# REMOVED: This was fruitless # rp1 = random_portfolios(portfolio=rp.portf, permutations=10000, max_permutations=400, rp_method="sample") # rp1.mean = apply(rp1, 1, function(w) mean(R %*% w)) # rp1.sd = apply(rp1, 1, function(x) StdDev(R=R, weights=x, p=p)) @@ -278,8 +282,8 @@ # print(paste('done constructing random portfolios at',Sys.time())) # save(rp,file=paste(resultsdir, 'random-portfolios-', Sys.Date(), '-', runname, '.rda',sep='')) -load(file=paste(resultsdir,'random-portfolios-2013-10-05.historical.moments.rda')) + start_time<-Sys.time() print(paste('Starting optimization at',Sys.time())) @@ -330,8 +334,8 @@ ### Evaluate BUOY 3: Constrained Minimum Variance Portfolio - with ROI MinSD.ROI<-optimize.portfolio(R=R, portfolio=MinSD.portf, - optimize_method='ROI', - trace=TRUE, verbose=TRUE + optimize_method='ROI', + trace=TRUE ) # plot(MinSD.ROI, risk.col="StdDev", return.col="mean", rp=permutations, chart.assets=TRUE, main="Minimum Volatility Portfolio with ROI") save(MinSD.ROI,file=paste(resultsdir, 'MinSD-', Sys.Date(), '-', runname, '.rda',sep='')) @@ -349,105 +353,106 @@ MinmETL.ROI<-optimize.portfolio(R=R, portfolio=MinmETL.portf, optimize_method='ROI', - trace=TRUE, verbose=TRUE, + trace=TRUE, verbose=TRUE ) plot(MinmETL.ROI, risk.col="StdDev", return.col="mean", rp=permutations, chart.assets=TRUE, main="Minimum mETL Portfolio") plot(MinmETL.ROI, risk.col="ES", return.col="mean", rp=permutations, chart.assets=TRUE, main="Minimum mETL Portfolio") save(MinmETL.ROI,file=paste(resultsdir, 'MinmETL-', Sys.Date(), '-', runname, '.rda',sep='')) -print(paste('Completed MinmETL optimization at',Sys.time(),'moving on to EqSD')) +print(paste('Completed MinmETL optimization at',Sys.time(),'moving on to MRCSD')) ### Evaluate BUOY 5: Constrained Equal Variance Contribution Portfolio - with RP -# EqSD.RND<-optimize.portfolio(R=R, -# portfolio=EqSD.portf, +# MRCSD.RND<-optimize.portfolio(R=R, +# portfolio=MRCSD.portf, # optimize_method='random', # rp=rp, # trace=TRUE # ) -# plot(EqSD.RND, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Equal Volatility Contribution Portfolio") -# chart.RiskBudget(EqSD.RND, risk.type="percentage", neighbors=25) -# save(EqSD.RND,file=paste(resultsdir, 'EqSD.RND-', Sys.Date(), '-', runname, '.rda',sep='')) +# plot(MRCSD.RND, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Equal Volatility Contribution Portfolio") +# chart.RiskBudget(MRCSD.RND, risk.type="percentage", neighbors=25) +# save(MRCSD.RND,file=paste(resultsdir, 'MRCSD.RND-', Sys.Date(), '-', runname, '.rda',sep='')) # ... not a very satisfying solution # OR DE optim - this gets very close (a nice, straight line), so use it -EqSD.DE<-optimize.portfolio(R=R, - portfolio=EqSD.portf, +MRCSD.DE<-optimize.portfolio(R=R, + portfolio=MRCSD.portf, optimize_method='DEoptim', search_size=20000, + itermax=400, initialpop=rp[1:50,], # seed with a starting population that we know fits the constraint space trace=FALSE ) -plot(EqSD.DE, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Equal Volatility Contribution Portfolio") -chart.RiskBudget(EqSD.DE, risk.type="percentage", neighbors=25) -save(EqSD.DE,file=paste(resultsdir, 'EqSD.DE-', Sys.Date(), '-', runname, '.rda',sep='')) +plot(MRCSD.DE, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Equal Volatility Contribution Portfolio") +chart.RiskBudget(MRCSD.DE, risk.type="percentage", neighbors=25) +save(MRCSD.DE,file=paste(resultsdir, 'MRCSD.DE-', Sys.Date(), '-', runname, '.rda',sep='')) -print(paste('Completed EqSD optimization at',Sys.time(),'moving on to EqmETL')) +print(paste('Completed MRCSD optimization at',Sys.time(),'moving on to MRCmETL')) ### Evaluate BUOY 6: Constrained Equal mETL Contribution Portfolio - with RP -EqmETL.RND<-optimize.portfolio(R=R, - portfolio=EqmETL.portf, +MRCmETL.RND<-optimize.portfolio(R=R, + portfolio=MRCmETL.portf, optimize_method='random', rp=rp, trace=TRUE ) # -plot(EqmETL.RND, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Equal mETL Contribution Portfolio") -plot(EqmETL.RND, risk.col="ES", return.col="mean", chart.assets=TRUE, main="Equal mETL Contribution Portfolio") -chart.RiskBudget(EqmETL.RND, neighbors=25) -save(EqmETL.RND,file=paste(resultsdir, 'EqmETL-', Sys.Date(), '-', runname, '.rda',sep='')) +plot(MRCmETL.RND, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Equal mETL Contribution Portfolio") +plot(MRCmETL.RND, risk.col="ES", return.col="mean", chart.assets=TRUE, main="Equal mETL Contribution Portfolio") +chart.RiskBudget(MRCmETL.RND, neighbors=25) +save(MRCmETL.RND,file=paste(resultsdir, 'MRCmETL-', Sys.Date(), '-', runname, '.rda',sep='')) # OR DE optim - -EqmETL.DE<-optimize.portfolio(R=R, - portfolio=EqmETL.portf, +MRCmETL.DE<-optimize.portfolio(R=R, + portfolio=MRCmETL.portf, optimize_method='DEoptim', search_size=20000, NP=200, initialpop=rp[1:50,], # seed with a starting population that we know fits the constraint space trace=FALSE ) -plot(EqmETL.DE, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Equal Volatility Contribution Portfolio") -chart.RiskBudget(EqmETL.DE, risk.type="percentage", neighbors=25) -save(EqmETL.DE,file=paste(resultsdir, 'EqmETL.DE-', Sys.Date(), '-', runname, '.rda',sep='')) +plot(MRCmETL.DE, risk.col="StdDev", return.col="mean", chart.assets=TRUE, main="Equal Volatility Contribution Portfolio") +chart.RiskBudget(MRCmETL.DE, risk.type="percentage", neighbors=25) +save(MRCmETL.DE,file=paste(resultsdir, 'MRCmETL.DE-', Sys.Date(), '-', runname, '.rda',sep='')) -# test it unconstrained: -unconstr.portf <- portfolio.spec(assets=colnames(R), - weight_seq=generatesequence(by=0.005) -) -unconstr.portf <- add.constraint(portfolio=unconstr.portf, - type="leverage", - min_sum=0.99, # set to speed up RP - max_sum=1.01 -) -# Establish position bounds -unconstr.portf <- add.constraint(portfolio=unconstr.portf, - type="box", - min=0.01, - max=1.0 -) -EqmETLun.portf <- add.objective(portfolio=unconstr.portf, - type="return", - name="mean" -) -EqmETLun.portf <- add.objective(EqmETL.portf, - type="risk_budget", - name="ES", - min_concentration=TRUE, - arguments = list(p=p, clean=clean) -) +# # test it unconstrained: +# unconstr.portf <- portfolio.spec(assets=colnames(R), +# weight_seq=generatesequence(by=0.005) +# ) +# unconstr.portf <- add.constraint(portfolio=unconstr.portf, +# type="leverage", +# min_sum=0.99, # set to speed up RP +# max_sum=1.01 +# ) +# # Establish position bounds +# unconstr.portf <- add.constraint(portfolio=unconstr.portf, +# type="box", +# min=0.01, +# max=1.0 +# ) +# MRCmETLun.portf <- add.objective(portfolio=unconstr.portf, +# type="return", +# name="mean" +# ) +# MRCmETLun.portf <- add.objective(MRCmETL.portf, +# type="risk_budget", +# name="ES", +# min_concentration=TRUE, +# arguments = list(p=p, clean=clean) +# ) +# +# # ...in DE optim - +# MRCmETLun.DE<-optimize.portfolio(R=R, +# portfolio=MRCmETLun.portf, +# optimize_method='DEoptim', +# search_size=20000, +# NP=200, +# initialpop=rp[1:50,], # seed with a starting population that we know fits the constraint space +# trace=FALSE +# ) -# ...in DE optim - -EqmETLun.DE<-optimize.portfolio(R=R, - portfolio=EqmETLun.portf, - optimize_method='DEoptim', - search_size=20000, - NP=200, - initialpop=rp[1:50,], # seed with a starting population that we know fits the constraint space - trace=FALSE - ) +print(paste('Completed MRCmETL optimization at',Sys.time(),'moving on to RiskBudget')) -print(paste('Completed EqmETL optimization at',Sys.time(),'moving on to RiskBudget')) - ### Evaluate BUOY 7: Equal Weight Portfolio # Calculate the objective measures for the equal weight portfolio -EqWt.opt <- equal.weight(R=R, portfolio=EqWt.portf) +EqWgt.opt <- equal.weight(R=R, portfolio=EqWgt.portf) ### Evaluate BUOY 8: Inverse Volatility Portfolio volatility.weight <- function (R, portfolio, ...) @@ -476,48 +481,49 @@ # Calculate the objective measures for the vol weight portfolio VolWgt.opt <- volatility.weight(R=R, portfolio=VolWgt.portf) -### Evaluate Constrained Concentration to mETL Portfolio - with DE -# registerDoSEQ() # turn off parallelization to keep the trace data -ConstrConcmETL.DE<-optimize.portfolio(R=R, - portfolio=ConstrConcmETL.portf, - optimize_method='DEoptim', - search_size=40000, - NP=4000, - itermax=400, - trace=FALSE -) -# list(c=0.25, # speed of crossover adaption (0,1] -# CR=0.75) # crossover probability [0,1] -plot(ConstrConcmETL.DE, risk.col="StdDev", return.col="mean") -plot(ConstrConcmETL.DE, risk.col="ES", return.col="mean") # several outlier portfolios -chart.RiskBudget(ConstrConcmETL.DE) -chart.RiskBudget(ConstrConcmETL.DE, risk.type="percentage") - -save(ConstrConcmETL.DE,file=paste(resultsdir, 'ConstrConcmETL-', Sys.Date(), '-', runname, '.rda',sep='')) -print(ConstrConcmETL.DE$elapsed_time) +# REMOVED +# ### Evaluate Constrained Concentration to mETL Portfolio - with DE +# # registerDoSEQ() # turn off parallelization to keep the trace data +# ConstrConcmETL.DE<-optimize.portfolio(R=R, +# portfolio=ConstrConcmETL.portf, +# optimize_method='DEoptim', +# search_size=40000, +# NP=4000, +# itermax=400, +# trace=FALSE +# ) +# # list(c=0.25, # speed of crossover adaption (0,1] +# # CR=0.75) # crossover probability [0,1] +# plot(ConstrConcmETL.DE, risk.col="StdDev", return.col="mean") +# plot(ConstrConcmETL.DE, risk.col="ES", return.col="mean") # several outlier portfolios +# chart.RiskBudget(ConstrConcmETL.DE) +# chart.RiskBudget(ConstrConcmETL.DE, risk.type="percentage") +# +# save(ConstrConcmETL.DE,file=paste(resultsdir, 'ConstrConcmETL-', Sys.Date(), '-', runname, '.rda',sep='')) +# print(ConstrConcmETL.DE$elapsed_time) print('Done with optimizations.') #------------------------------------------------------------------------ ### Extract data from optimizations for analysis #------------------------------------------------------------------------ # Combine optimization objects -buoys <- combine.optimizations(list(MeanSD=MeanSD.ROI, MeanmETL=MeanmETL.ROI, MinSD=MinSD.ROI, MinmETL=MinmETL.ROI, EqSD=EqSD.RND, EqmETL=EqmETL.RND, RB=RiskBudget.DE, EqWt=EqWt.opt)) -chart.Weights(buoys, plot.type="bar", ylim=c(0,1)) +buoys <- combine.optimizations(list(MeanSD=MeanSD.ROI, MeanmETL=MeanmETL.RND, MinSD=MinSD.ROI, MinmETL=MinmETL.ROI, MRCSD=MRCSD.DE, MRCmETL=MRCmETL.DE, VolWgt=VolWgt.opt, EqWgt=EqWgt.opt)) +# chart.Weights(buoys, plot.type="bar", ylim=c(0,1)) +# +# #@ Chart the portfolios that have mean and ES as objective measures. - RB +# chart.RiskReward(buoys, risk.col="ES") +# #@ Chart the portfolios that have mean and StdDev as objective measures. - RB +# chart.RiskReward(buoys, risk.col="StdDev") +# +# #@ The MRCmETL and RB optimizations would be good to compare because they are +# #@ similar in that they both include component ES as an objective. - RB +# buoyETL <- combine.optimizations(list(MRCmETL=MRCmETL.RND, RB=RiskBudget.DE, EqWgt=EqWgt.opt)) +# chart.RiskBudget(buoyETL, match.col="ES", risk.type="percentage", legend.loc="topright") +# +# #@ Compare the equal weight portfolio and the equal SD contribution portfolio. - RB +# buoyStdDev <- combine.optimizations(list(MRCSD=MRCSD.RND, EqWgt=EqWgt.opt)) +# chart.RiskBudget(buoyStdDev, match.col="StdDev", risk.type="absolute", legend.loc="topleft") -#@ Chart the portfolios that have mean and ES as objective measures. - RB -chart.RiskReward(buoys, risk.col="ES") -#@ Chart the portfolios that have mean and StdDev as objective measures. - RB -chart.RiskReward(buoys, risk.col="StdDev") - -#@ The EqmETL and RB optimizations would be good to compare because they are -#@ similar in that they both include component ES as an objective. - RB -buoyETL <- combine.optimizations(list(EqmETL=EqmETL.RND, RB=RiskBudget.DE, EqWt=EqWt.opt)) -chart.RiskBudget(buoyETL, match.col="ES", risk.type="percentage", legend.loc="topright") - -#@ Compare the equal weight portfolio and the equal SD contribution portfolio. - RB -buoyStdDev <- combine.optimizations(list(EqSD=EqSD.RND, EqWt=EqWt.opt)) -chart.RiskBudget(buoyStdDev, match.col="StdDev", risk.type="absolute", legend.loc="topleft") - Wgts = extractWeights(buoys) ### Extract portfolio measures from each objective @@ -526,8 +532,8 @@ buoys.portfmeas = buoys.contrib.sd = buoys.contrib.es = buoys.perc.sd = buoys.perc.es = NULL for(i in 1:NROW(Wgts)){ mean = sum(colMeans(R)*Wgts[i,]) - sd = StdDev(R, weights=Wgts[i,], portfolio_method="component") - es = ES(R, weights=Wgts[i,], method="modified", portfolio_method="component", p=p) + sd = StdDev(R, weights=Wgts[i,], portfolio_method="component", clean=clean) + es = ES(R, weights=Wgts[i,], method="modified", portfolio_method="component", p=p, clean=clean) buoys.portfmeas=rbind(buoys.portfmeas, c(mean, sd[[1]][1], es[[1]][1])) buoys.contrib.sd= rbind(buoys.contrib.sd,sd[[2]]) buoys.contrib.es= rbind(buoys.contrib.es,es[[2]]) @@ -546,15 +552,15 @@ colnames(buoys.perc.es) = colnames(Wgts) # get the RP portfolios with risk and return pre-calculated -xtract = extractStats(EqmETL.RND) +xtract = extractStats(MRCmETL.RND) save(xtract,file=paste(resultsdir, 'xtract-RPs-', Sys.Date(), '-', runname, '.rda',sep='')) # columnnames = colnames(xtract) results.names=rownames(buoys.portfmeas) # by Asset metrics assets.portfmeas=as.matrix(scatterFUN(R, FUN="mean")) -assets.portfmeas=cbind(assets.portfmeas, scatterFUN(R, FUN="StdDev")) -assets.portfmeas=cbind(assets.portfmeas, scatterFUN(R, FUN="ES")) +assets.portfmeas=cbind(assets.portfmeas, scatterFUN(R, FUN="StdDev", clean=clean)) +assets.portfmeas=cbind(assets.portfmeas, scatterFUN(R, FUN="ES", clean=clean)) colnames(assets.portfmeas)=c("Mean", "StdDev", "mETL") rownames(assets.portfmeas)=colnames(Wgts) @@ -572,9 +578,9 @@ EqWgt.R=Return.rebalancing(R, EqWgt.w) chart.StackedBar(EqWgt.w, colorset=wb13color, gap=0) -# Equal mETL -EqmETL.DE.t = optimize.portfolio.rebalancing(R=R, - portfolio=EqmETL.portf, +# Equal SD +MRCSD.DE.t = optimize.portfolio.rebalancing(R=R, + portfolio=MRCSD.portf, optimize_method='DEoptim', search_size=20000, NP=200, @@ -583,14 +589,54 @@ rebalance_on=rebalance_period, # uses xts 'endpoints' trailing_periods=NULL, # calculates from inception training_period=36) # starts 3 years in to the data history -EqmETL.w = extractWeights.rebal(EqmETL.DE.t) -chart.UnStackedBar(EqmETL.w, rotate="horizontal", colorset=wb13color, space=0, las=2) -EqmETL=Return.rebalancing(edhec.R, EqmETL.w) -colnames(EqmETL) = "EqmETL" -save(EqmETL.DE.t,file=paste(resultsdir, 'EqmETL.DE.t-', Sys.Date(), '-', runname, '.rda',sep='')) +MRCSD.w = extractWeights(MRCSD.DE.t) +MRCSD.gw = extractGroups(MRCSD.DE.t) +save(MRCSD.DE.t,file=paste(resultsdir, 'MRCSD.DE.t-', Sys.Date(), '-', runname, '.rda',sep='')) +chart.UnStackedBar(MRCSD.w, rotate="horizontal", colorset=wb13color, space=0, las=2) +MRCSD.R=Return.rebalancing(edhec.R, MRCSD.w) +colnames(MRCSD) = "MRCSD" +# Extract perc contrib of mES from results object +x=NULL +for(i in 1:length(names(MRCSD.DE.t))) { + x = rbind(x,MRCSD.DE.t[[i]][["objective_measures"]]$StdDev$pct_contrib_StdDev) +} +MRCSD.DE.pct_contrib_StdDev.t = as.xts(x, order.by=as.POSIXct(names(MRCSD.DE.t))) +chart.UnStackedBar(x.xts, rotate="horizontal", colorset=wb13color, space=0, las=2) +# MRC mETL +MRCmETL.DE.t = optimize.portfolio.rebalancing(R=R, + portfolio=MRCmETL.portf, + optimize_method='DEoptim', + search_size=20000, + NP=200, + initialpop=rp[1:50,], # seed with a starting population that we know fits the constraint space + trace=FALSE, + rebalance_on=rebalance_period, # uses xts 'endpoints' + trailing_periods=NULL, # calculates from inception + training_period=36) # starts 3 years in to the data history +MRCmETL.w = extractWeights(MRCmETL.DE.t) +MRCmETL.gw = extractGroups(MRCmETL.DE.t) +save(MRCmETL.DE.t,file=paste(resultsdir, 'MRCmETL.DE.t-', Sys.Date(), '-', runname, '.rda',sep='')) +chart.UnStackedBar(MRCmETL.w, rotate="horizontal", colorset=wb13color, space=0, las=2) +MRCmETL=Return.rebalancing(edhec.R, MRCmETL.w) +colnames(MRCmETL) = "MRCmETL" + +MRCmETL.RND.t = optimize.portfolio.rebalancing(R=R, + portfolio=MRCmETL.portf, + optimize_method='random', + rp=rp, + trace=TRUE, + rebalance_on=rebalance_period, # uses xts 'endpoints' + trailing_periods=NULL, # calculates from inception + training_period=36) # starts 3 years in to the data history +MRCmETL.RND.w = extractWeights(MRCmETL.RND.t) +MRCmETL.gw = extractGroups(MRCmETL.RND.t) +save(MRCmETL.DE.t,file=paste(resultsdir, 'MRCmETL.DE.t-', Sys.Date(), '-', runname, '.rda',sep='')) +chart.UnStackedBar(MRCmETL.w, rotate="horizontal", colorset=wb13color, space=0, las=2) +MRCmETL=Return.rebalancing(edhec.R, MRCmETL.w) +colnames(MRCmETL) = "MRCmETL" end_time<-Sys.time() end_time-start_time Modified: pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R =================================================================== --- pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R 2013-10-11 21:57:12 UTC (rev 3217) +++ pkg/PortfolioAnalytics/sandbox/symposium2013/results.HFindexes.R 2013-10-12 14:39:34 UTC (rev 3218) @@ -6,21 +6,21 @@ # Plot Ex Ante scatter of RP and ONLY Equal Weight portfolio in StdDev space # -------------------------------------------------------------------- # Done -CairoPDF(file=paste(resultsdir, dataname, "-RP-EqWgt-MeanSD-ExAnte.pdf", sep=""), height=6, width=9) -par(mar=c(5, 5, 1, 2) + 0.1) #c(bottom, left, top, right) +CairoPDF(file=paste(resultsdir, dataname, "-RP-EqWgt-MeanSD-ExAnte.pdf", sep=""), height=5.5, width=9) +par(mar=c(5, 4, 1, 1) + 0.1) #c(bottom, left, top, right) # Calculate chart bounds to unify with the charts below xlim.StdDev=c(min(c(xtract[,"StdDev"], buoys.portfmeas[,"StdDev"])), max(c(xtract[,"StdDev"], buoys.portfmeas[,"StdDev"]))) ylim.mean=c(min(c(xtract[,"mean"], buoys.portfmeas[,"Mean"])), max(c(xtract[,"mean"], buoys.portfmeas[,"Mean"]))) -plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante Std Dev", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.6, xlim=xlim.StdDev, ylim=ylim.mean) +plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante Std Dev", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.6, xlim=xlim.StdDev, ylim=ylim.mean) # leave cloud darkgray for this slide grid(col = "darkgray") abline(h = 0, col = "darkgray") # Overplot the equal weight portfolio -points(buoys.portfmeas[8,"StdDev"],buoys.portfmeas[8,"Mean"], col=tol8qualitative[8], pch=16, cex=1.5) # watch the order in portfmeas -axis(1, cex.axis = 0.8, col = "darkgray", las=1) -axis(2, cex.axis = 0.8, col = "darkgray", las=1) +points(buoys.portfmeas[8,"StdDev"],buoys.portfmeas[8,"Mean"], col=wb13color[4], pch=16, cex=1.5) # watch the order in portfmeas +axis(1, cex.axis = 0.8, col = "darkgray") +axis(2, cex.axis = 0.8, col = "darkgray") box(col = "darkgray") -legend("bottomright",legend=results.names[8], col=tol8qualitative[8], pch=16, ncol=1, border.col="darkgray", y.intersp=1.2, cex=0.8, inset=.02) +legend("bottomright",legend=results.names[8], col=wb13color[4], pch=16, ncol=1, border.col="darkgray", y.intersp=1.2, cex=0.8, inset=.02) par(op) dev.off() @@ -28,17 +28,17 @@ # Plot Ex Ante scatter of RP and ASSET portfolios in StdDev space # -------------------------------------------------------------------- # @TODO: add the assets to this chart -CairoPDF(file=paste(resultsdir, dataname, "-RP-Assets-MeanSD-ExAnte.pdf", sep=""), height=6, width=9) +CairoPDF(file=paste(resultsdir, dataname, "-RP-Assets-MeanSD-ExAnte.pdf", sep=""), height=5.5, width=9) xlim.StdDev.assets =c(min(c(xtract[,"StdDev"], assets.portfmeas[,"StdDev"], 0)), max(c(xtract[,"StdDev"], assets.portfmeas[,"StdDev"],0.03))) ylim.mean.assets =c(min(c(xtract[,"mean"], assets.portfmeas[,"Mean"], 0)), max(c(xtract[,"mean"], assets.portfmeas[,"Mean"]))) -par(mar=c(5, 5, 1, 2) + 0.1) #c(bottom, left, top, right) +par(mar=c(5, 4, 1, 1) + 0.1) #c(bottom, left, top, right) # Revise the chart bounds to include the asssets -plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante mETL", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.6, xlim=xlim.StdDev.assets, ylim=ylim.mean.assets) +plot(xtract[,"StdDev"],xtract[,"mean"], xlab="Ex Ante mETL", ylab="Ex Ante Mean", col="darkgray", axes=FALSE, main="", cex=.3, xlim=xlim.StdDev.assets, ylim=ylim.mean.assets) grid(col = "darkgray") abline(h = 0, col = "darkgray") abline(v = 0, col = "darkgray") # Overplot the equal weight portfolio -points(buoys.portfmeas[8,"StdDev"],buoys.portfmeas[8,"Mean"], col=tol8qualitative[8], pch=16, cex=1.5) # watch the order in portfmeas +points(buoys.portfmeas[8,"StdDev"],buoys.portfmeas[8,"Mean"], col=wb13color[4], pch=16, cex=1.5) # watch the order in portfmeas text(x=buoys.portfmeas[8,"StdDev"], y=buoys.portfmeas[8,"Mean"], labels=rownames(buoys.portfmeas)[8], pos=4, cex=1) points(assets.portfmeas[,"StdDev"],assets.portfmeas[,"Mean"], col=rich8equal, pch=18, cex=1.5) # watch the order in portfmeas text(x=assets.portfmeas[,"StdDev"], y=assets.portfmeas[,"Mean"], labels=rownames(assets.portfmeas), pos=4, cex=1) @@ -53,17 +53,17 @@ [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/returnanalytics -r 3218 From noreply at r-forge.r-project.org Sat Oct 12 18:02:02 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 12 Oct 2013 18:02:02 +0200 (CEST) Subject: [Returnanalytics-commits] r3219 - in pkg/PerformanceAnalytics/sandbox/Shubhankit: . noniid.sm/vignettes Message-ID: <20131012160202.AD529185077@r-forge.r-project.org> Author: shubhanm Date: 2013-10-12 18:02:02 +0200 (Sat, 12 Oct 2013) New Revision: 3219 Removed: pkg/PerformanceAnalytics/sandbox/Shubhankit/Shubhankit.zip pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm_0.1.tar.gz Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/vignettes/Non-iid-EmaxDDGBM.Rnw pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/vignettes/Non-iid-EmaxDDGBM.pdf pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/vignettes/Non-iid-Managers.Rnw Log: R CMD Clean Build, removing one path script which lead to previous non-build fatal error, deletion of 21 MB file zipped file [ deemed unnecessary] Deleted: pkg/PerformanceAnalytics/sandbox/Shubhankit/Shubhankit.zip =================================================================== (Binary files differ) Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/vignettes/Non-iid-EmaxDDGBM.Rnw =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/vignettes/Non-iid-EmaxDDGBM.Rnw 2013-10-12 14:39:34 UTC (rev 3218) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/vignettes/Non-iid-EmaxDDGBM.Rnw 2013-10-12 16:02:02 UTC (rev 3219) @@ -45,9 +45,6 @@ \end{abstract} -<>= -require(noniid.sm) #source('C:/Users/shubhankit/Desktop/Again/pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/R/LoSharpe.R') -@ <>= library(PerformanceAnalytics) @@ -74,7 +71,7 @@ <>= -source('C:/Users/shubhankit/Desktop/Again/pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/R/EmaxDDGBM.R') +library(noniid.sm) data(edhec) Lo.Sharpe = -100*ES(edhec,.99) Theoretical.Sharpe= EmaxDDGBM(edhec) @@ -87,7 +84,7 @@ We can observe that the fund "\textbf{Emerging Markets}", which has the largest drawdown and serial autocorrelation, has highest Drawdown , \emph{decrease} most significantly as comapared to other funds. <>= - +library(noniid.sm) data(managers) Lo.Sharpe = -100*ES(managers[,1:6],.99) Theoretical.Sharpe= EmaxDDGBM(managers[,1:6]) Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/vignettes/Non-iid-EmaxDDGBM.pdf =================================================================== (Binary files differ) Modified: pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/vignettes/Non-iid-Managers.Rnw =================================================================== --- pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/vignettes/Non-iid-Managers.Rnw 2013-10-12 14:39:34 UTC (rev 3218) +++ pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/vignettes/Non-iid-Managers.Rnw 2013-10-12 16:02:02 UTC (rev 3219) @@ -198,7 +198,7 @@ <>= library(noniid.sm) -source("C:/Users/shubhankit/Desktop/Again/pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/R/GLMSmoothIndex.R") + GLM.index=GLMSmoothIndex(managers[,1:6]) barplot(as.matrix(GLM.index), main="GLM Smooth Index", xlab="Fund Type",ylab="Value",colorset = rich6equal[1], beside=TRUE) @@ -231,8 +231,8 @@ This means that as the return/volatility increases not only the magnitude of drawdown decreases but the confidence interval as well. In others words losses are both smaller and more predictable. <>= -source("C:/Users/shubhankit/Desktop/Again/pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm/R/AcarSim.R") -AcarSim(managers[,1:6]) +library(noniid.sm) +chart.AcarSim(managers[,1:6]) @ As we can see from the \emph{simulated chart}, DJUBS.Commodity comes at the bottom , which imply a \emph{lower} \textbf{return-maximum loss} ratio. Deleted: pkg/PerformanceAnalytics/sandbox/Shubhankit/noniid.sm_0.1.tar.gz =================================================================== (Binary files differ) From noreply at r-forge.r-project.org Mon Oct 14 21:36:43 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 14 Oct 2013 21:36:43 +0200 (CEST) Subject: [Returnanalytics-commits] r3220 - in pkg/PortfolioAnalytics: . R man Message-ID: <20131014193644.0B13D185EB2@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-14 21:36:43 +0200 (Mon, 14 Oct 2013) New Revision: 3220 Added: pkg/PortfolioAnalytics/man/print.summary.optimize.portfolio.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/generics.R pkg/PortfolioAnalytics/man/chart.RiskReward.Rd pkg/PortfolioAnalytics/man/chart.Weights.Rd pkg/PortfolioAnalytics/man/summary.optimize.portfolio.Rd Log: Modifying the summary method to be more structured and add print method for summary.optimize.portfolio objects. Minor clean up of documentation. Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-10-12 16:02:02 UTC (rev 3219) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-10-14 19:36:43 UTC (rev 3220) @@ -118,6 +118,7 @@ S3method(print,optimize.portfolio.random) S3method(print,optimize.portfolio.ROI) S3method(print,portfolio) +S3method(print,summary.optimize.portfolio) S3method(summary,efficient.frontier) S3method(summary,optimize.portfolio.rebalancing) S3method(summary,optimize.portfolio) Modified: pkg/PortfolioAnalytics/R/generics.R =================================================================== --- pkg/PortfolioAnalytics/R/generics.R 2013-10-12 16:02:02 UTC (rev 3219) +++ pkg/PortfolioAnalytics/R/generics.R 2013-10-14 19:36:43 UTC (rev 3220) @@ -468,33 +468,34 @@ #' @param object an object of class "optimize.portfolio.pso" resulting from a call to optimize.portfolio #' @param ... any other passthru parameters. Currently not used. #' @author Ross Bennett -#' @method summary optimize.portfolio -#' @export -summary.optimize.portfolio <- function(object, ...){ +#' @method print summary.optimize.portfolio +#' @S3method print summary.optimize.portfolio +print.summary.optimize.portfolio <- function(x, ...){ cat(rep("*", 50) ,"\n", sep="") cat("PortfolioAnalytics Optimization Summary", "\n") cat(rep("*", 50) ,"\n", sep="") # show the call to optimize.portfolio - cat("\nCall:\n", paste(deparse(object$call), sep = "\n", collapse = "\n"), - "\n\n", sep = "") + cat("\nCall:\n") + print(x$call) + cat("\n") # get optimal weights cat("Optimal Weights:\n") - print.default(round(object$weights, digits=4)) + print.default(round(x$weights, digits=4)) cat("\n") # objective measures # The objective measure is object$out for ROI cat("Objective Measures:\n") - if(!is.null(object$objective_measures)){ + if(!is.null(x$objective_values)){ # get objective measures - objective_measures <- object$objective_measures + objective_measures <- x$objective_values tmp_obj <- as.numeric(unlist(objective_measures)) names(tmp_obj) <- names(objective_measures) for(i in 1:length(objective_measures)){ - print(tmp_obj[i], digits=4) + print.default(tmp_obj[i], digits=4) cat("\n") if(length(objective_measures[[i]]) > 1){ # This will be the case for any objective measures with risk budgets @@ -502,86 +503,70 @@ tmpl <- objective_measures[[i]][j] cat(names(tmpl), ":\n") tmpv <- unlist(tmpl) - names(tmpv) <- names(object$weights) - print(tmpv) + names(tmpv) <- names(x$weights) + print.default(tmpv) cat("\n") } } cat("\n") } } else { - print(as.numeric(object$out)) + print.default(as.numeric(x$out)) } - cat("\n") # get initial portfolio cat("Portfolio Assets and Initial Weights:\n") - print.default(object$portfolio$assets) + print.default(x$initial_weights) cat("\n") # print the portfolio object - print(object$portfolio) + print(x$portfolio) # Constraints cat(rep("*", 40), "\n", sep="") cat("Constraints\n") cat(rep("*", 40), "\n", sep="") - # get the constraints - constraints <- get_constraints(object$portfolio) - # leverage constraints cat("Leverage Constraint:\n") - if(!is.null(constraints$min_sum) & !is.null(constraints$max_sum)){ - cat("min_sum = ", constraints$min_sum, "\n", sep="") - cat("max_sum = ", constraints$max_sum, "\n", sep="") + if(!is.null(x$leverage_constraint)){ + cat("min_sum = ", x$leverage_constraint$min_sum, "\n", sep="") + cat("max_sum = ", x$leverage_constraint$max_sum, "\n", sep="") + cat("actual_leverage = ", x$leverage_constraint$actual, "\n", sep="") cat("\n") } # box constraints cat("Box Constraints:\n") - if(!is.null(constraints$min) & !is.null(constraints$max)){ + if(!is.null(x$box_constraint)){ cat("min:\n") - print(constraints$min) + print.default(x$box_constraint$min) cat("max:\n") - print(constraints$max) + print.default(x$box_constraint$max) cat("\n") } # group constraints group_weights <- NULL - if(!is.null(constraints$groups) & !is.null(constraints$cLO) & !is.null(constraints$cUP)){ + if(!is.null(x$group_constraint)){ cat("Group Constraints:\n") cat("Groups:\n") - groups <- constraints$groups - group_labels <- constraints$group_labels - names(groups) <- group_labels - print(groups) + print.default(x$group_constraint$groups) cat("\n") cat("Lower bound on group weights, group_min:\n") - cLO <- constraints$cLO - names(cLO) <- group_labels - print(cLO) + print.default(x$group_constraint$group_min) cat("\n") cat("Upper bound on group weights, group_max:\n") - cUP <- constraints$cUP - names(cUP) <- group_labels - print(cUP) + print.default(x$group_constraint$group_max) cat("\n") - cat("Group position limits, group_pos:\n") - group_pos <- constraints$group_pos - if(!is.null(group_pos)) names(group_pos) <- group_labels - print(group_pos) - cat("\n") +# cat("Group position limits, group_pos:\n") +# group_pos <- constraints$group_pos +# if(!is.null(group_pos)) names(group_pos) <- group_labels +# print(group_pos) +# cat("\n") cat("Group Weights:\n") - n.groups <- length(groups) - group_weights <- rep(0, n.groups) - for(i in 1:n.groups){ - group_weights[i] <- sum(object$weights[groups[[i]]]) - } - names(group_weights) <- group_labels - print(group_weights) + print.default(x$group_constraint$group_weights_actual) cat("\n") } tolerance <- .Machine$double.eps^0.5 @@ -589,64 +574,73 @@ # position limit constraints cat("Position Limit Constraints:\n") cat("Maximum number of non-zero weights, max_pos:\n") - print(constraints$max_pos) + if(!is.null(x$position_limit_constraint[["max_pos"]])){ + print.default(x$position_limit_constraint[["max_pos"]]) + } else { + print("Unconstrained") + } cat("Realized number of non-zero weights (i.e. positions):\n") - print(sum(abs(object$weights) > tolerance)) + print.default(x$position_limit_constraint$max_pos_actual) cat("\n") cat("Maximum number of long positions, max_pos_long:\n") - print(constraints$max_pos_long) + if(!is.null(x$position_limit_constraint[["max_pos_long"]])){ + print.default(x$position_limit_constraint[["max_pos_long"]]) + } else { + print("Unconstrained") + } cat("Realized number of long positions:\n") - print(sum(object$weights > tolerance)) + print.default(x$position_limit_constraint$max_pos_long_actual) cat("\n") cat("Maximum number of short positions, max_pos_short:\n") - print(constraints$max_pos_short) + if(!is.null(x$position_limit_constraint[["max_pos_short"]])){ + print.default(x$position_limit_constraint[["max_pos_short"]]) + } else { + print("Unconstrained") + } cat("Realized number of short positions:\n") - print(sum(object$weights < -tolerance)) + print.default(x$position_limit_constraint$max_pos_short_actual) cat("\n\n") # diversification cat("Diversification Target Constraint:\n") - print(constraints$div_target) + if(!is.null(x$diversification_constraint$diversification_target)){ + print.default(x$diversification_constraint$diversification_target) + } else { + print("Unconstrained") + } cat("\n") cat("Realized diversification:\n") - print(diversification(object$weights)) + print.default(x$diversification_constraint$diversification_actual) cat("\n") # turnover cat("Turnover Target Constraint:\n") - print(constraints$turnover_target) + if(!is.null(x$turnover_constraint$turnover_target)){ + print.default(x$turnover_constraint$turnover_target) + } else { + print("Unconstrained") + } cat("\n") cat("Realized turnover from initial weights:\n") - print(turnover(object$weights, wts.init=object$portfolio$assets)) + print.default(x$turnover_constraint$turnover_actual) cat("\n") # Factor exposure constraint - tmpexp <- NULL - if(!is.null(constraints$B) & !is.null(constraints$lower) & !is.null(constraints$upper)){ + if(!is.null(x$factor_exposure_constraint)){ cat("Factor Exposure Constraints:\n") - t.B <- t(constraints$B) cat("Factor Exposure B Matrix:\n") - print(constraints$B) + print.default(x$factor_exposure_constraint$B) cat("\n") cat("Lower bound on factor exposures, lower:\n") - lower <- constraints$lower - names(lower) <- colnames(constraints$B) - print(lower) + print.default(x$factor_exposure_constraint$lower) cat("\n") - cat("Upper bound on group weights, group_max:\n") - upper <- constraints$upper - names(upper) <- colnames(constraints$B) - print(upper) + cat("Upper bound on group weights, upper:\n") + print.default(x$factor_exposure_constraint$upper) cat("\n") cat("Realized Factor Exposures:\n") - tmpexp <- vector(mode="numeric", length=nrow(t.B)) - for(i in 1:nrow(t.B)){ - tmpexp[i] <- t(object$weights) %*% t.B[i, ] - } - names(tmpexp) <- rownames(t.B) - print(tmpexp) + print.default(x$factor_exposure_constraint$exposure_actual) cat("\n\n") } @@ -655,28 +649,147 @@ cat("Objectives\n") cat(rep("*", 40), "\n\n", sep="") - for(obj in object$portfolio$objectives){ + for(obj in x$portfolio$objectives){ cat("Objective:", class(obj)[1], "\n") - print(obj) + print.default(obj) cat("\n", rep("*", 40), "\n", sep="") } cat("\n") # show the elapsed time for the optimization cat("Elapsed Time:\n") - print(object$elapsed_time) + print(x$elapsed_time) cat("\n") - invisible(list(weights=object$weights, - opt_values=object$objective_measures, - group_weights=group_weights, - factor_exposures=tmpexp, - diversification=diversification(object$weights), - turnover=turnover(object$weights, wts.init=object$portfolio$assets), - positions=sum(abs(object$weights) > tolerance), - long_positions=sum(object$weights > tolerance), - short_positions=sum(object$weights < -tolerance))) } +#' Summarizing output of optimize.portfolio +#' +#' summary method for class "optimize.portfolio" +#' +#' @param object an object of class "optimize.portfolio.pso" resulting from a call to optimize.portfolio +#' @param ... any other passthru parameters. Currently not used. +#' @author Ross Bennett +#' @method summary optimize.portfolio +#' @S3method summary optimize.portfolio +summary.optimize.portfolio <- function(object, ...){ + + out <- list() + + out$call <- object$call + + # optimal weights + opt_weights <- extractWeights(object) + out$weights <- opt_weights + + # objective measure values + out$objective_values <- extractObjectiveMeasures(object) + + # optimization time + out$elapsed_time <- object$elapsed_time + + # initial weights + initial_weights <- object$portfolio$assets + out$initial_weights <- initial_weights + + ### constraint realization + constraints <- get_constraints(object$portfolio) + # leverage + leverage_constraint <- list() + leverage_constraint$min_sum <- constraints$min_sum + leverage_constraint$max_sum <- constraints$max_sum + leverage_constraint$actual <- sum(opt_weights) + out$leverage_constraint <- leverage_constraint + + # box + box_constraint <- list() + box_constraint$min <- constraints$min + box_constraint$max <- constraints$max + box_constraint$actual <- opt_weights + out$box_constraint <- box_constraint + + # group + if(!is.null(constraints$groups)){ + asset_names <- names(opt_weights) + group_constraint <- list() + group_constraint$groups <- list() + groups <- constraints$groups + for(i in 1:length(groups)){ + groups[[i]] <- asset_names[groups[[i]]] + } + group_constraint$groups <- groups + group_constraint$group_min <- constraints$cLO + group_constraint$group_max <- constraints$cUP + group_constraint$group_pos <- constraints$group_pos + + # actual weights by group and/or category + tmp_groups <- extractGroups(object) + group_constraint$group_weights_actual <- tmp_groups$group_weights + out$group_constraint <- group_constraint + } + + # category weights + if(is.null(constraints$groups) & !is.null(object$portfolio$category_labels)){ + category_weights <- list() + category_weights$category_weights <- object$portfolio$category_labels + tmp_groups <- extractGroups(object) + category_weights$category_weights_actual <- tmp_groups$category_weights + out$category_weights <- category_weights + } + + # factor exposure + if(!is.null(constraints$B) & !is.null(constraints$lower) & !is.null(constraints$upper)){ + factor_exposure_constraint <- list() + factor_exposure_constraint$B <- constraints$B + factor_exposure_constraint$lower <- constraints$lower + names(factor_exposure_constraint$lower) <- colnames(constraints$B) + factor_exposure_constraint$upper <- constraints$upper + names(factor_exposure_constraint$upper) <- colnames(constraints$B) + + t.B <- t(constraints$B) + tmpexp <- vector(mode="numeric", length=nrow(t.B)) + for(i in 1:nrow(t.B)){ + tmpexp[i] <- t(opt_weights) %*% t.B[i, ] + } + names(tmpexp) <- rownames(t.B) + factor_exposure_constraint$exposure_actual <- tmpexp + out$factor_exposure_constraint <- factor_exposure_constraint + } + + # position limit + tolerance <- .Machine$double.eps^0.5 + position_limit_constraint <- list() + position_limit_constraint$max_pos <- constraints$max_pos + position_limit_constraint$max_pos_long <- constraints$max_pos_long + position_limit_constraint$max_pos_short <- constraints$max_pos_short + # number of positions with non-zero weights + position_limit_constraint$max_pos_actual <- sum(abs(object$weights) > tolerance) + # actual long positions + position_limit_constraint$max_pos_long_actual <- sum(object$weights > tolerance) + # actual short positions + position_limit_constraint$max_pos_short_actual <- sum(object$weights < -tolerance) + out$position_limit_constraint <- position_limit_constraint + + # diversification + diversification_constraint <- list() + # target diversification + diversification_constraint$diversification_target <- constraints$div_target + # actual realized diversification + diversification_constraint$diversification_actual <- diversification(opt_weights) + out$diversification_constraint <- diversification_constraint + + # turnover + turnover_constraint <- list() + turnover_constraint$turnover_target <- constraints$turnover_target + turnover_constraint$turnover_actual <- turnover(opt_weights, wts.init=initial_weights) + out$turnover_constraint <- turnover_constraint + + # original portfolio object + out$portfolio <- object$portfolio + + class(out) <- "summary.optimize.portfolio" + return(out) +} + #' Print an efficient frontier object #' #' Print method for efficient frontier objects. Display the call to create or Modified: pkg/PortfolioAnalytics/man/chart.RiskReward.Rd =================================================================== --- pkg/PortfolioAnalytics/man/chart.RiskReward.Rd 2013-10-12 16:02:02 UTC (rev 3219) +++ pkg/PortfolioAnalytics/man/chart.RiskReward.Rd 2013-10-14 19:36:43 UTC (rev 3220) @@ -38,8 +38,8 @@ \method{chart.RiskReward}{opt.list} (object, ..., risk.col = "ES", return.col = "mean", main = "", ylim = NULL, xlim = NULL, labels.assets = TRUE, - pch.assets = 1, cex.assets = 0.8, cex.axis = 0.8, - cex.lab = 0.8, colorset = NULL, + chart.assets = FALSE, pch.assets = 1, cex.assets = 0.8, + cex.axis = 0.8, cex.lab = 0.8, colorset = NULL, element.color = "darkgray") } \arguments{ Modified: pkg/PortfolioAnalytics/man/chart.Weights.Rd =================================================================== --- pkg/PortfolioAnalytics/man/chart.Weights.Rd 2013-10-12 16:02:02 UTC (rev 3219) +++ pkg/PortfolioAnalytics/man/chart.Weights.Rd 2013-10-14 19:36:43 UTC (rev 3220) @@ -1,4 +1,4 @@ -\name{chart.Weights} +\name{chart.Weights.optimize.portfolio.DEoptim} \alias{chart.Weights} \alias{chart.Weights.opt.list} \alias{chart.Weights.optimize.portfolio.DEoptim} Added: pkg/PortfolioAnalytics/man/print.summary.optimize.portfolio.Rd =================================================================== --- pkg/PortfolioAnalytics/man/print.summary.optimize.portfolio.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/print.summary.optimize.portfolio.Rd 2013-10-14 19:36:43 UTC (rev 3220) @@ -0,0 +1,20 @@ +\name{print.summary.optimize.portfolio} +\alias{print.summary.optimize.portfolio} +\title{Summarizing Output of optimize.portfolio} +\usage{ + \method{print}{summary.optimize.portfolio} (x, ...) +} +\arguments{ + \item{object}{an object of class "optimize.portfolio.pso" + resulting from a call to optimize.portfolio} + + \item{...}{any other passthru parameters. Currently not + used.} +} +\description{ + summary method for class "optimize.portfolio" +} +\author{ + Ross Bennett +} + Modified: pkg/PortfolioAnalytics/man/summary.optimize.portfolio.Rd =================================================================== --- pkg/PortfolioAnalytics/man/summary.optimize.portfolio.Rd 2013-10-12 16:02:02 UTC (rev 3219) +++ pkg/PortfolioAnalytics/man/summary.optimize.portfolio.Rd 2013-10-14 19:36:43 UTC (rev 3220) @@ -1,6 +1,6 @@ \name{summary.optimize.portfolio} \alias{summary.optimize.portfolio} -\title{Summarizing Output of optimize.portfolio} +\title{Summarizing output of optimize.portfolio} \usage{ \method{summary}{optimize.portfolio} (object, ...) } From noreply at r-forge.r-project.org Mon Oct 14 23:07:18 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 14 Oct 2013 23:07:18 +0200 (CEST) Subject: [Returnanalytics-commits] r3221 - pkg/PortfolioAnalytics/R Message-ID: <20131014210718.BF7D0184C83@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-14 23:07:18 +0200 (Mon, 14 Oct 2013) New Revision: 3221 Modified: pkg/PortfolioAnalytics/R/optFUN.R Log: Modifying turnover constraint gmv optimization Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-10-14 19:36:43 UTC (rev 3220) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-10-14 21:07:18 UTC (rev 3221) @@ -497,13 +497,6 @@ # initial weights for solver if(is.null(init_weights)) init_weights <- rep(1/ N, N) - # Amat for initial weights - # Amat <- cbind(diag(N), matrix(0, nrow=N, ncol=N*2)) - Amat <- cbind(diag(N), -1*diag(N), diag(N)) - rhs <- init_weights - dir <- rep("==", N) - meq <- 4 - # check for a target return constraint if(!is.na(target)) { # If var is the only objective specified, then moments$mean won't be calculated @@ -511,28 +504,23 @@ tmp_means <- colMeans(R) } else { tmp_means <- moments$mean + target <- 0 } - Amat <- rbind(Amat, c(tmp_means, rep(0, 2*N))) - dir <- c(dir, "==") - rhs <- c(rhs, target) - meq <- 5 + } else { + tmp_means <- moments$mean + target <- 0 } + Amat <- c(tmp_means, rep(0, 2*N)) + dir <- "==" + rhs <- target + meq <- N + 1 - # Amat for full investment constraint - Amat <- rbind(Amat, rbind(c(rep(1, N), rep(0,2*N)), c(rep(-1, N), rep(0,2*N)))) - rhs <- c(rhs, constraints$min_sum, -constraints$max_sum) - dir <- c(dir, ">=", ">=") + # Amat for initial weights + # Amat <- cbind(diag(N), matrix(0, nrow=N, ncol=N*2)) + Amat <- rbind(Amat, cbind(diag(N), -1*diag(N), diag(N))) + rhs <- c(rhs, init_weights) + dir <- c(dir, rep("==", N)) - # Amat for lower box constraints - Amat <- rbind(Amat, cbind(diag(N), diag(0, N), diag(0, N))) - rhs <- c(rhs, constraints$min) - dir <- c(dir, rep(">=", N)) - - # Amat for upper box constraints - Amat <- rbind(Amat, cbind(-diag(N), diag(0, N), diag(0, N))) - rhs <- c(rhs, -constraints$max) - dir <- c(dir, rep(">=", N)) - # Amat for turnover constraints Amat <- rbind(Amat, c(rep(0, N), rep(-1, N), rep(-1, N))) rhs <- c(rhs, -constraints$turnover_target) @@ -548,6 +536,21 @@ rhs <- c(rhs, rep(0, N)) dir <- c(dir, rep(">=", N)) + # Amat for full investment constraint + Amat <- rbind(Amat, rbind(c(rep(1, N), rep(0,2*N)), c(rep(-1, N), rep(0,2*N)))) + rhs <- c(rhs, constraints$min_sum, -constraints$max_sum) + dir <- c(dir, ">=", ">=") + + # Amat for lower box constraints + Amat <- rbind(Amat, cbind(diag(N), diag(0, N), diag(0, N))) + rhs <- c(rhs, constraints$min) + dir <- c(dir, rep(">=", N)) + + # Amat for upper box constraints + Amat <- rbind(Amat, cbind(-diag(N), diag(0, N), diag(0, N))) + rhs <- c(rhs, -constraints$max) + dir <- c(dir, rep(">=", N)) + # include group constraints if(try(!is.null(constraints$groups), silent=TRUE)){ n.groups <- length(constraints$groups) @@ -575,7 +578,7 @@ } d <- rep(-moments$mean, 3) - + # print(Amat) stopifnot("package:corpcor" %in% search() || require("corpcor",quietly = TRUE)) stopifnot("package:quadprog" %in% search() || require("quadprog",quietly = TRUE)) qp.result <- try(solve.QP(Dmat=make.positive.definite(2*lambda*V), @@ -583,6 +586,7 @@ if(inherits(qp.result, "try-error")) stop("No solution found, consider adjusting constraints.") wts <- qp.result$solution + # print(round(wts,4)) wts.final <- wts[(1:N)] # wts.buy <- wts[(1+N):(2*N)] # wts.sell <- wts[(2*N+1):(3*N)] From noreply at r-forge.r-project.org Thu Oct 17 18:30:37 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 17 Oct 2013 18:30:37 +0200 (CEST) Subject: [Returnanalytics-commits] r3222 - pkg/PortfolioAnalytics/R Message-ID: <20131017163037.7DE0D184D58@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-17 18:30:37 +0200 (Thu, 17 Oct 2013) New Revision: 3222 Added: pkg/PortfolioAnalytics/R/inverse.volatility.weight.R Log: Adding constructor for inverse volatility weighted portfolio. Added: pkg/PortfolioAnalytics/R/inverse.volatility.weight.R =================================================================== --- pkg/PortfolioAnalytics/R/inverse.volatility.weight.R (rev 0) +++ pkg/PortfolioAnalytics/R/inverse.volatility.weight.R 2013-10-17 16:30:37 UTC (rev 3222) @@ -0,0 +1,49 @@ + + +#' Create an inverse volatility weighted portfolio +#' +#' This function calculates objective measures for an equal weight portfolio. +#' +#' @details +#' This function is simply a wrapper around \code{\link{constrained_objective}} +#' to calculate the objective measures in the given \code{portfolio} object of +#' an inverse volatility weight portfolio. The portfolio object should include all objectives +#' to be calculated. +#' +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns +#' @param portfolio an object of type "portfolio" specifying the constraints and objectives for the optimization +#' @param \dots any other passthru parameters to \code{constrained_objective} +#' @return a list containing the returns, weights, objective measures, call, and portfolio object +#' @author Peter Carl +#' @export +inverse.volatility.weight <- function(R, portfolio, ...){ + # Check for portfolio object passed in + if(!is.portfolio(portfolio)) stop("portfolio object passed in must be of class 'portfolio'") + + # get asset information for equal weight portfolio + assets <- portfolio$assets + nassets <- length(assets) + + # make sure the number of columns in R matches the number of assets + if(ncol(R) != nassets){ + if(ncol(R) > nassets){ + R <- R[, 1:nassets] + warning("number of assets is less than number of columns in returns object, subsetting returns object.") + } else { + stop("number of assets is greater than number of columns in returns object") + } + } + + weights <- as.vector((1/StdDev(R))/sum(1/StdDev(R))) + names(weights) <- names(assets) + + out <- constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE, ...)$objective_measures + return(structure(list( + R=R, + weights=weights, + objective_measures=out, + call=match.call(), + portfolio=portfolio), + class=c("optimize.portfolio.invol", "optimize.portfolio")) + ) +} \ No newline at end of file From noreply at r-forge.r-project.org Thu Oct 17 18:48:38 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 17 Oct 2013 18:48:38 +0200 (CEST) Subject: [Returnanalytics-commits] r3223 - pkg/PortfolioAnalytics/R Message-ID: <20131017164838.9BE10184B54@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-17 18:48:38 +0200 (Thu, 17 Oct 2013) New Revision: 3223 Modified: pkg/PortfolioAnalytics/R/equal.weight.R pkg/PortfolioAnalytics/R/extractstats.R pkg/PortfolioAnalytics/R/inverse.volatility.weight.R Log: Minor modification to equal weight and inverse volatility weight constructors. Added extractStats method for optimize.portfolio.eqwt and optimize.portfolio.invol. Modified: pkg/PortfolioAnalytics/R/equal.weight.R =================================================================== --- pkg/PortfolioAnalytics/R/equal.weight.R 2013-10-17 16:30:37 UTC (rev 3222) +++ pkg/PortfolioAnalytics/R/equal.weight.R 2013-10-17 16:48:38 UTC (rev 3223) @@ -36,11 +36,12 @@ } } - out <- constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE, ...)$objective_measures + tmpout <- constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE, ...) return(structure(list( R=R, weights=weights, - objective_measures=out, + out=tmpout$out, + objective_measures=tmpout$objective_measures, call=match.call(), portfolio=portfolio), class=c("optimize.portfolio.eqwt", "optimize.portfolio")) Modified: pkg/PortfolioAnalytics/R/extractstats.R =================================================================== --- pkg/PortfolioAnalytics/R/extractstats.R 2013-10-17 16:30:37 UTC (rev 3222) +++ pkg/PortfolioAnalytics/R/extractstats.R 2013-10-17 16:48:38 UTC (rev 3223) @@ -297,6 +297,36 @@ return(result) } +#' @method extractStats optimize.portfolio.invol +#' @S3method extractStats optimize.portfolio.invol +#' @export +extractStats.optimize.portfolio.invol <- function(object, prefix=NULL, ...) { + if(!inherits(object, "optimize.portfolio.invol")) stop("object must be of class optimize.portfolio.invol") + trow<-c(out=object$out, object$weights) + + obj <- unlist(object$objective_measures) + result <- c(obj, trow) + + rnames <- name.replace(names(result)) + names(result) <- rnames + return(result) +} + +#' @method extractStats optimize.portfolio.eqwt +#' @S3method extractStats optimize.portfolio.eqwt +#' @export +extractStats.optimize.portfolio.eqwt <- function(object, prefix=NULL, ...) { + if(!inherits(object, "optimize.portfolio.eqwt")) stop("object must be of class optimize.portfolio.eqwt") + trow<-c(out=object$out, object$weights) + + obj <- unlist(object$objective_measures) + result <- c(obj, trow) + + rnames <- name.replace(names(result)) + names(result) <- rnames + return(result) +} + #' Extract the objective measures #' #' This function will extract the objective measures from the optimal portfolio Modified: pkg/PortfolioAnalytics/R/inverse.volatility.weight.R =================================================================== --- pkg/PortfolioAnalytics/R/inverse.volatility.weight.R 2013-10-17 16:30:37 UTC (rev 3222) +++ pkg/PortfolioAnalytics/R/inverse.volatility.weight.R 2013-10-17 16:48:38 UTC (rev 3223) @@ -37,11 +37,12 @@ weights <- as.vector((1/StdDev(R))/sum(1/StdDev(R))) names(weights) <- names(assets) - out <- constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE, ...)$objective_measures + tmpout <- constrained_objective(w=weights, R=R, portfolio=portfolio, trace=TRUE, ...) return(structure(list( R=R, weights=weights, - objective_measures=out, + out=tmpout$out, + objective_measures=tmpout$objective_measures, call=match.call(), portfolio=portfolio), class=c("optimize.portfolio.invol", "optimize.portfolio")) From noreply at r-forge.r-project.org Thu Oct 17 20:55:01 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 17 Oct 2013 20:55:01 +0200 (CEST) Subject: [Returnanalytics-commits] r3224 - in pkg/PortfolioAnalytics: . man Message-ID: <20131017185501.67A2A185D9B@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-17 20:55:01 +0200 (Thu, 17 Oct 2013) New Revision: 3224 Modified: pkg/PortfolioAnalytics/DESCRIPTION pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/man/chart.Weights.Rd pkg/PortfolioAnalytics/man/plot.Rd Log: minor update to documentation after running roxygenize Modified: pkg/PortfolioAnalytics/DESCRIPTION =================================================================== --- pkg/PortfolioAnalytics/DESCRIPTION 2013-10-17 16:48:38 UTC (rev 3223) +++ pkg/PortfolioAnalytics/DESCRIPTION 2013-10-17 18:55:01 UTC (rev 3224) @@ -60,3 +60,4 @@ 'charts.multiple.R' 'utility.combine.R' 'equal.weight.R' + 'inverse.volatility.weight.R' Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-10-17 16:48:38 UTC (rev 3223) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-10-17 18:55:01 UTC (rev 3224) @@ -30,6 +30,7 @@ export(group_constraint) export(HHI) export(insert_objectives) +export(inverse.volatility.weight) export(is.constraint) export(is.objective) export(is.portfolio) @@ -96,7 +97,9 @@ S3method(extractObjectiveMeasures,opt.list) S3method(extractObjectiveMeasures,optimize.portfolio) S3method(extractStats,optimize.portfolio.DEoptim) +S3method(extractStats,optimize.portfolio.eqwt) S3method(extractStats,optimize.portfolio.GenSA) +S3method(extractStats,optimize.portfolio.invol) S3method(extractStats,optimize.portfolio.parallel) S3method(extractStats,optimize.portfolio.pso) S3method(extractStats,optimize.portfolio.random) Modified: pkg/PortfolioAnalytics/man/chart.Weights.Rd =================================================================== --- pkg/PortfolioAnalytics/man/chart.Weights.Rd 2013-10-17 16:48:38 UTC (rev 3223) +++ pkg/PortfolioAnalytics/man/chart.Weights.Rd 2013-10-17 18:55:01 UTC (rev 3224) @@ -1,4 +1,4 @@ -\name{chart.Weights.optimize.portfolio.DEoptim} +\name{chart.Weights} \alias{chart.Weights} \alias{chart.Weights.opt.list} \alias{chart.Weights.optimize.portfolio.DEoptim} Modified: pkg/PortfolioAnalytics/man/plot.Rd =================================================================== --- pkg/PortfolioAnalytics/man/plot.Rd 2013-10-17 16:48:38 UTC (rev 3223) +++ pkg/PortfolioAnalytics/man/plot.Rd 2013-10-17 18:55:01 UTC (rev 3224) @@ -1,4 +1,4 @@ -\name{plot} +\name{plot.optimize.portfolio} \alias{plot.optimize.portfolio} \alias{plot.optimize.portfolio.DEoptim} \alias{plot.optimize.portfolio.GenSA} From noreply at r-forge.r-project.org Fri Oct 18 01:02:56 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 18 Oct 2013 01:02:56 +0200 (CEST) Subject: [Returnanalytics-commits] r3225 - pkg/PortfolioAnalytics/R Message-ID: <20131017230256.A8D2E185B76@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-18 01:02:56 +0200 (Fri, 18 Oct 2013) New Revision: 3225 Modified: pkg/PortfolioAnalytics/R/optFUN.R Log: Modifying gmv_opt to use solve.QP directly until ROI.plugin.quadprog is stable on CRAN. Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-10-17 18:55:01 UTC (rev 3224) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-10-17 23:02:56 UTC (rev 3225) @@ -13,30 +13,46 @@ #' @param conc_groups list of vectors specifying the groups of the assets. #' @author Ross Bennett gmv_opt <- function(R, constraints, moments, lambda, target, lambda_hhi, conc_groups){ - + stopifnot("package:quadprog" %in% search() || require("quadprog",quietly = TRUE)) + N <- ncol(R) - # Applying box constraints - bnds <- list(lower=list(ind=seq.int(1L, N), val=as.numeric(constraints$min)), - upper=list(ind=seq.int(1L, N), val=as.numeric(constraints$max))) + # Applying box constraints, used for ROI + # bnds <- list(lower=list(ind=seq.int(1L, N), val=as.numeric(constraints$min)), + # upper=list(ind=seq.int(1L, N), val=as.numeric(constraints$max))) - # set up initial A matrix for leverage constraints - Amat <- rbind(rep(1, N), rep(1, N)) - dir.vec <- c(">=","<=") - rhs.vec <- c(constraints$min_sum, constraints$max_sum) - - # check for a target return + # check for a target return constraint if(!is.na(target)) { # If var is the only objective specified, then moments$mean won't be calculated if(all(moments$mean==0)){ tmp_means <- colMeans(R) } else { tmp_means <- moments$mean + target <- 0 } - Amat <- rbind(Amat, tmp_means) - dir.vec <- c(dir.vec, "==") - rhs.vec <- c(rhs.vec, target) + } else { + tmp_means <- moments$mean + target <- 0 } + Amat <- tmp_means + # dir.vec <- "==" + rhs.vec <- target + meq <- 1 + # set up initial A matrix for leverage constraints + Amat <- rbind(Amat, rep(1, N), rep(-1, N)) + # dir.vec <- c(dir.vec, ">=",">=") + rhs.vec <- c(rhs.vec, constraints$min_sum, -constraints$max_sum) + + # Add min box constraints + Amat <- rbind(Amat, diag(N)) + # dir.vec <- c(dir.vec, rep(">=", N)) + rhs.vec <- c(rhs.vec, constraints$min) + + # Add max box constraints + Amat <- rbind(Amat, -1*diag(N)) + # dir.vec <- c(dir.vec, rep(">=", N)) + rhs.vec <- c(rhs.vec, -constraints$max) + # include group constraints if(try(!is.null(constraints$groups), silent=TRUE)){ n.groups <- length(constraints$groups) @@ -47,7 +63,7 @@ if(is.null(constraints$cLO)) cLO <- rep(-Inf, n.groups) if(is.null(constraints$cUP)) cUP <- rep(Inf, n.groups) Amat <- rbind(Amat, Amat.group, -Amat.group) - dir.vec <- c(dir.vec, rep(">=", (n.groups + n.groups))) + # dir.vec <- c(dir.vec, rep(">=", (n.groups + n.groups))) rhs.vec <- c(rhs.vec, constraints$cLO, -constraints$cUP) } @@ -55,14 +71,16 @@ if(!is.null(constraints$B)){ t.B <- t(constraints$B) Amat <- rbind(Amat, t.B, -t.B) - dir.vec <- c(dir.vec, rep(">=", 2 * nrow(t.B))) + # dir.vec <- c(dir.vec, rep(">=", 2 * nrow(t.B))) rhs.vec <- c(rhs.vec, constraints$lower, -constraints$upper) } # set up the quadratic objective if(!is.null(lambda_hhi)){ if(length(lambda_hhi) == 1 & is.null(conc_groups)){ - ROI_objective <- Q_objective(Q=2*lambda*(moments$var + lambda_hhi * diag(N)), L=-moments$mean) + # ROI_objective <- Q_objective(Q=2*lambda*(moments$var + lambda_hhi * diag(N)), L=-moments$mean) # ROI + Dmat <- 2*lambda*(moments$var + lambda_hhi * diag(N)) # solve.QP + dvec <- -moments$mean # solve.QP } else if(!is.null(conc_groups)){ # construct the matrix with concentration aversion values by group hhi_mat <- matrix(0, nrow=N, ncol=N) @@ -76,22 +94,29 @@ } hhi_mat <- hhi_mat + lambda_hhi[i] * tmpI } - ROI_objective <- Q_objective(Q=2*lambda*(moments$var + hhi_mat), L=-moments$mean) + # ROI_objective <- Q_objective(Q=2*lambda*(moments$var + hhi_mat), L=-moments$mean) # ROI + Dmat <- 2 * lambda * (moments$var + hhi_mat) # solve.QP + dvec <- -moments$mean # solve.QP } } else { - ROI_objective <- Q_objective(Q=2*lambda*moments$var, L=-moments$mean) + # ROI_objective <- Q_objective(Q=2*lambda*moments$var, L=-moments$mean) # ROI + Dmat <- 2 * lambda * moments$var # solve.QP + dvec <- -moments$mean # solve.QP } # set up the optimization problem and solve - opt.prob <- OP(objective=ROI_objective, - constraints=L_constraint(L=Amat, dir=dir.vec, rhs=rhs.vec), - bounds=bnds) - roi.result <- ROI_solve(x=opt.prob, solver="quadprog") + # opt.prob <- OP(objective=ROI_objective, + # constraints=L_constraint(L=Amat, dir=dir.vec, rhs=rhs.vec), + # bounds=bnds) + # roi.result <- ROI_solve(x=opt.prob, solver="quadprog") - weights <- roi.result$solution[1:N] + result <- try(solve.QP(Dmat=Dmat, dvec=dvec, Amat=t(Amat), bvec=rhs.vec, meq=meq), silent=TRUE) + + weights <- result$solution[1:N] names(weights) <- colnames(R) out <- list() out$weights <- weights - out$out <- roi.result$objval + out$out <- result$value + # out$out <- result$objval # ROI # out$call <- call # need to get the call outside of the function return(out) } From noreply at r-forge.r-project.org Fri Oct 18 01:04:25 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 18 Oct 2013 01:04:25 +0200 (CEST) Subject: [Returnanalytics-commits] r3226 - in pkg/PortfolioAnalytics: . R man Message-ID: <20131017230425.504F4185B76@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-18 01:04:24 +0200 (Fri, 18 Oct 2013) New Revision: 3226 Added: pkg/PortfolioAnalytics/man/inverse.volatility.weight.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/extractstats.R pkg/PortfolioAnalytics/man/extractStats.Rd Log: Adding extractStats and extractObjectiveMeasures methods for optimize.portfolio.rebalancing objects. Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-10-17 23:02:56 UTC (rev 3225) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-10-17 23:04:24 UTC (rev 3226) @@ -95,6 +95,7 @@ S3method(chart.Weights.EF,efficient.frontier) S3method(chart.Weights.EF,optimize.portfolio) S3method(extractObjectiveMeasures,opt.list) +S3method(extractObjectiveMeasures,optimize.portfolio.rebalancing) S3method(extractObjectiveMeasures,optimize.portfolio) S3method(extractStats,optimize.portfolio.DEoptim) S3method(extractStats,optimize.portfolio.eqwt) @@ -103,6 +104,7 @@ S3method(extractStats,optimize.portfolio.parallel) S3method(extractStats,optimize.portfolio.pso) S3method(extractStats,optimize.portfolio.random) +S3method(extractStats,optimize.portfolio.rebalancing) S3method(extractStats,optimize.portfolio.ROI) S3method(extractWeights,opt.list) S3method(extractWeights,optimize.portfolio.rebalancing) Modified: pkg/PortfolioAnalytics/R/extractstats.R =================================================================== --- pkg/PortfolioAnalytics/R/extractstats.R 2013-10-17 23:02:56 UTC (rev 3225) +++ pkg/PortfolioAnalytics/R/extractstats.R 2013-10-17 23:04:24 UTC (rev 3226) @@ -15,15 +15,32 @@ #' This function will dispatch to the appropriate class handler based on the #' input class of the optimize.portfolio output object. #' +#' For \code{optimize.portfolio} objects: +#' +#' In general, \code{extractStats} will extract the values objective measures +#' and weights at each iteration of a set of weights. This is the case for the +#' DEoptim, random portfolios, and pso solvers that return trace information. +#' Note that \code{trace=TRUE} must be specified in \code{optimize.portfolio} +#' to return the trace information. +#' #' For \code{optimize.portfolio.pso} objects, this function will extract the #' weights (swarm positions) from the PSO output and the out values #' (swarm fitness values) for each iteration of the optimization. #' This function can be slow because we need to run \code{constrained_objective} -#' to calculate the objective measures on the weights. +#' to calculate the objective measures on the transformed weights. #' +#' For \code{optimize.portfolio.rebalancing} objects: +#' +#' The \code{extractStats} function will return a list of the objective measures +#' and weights at each rebalance date for \code{optimize.portfolio.rebalancing} +#' objects. The objective measures and weights of each iteration or permutation +#' will be returned if the optimization was done with DEoptim, random portfolios, +#' or pso. This could potentially result in a very large list object where each +#' list element has thousands of rows of at each rebalance period. +#' #' The output from the GenSA solver does not store weights evaluated at each iteration #' The GenSA output for trace.mat contains nb.steps, temperature, function.value, and current.minimum -#' +#' #' @param object list returned by optimize.portfolio #' @param prefix prefix to add to output row names #' @param ... any other passthru parameters @@ -327,6 +344,14 @@ return(result) } +#' @method extractStats optimize.portfolio.rebalancing +#' @S3method extractStats optimize.portfolio.rebalancing +#' @export +extractStats.optimize.portfolio.rebalancing <- function(object, prefix=NULL, ...) { + if(!inherits(object, "optimize.portfolio.rebalancing")) stop("object must be of class optimize.portfolio.rebalancing") + return(lapply(object, extractStats, ...)) +} + #' Extract the objective measures #' #' This function will extract the objective measures from the optimal portfolio @@ -350,6 +375,26 @@ return(out) } +#' @method extractObjectiveMeasures optimize.portfolio.rebalancing +#' @S3method extractObjectiveMeasures optimize.portfolio.rebalancing +extractObjectiveMeasures.optimize.portfolio.rebalancing <- function(object){ + if(!inherits(object, "optimize.portfolio.rebalancing")) stop("object must be of class 'optimize.portfolio.rebalancing'") + + num.columns <- length(unlist(extractObjectiveMeasures(object[[1]]))) + num.rows <- length(object) + + result <- matrix(nrow=num.rows, ncol=num.columns) + + for(i in 1:num.rows){ + result[i,] <- unlist(extractObjectiveMeasures(object[[i]])) + } + + colnames(result) <- name.replace(names(unlist(extractObjectiveMeasures(object[[1]])))) + rownames(result) <- names(object) + result <- as.xts(result) + return(result) +} + #' Extract the group and/or category weights #' #' This function extracts the weights by group and/or category from an object Modified: pkg/PortfolioAnalytics/man/extractStats.Rd =================================================================== --- pkg/PortfolioAnalytics/man/extractStats.Rd 2013-10-17 23:02:56 UTC (rev 3225) +++ pkg/PortfolioAnalytics/man/extractStats.Rd 2013-10-17 23:04:24 UTC (rev 3226) @@ -23,13 +23,36 @@ optimize.portfolio output object. } \details{ + For \code{optimize.portfolio} objects: + + In general, \code{extractStats} will extract the values + objective measures and weights at each iteration of a set + of weights. This is the case for the DEoptim, random + portfolios, and pso solvers that return trace + information. Note that \code{trace=TRUE} must be + specified in \code{optimize.portfolio} to return the + trace information. + For \code{optimize.portfolio.pso} objects, this function will extract the weights (swarm positions) from the PSO output and the out values (swarm fitness values) for each iteration of the optimization. This function can be slow because we need to run \code{constrained_objective} to - calculate the objective measures on the weights. + calculate the objective measures on the transformed + weights. + For \code{optimize.portfolio.rebalancing} objects: + + The \code{extractStats} function will return a list of + the objective measures and weights at each rebalance date + for \code{optimize.portfolio.rebalancing} objects. The + objective measures and weights of each iteration or + permutation will be returned if the optimization was done + with DEoptim, random portfolios, or pso. This could + potentially result in a very large list object where each + list element has thousands of rows of at each rebalance + period. + The output from the GenSA solver does not store weights evaluated at each iteration The GenSA output for trace.mat contains nb.steps, temperature, function.value, Added: pkg/PortfolioAnalytics/man/inverse.volatility.weight.Rd =================================================================== --- pkg/PortfolioAnalytics/man/inverse.volatility.weight.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/inverse.volatility.weight.Rd 2013-10-17 23:04:24 UTC (rev 3226) @@ -0,0 +1,35 @@ +\name{inverse.volatility.weight} +\alias{inverse.volatility.weight} +\title{Create an inverse volatility weighted portfolio} +\usage{ + inverse.volatility.weight(R, portfolio, ...) +} +\arguments{ + \item{R}{an xts, vector, matrix, data frame, timeSeries + or zoo object of asset returns} + + \item{portfolio}{an object of type "portfolio" specifying + the constraints and objectives for the optimization} + + \item{\dots}{any other passthru parameters to + \code{constrained_objective}} +} +\value{ + a list containing the returns, weights, objective + measures, call, and portfolio object +} +\description{ + This function calculates objective measures for an equal + weight portfolio. +} +\details{ + This function is simply a wrapper around + \code{\link{constrained_objective}} to calculate the + objective measures in the given \code{portfolio} object + of an inverse volatility weight portfolio. The portfolio + object should include all objectives to be calculated. +} +\author{ + Peter Carl +} + From noreply at r-forge.r-project.org Fri Oct 18 01:25:33 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 18 Oct 2013 01:25:33 +0200 (CEST) Subject: [Returnanalytics-commits] r3227 - pkg/PortfolioAnalytics/R Message-ID: <20131017232533.49A30184289@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-18 01:25:32 +0200 (Fri, 18 Oct 2013) New Revision: 3227 Modified: pkg/PortfolioAnalytics/R/optFUN.R Log: Adding require(package) for all optFun functions. Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-10-17 23:04:24 UTC (rev 3226) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-10-17 23:25:32 UTC (rev 3227) @@ -14,6 +14,8 @@ #' @author Ross Bennett gmv_opt <- function(R, constraints, moments, lambda, target, lambda_hhi, conc_groups){ stopifnot("package:quadprog" %in% search() || require("quadprog",quietly = TRUE)) + # stopifnot("package:ROI" %in% search() || require("ROI",quietly = TRUE)) + # stopifnot("package:ROI.plugin.quadprog" %in% search() || require("ROI.plugin.quadprog",quietly = TRUE)) N <- ncol(R) # Applying box constraints, used for ROI @@ -132,6 +134,8 @@ #' @param target target return value #' @author Ross Bennett maxret_opt <- function(R, moments, constraints, target){ + stopifnot("package:ROI" %in% search() || require("ROI",quietly = TRUE)) + stopifnot("package:ROI.plugin.glpk" %in% search() || require("ROI.plugin.glpk",quietly = TRUE)) N <- ncol(R) # Applying box constraints @@ -212,6 +216,7 @@ #' @param target target return value #' @author Ross Bennett maxret_milp_opt <- function(R, constraints, moments, target){ + stopifnot("package:Rglpk" %in% search() || require("Rglpk",quietly = TRUE)) N <- ncol(R) @@ -280,7 +285,6 @@ types <- c(rep("C", N), rep("B", N)) # Solve directly with Rglpk... getting weird errors with ROI - stopifnot("package:Rglpk" %in% search() || require("Rglpk",quietly = TRUE)) result <- Rglpk_solve_LP(obj=objL, mat=Amat, dir=dir, rhs=rhs, types=types, bounds=bnds, max=FALSE) # The Rglpk solvers status returns an an integer with status information @@ -312,6 +316,8 @@ #' @param alpha alpha value for ETL/ES/CVaR #' @author Ross Bennett etl_opt <- function(R, constraints, moments, target, alpha){ + stopifnot("package:ROI" %in% search() || require("ROI",quietly = TRUE)) + stopifnot("package:ROI.plugin.glpk" %in% search() || require("ROI.plugin.glpk",quietly = TRUE)) # Check for cleaned returns in moments if(!is.null(moments$cleanR)) R <- moments$cleanR @@ -377,6 +383,8 @@ #' @author Ross Bennett etl_milp_opt <- function(R, constraints, moments, target, alpha){ + stopifnot("package:Rglpk" %in% search() || require("Rglpk",quietly = TRUE)) + # Check for cleaned returns in moments if(!is.null(moments$cleanR)) R <- moments$cleanR @@ -473,7 +481,7 @@ bounds <- list( lower = list( ind = 1L:(m + n + 2 + m), val = c(LB, -1, rep(0, n), 1, rep(0, m)) ), upper = list( ind = 1L:(m + n + 2 + m), val = c( UB, 1, rep(Inf, n), 1 , rep(1, m)) ) ) - stopifnot("package:Rglpk" %in% search() || require("Rglpk",quietly = TRUE)) + result <- Rglpk_solve_LP(obj=objL, mat=tmpAmat, dir=dir, rhs=rhs, types=types, bounds=bounds) # The Rglpk solvers status returns an an integer with status information # about the solution returned: 0 if the optimal solution was found, a @@ -506,6 +514,8 @@ #' @author Ross Bennett gmv_opt_toc <- function(R, constraints, moments, lambda, target, init_weights){ # function for minimum variance or max quadratic utility problems + stopifnot("package:corpcor" %in% search() || require("corpcor",quietly = TRUE)) + stopifnot("package:quadprog" %in% search() || require("quadprog",quietly = TRUE)) # Check for cleaned returns in moments if(!is.null(moments$cleanR)) R <- moments$cleanR @@ -604,8 +614,7 @@ d <- rep(-moments$mean, 3) # print(Amat) - stopifnot("package:corpcor" %in% search() || require("corpcor",quietly = TRUE)) - stopifnot("package:quadprog" %in% search() || require("quadprog",quietly = TRUE)) + qp.result <- try(solve.QP(Dmat=make.positive.definite(2*lambda*V), dvec=d, Amat=t(Amat), bvec=rhs, meq=meq), silent=TRUE) if(inherits(qp.result, "try-error")) stop("No solution found, consider adjusting constraints.") @@ -639,6 +648,8 @@ gmv_opt_ptc <- function(R, constraints, moments, lambda, target, init_weights){ # function for minimum variance or max quadratic utility problems # modifying ProportionalCostOpt function from MPO package + stopifnot("package:corpcor" %in% search() || require("corpcor",quietly = TRUE)) + stopifnot("package:quadprog" %in% search() || require("quadprog",quietly = TRUE)) # Check for cleaned returns in moments if(!is.null(moments$cleanR)) R <- moments$cleanR @@ -723,8 +734,6 @@ d <- rep(-moments$mean, 3) - stopifnot("package:corpcor" %in% search() || require("corpcor",quietly = TRUE)) - stopifnot("package:quadprog" %in% search() || require("quadprog",quietly = TRUE)) qp.result <- try(solve.QP(Dmat=make.positive.definite(2*lambda*V), dvec=d, Amat=t(Amat), bvec=rhs, meq=meq), silent=TRUE) if(inherits(qp.result, "try-error")) stop("No solution found, consider adjusting constraints.") From noreply at r-forge.r-project.org Fri Oct 18 03:04:32 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 18 Oct 2013 03:04:32 +0200 (CEST) Subject: [Returnanalytics-commits] r3228 - in pkg/PortfolioAnalytics: . R man Message-ID: <20131018010433.5040318090B@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-18 03:04:30 +0200 (Fri, 18 Oct 2013) New Revision: 3228 Removed: pkg/PortfolioAnalytics/man/chart.Weights.Rd Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/chart.RiskReward.R pkg/PortfolioAnalytics/R/chart.Weights.R pkg/PortfolioAnalytics/R/charts.DE.R pkg/PortfolioAnalytics/R/charts.GenSA.R pkg/PortfolioAnalytics/R/charts.PSO.R pkg/PortfolioAnalytics/R/charts.ROI.R pkg/PortfolioAnalytics/R/charts.RP.R Log: Adding chart.Weights method for optimize.portfolio.rebalancing objects. Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-10-17 23:25:32 UTC (rev 3227) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-10-18 01:04:30 UTC (rev 3228) @@ -91,6 +91,7 @@ S3method(chart.Weights,optimize.portfolio.GenSA) S3method(chart.Weights,optimize.portfolio.pso) S3method(chart.Weights,optimize.portfolio.random) +S3method(chart.Weights,optimize.portfolio.rebalancing) S3method(chart.Weights,optimize.portfolio.ROI) S3method(chart.Weights.EF,efficient.frontier) S3method(chart.Weights.EF,optimize.portfolio) Modified: pkg/PortfolioAnalytics/R/chart.RiskReward.R =================================================================== --- pkg/PortfolioAnalytics/R/chart.RiskReward.R 2013-10-17 23:25:32 UTC (rev 3227) +++ pkg/PortfolioAnalytics/R/chart.RiskReward.R 2013-10-18 01:04:30 UTC (rev 3228) @@ -32,8 +32,6 @@ #' @param cex.lab numerical value giving the amount by which the labels should be magnified relative to the default. #' @param colorset color palette or vector of colors to use. #' @seealso \code{\link{optimize.portfolio}} -#' @rdname chart.RiskReward -#' @name chart.RiskReward #' @export chart.RiskReward <- function(object, ...){ UseMethod("chart.RiskReward") Modified: pkg/PortfolioAnalytics/R/chart.Weights.R =================================================================== --- pkg/PortfolioAnalytics/R/chart.Weights.R 2013-10-17 23:25:32 UTC (rev 3227) +++ pkg/PortfolioAnalytics/R/chart.Weights.R 2013-10-18 01:04:30 UTC (rev 3228) @@ -1,7 +1,12 @@ #' boxplot of the weights of the optimal portfolios #' -#' Chart the optimal weights and upper and lower bounds on weights of a portfolio run via \code{\link{optimize.portfolio}}. +#' This function charts the optimal weights of a portfolio run via +#' \code{\link{optimize.portfolio}} or \code{\link{optimize.portfolio.rebalancing}}. +#' The upper and lower bounds on weights can be plotted for single period optimizations. +#' The optimal weights will be charted through time for \code{optimize.portfolio.rebalancing} +#' objects. For \code{optimize.portfolio.rebalancing} objects, the weights are +#' plotted with \code{\link[PerformanceAnalytics]{chart.StackedBar}}. #' #' @param object optimal portfolio object created by \code{\link{optimize.portfolio}}. #' @param neighbors set of 'neighbor' portfolios to overplot. See Details. @@ -22,12 +27,10 @@ #' @param legend.loc location of the legend. If NULL, the legend will not be plotted. #' @param cex.legend The magnification to be used for legend annotation relative to the current setting of \code{cex}. #' @param plot.type "line" or "barplot" to plot. -#' @seealso \code{\link{optimize.portfolio}} -#' @rdname chart.Weights +#' @seealso \code{\link{optimize.portfolio}} \code{\link{optimize.portfolio.rebalancing}} \code{\link[PerformanceAnalytics]{chart.StackedBar}} #' @name chart.Weights -#' @aliases chart.Weights.optimize.portfolio.ROI chart.Weights.optimize.portfolio.DEoptim chart.Weights.optimize.portfolio.pso chart.Weights.optimize.portfolio.GenSA #' @export -chart.Weights <- function(object, neighbors = NULL, ..., main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8){ +chart.Weights <- function(object, ...){ UseMethod("chart.Weights") } @@ -91,3 +94,11 @@ } box(col=element.color) } + +#' @rdname chart.Weights +#' @method chart.Weights optimize.portfolio.rebalancing +#' @S3method chart.Weights optimize.portfolio.rebalancing +chart.Weights.optimize.portfolio.rebalancing <- function(object, ..., main="Weights"){ + rebal.weights <- extractWeights(object) + chart.StackedBar(w=rebal.weights, main=main, ...) +} Modified: pkg/PortfolioAnalytics/R/charts.DE.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.DE.R 2013-10-17 23:25:32 UTC (rev 3227) +++ pkg/PortfolioAnalytics/R/charts.DE.R 2013-10-18 01:04:30 UTC (rev 3228) @@ -11,7 +11,7 @@ ############################################################################### -chart.Weights.DE <- function(object, neighbors = NULL, ..., main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8, colorset=NULL, legend.loc="topright", cex.legend=0.8, plot.type="line"){ +chart.Weights.DE <- function(object, ..., neighbors = NULL, main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8, colorset=NULL, legend.loc="topright", cex.legend=0.8, plot.type="line"){ # Specific to the output of optimize.portfolio with optimize_method="DEoptim" if(!inherits(object, "optimize.portfolio.DEoptim")) stop("object must be of class 'optimize.portfolio.DEoptim'") Modified: pkg/PortfolioAnalytics/R/charts.GenSA.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.GenSA.R 2013-10-17 23:25:32 UTC (rev 3227) +++ pkg/PortfolioAnalytics/R/charts.GenSA.R 2013-10-18 01:04:30 UTC (rev 3228) @@ -1,5 +1,5 @@ -chart.Weights.GenSA <- function(object, neighbors = NULL, ..., main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8, colorset=NULL, legend.loc="topright", cex.legend=0.8, plot.type="line"){ +chart.Weights.GenSA <- function(object, ..., neighbors = NULL, main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8, colorset=NULL, legend.loc="topright", cex.legend=0.8, plot.type="line"){ if(!inherits(object, "optimize.portfolio.GenSA")) stop("object must be of class 'optimize.portfolio.GenSA'") Modified: pkg/PortfolioAnalytics/R/charts.PSO.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.PSO.R 2013-10-17 23:25:32 UTC (rev 3227) +++ pkg/PortfolioAnalytics/R/charts.PSO.R 2013-10-18 01:04:30 UTC (rev 3228) @@ -1,5 +1,5 @@ -chart.Weights.pso <- function(object, neighbors = NULL, ..., main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8, colorset=NULL, legend.loc="topright", cex.legend=0.8, plot.type="line"){ +chart.Weights.pso <- function(object, ..., neighbors = NULL, main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8, colorset=NULL, legend.loc="topright", cex.legend=0.8, plot.type="line"){ if(!inherits(object, "optimize.portfolio.pso")) stop("object must be of class 'optimize.portfolio.pso'") Modified: pkg/PortfolioAnalytics/R/charts.ROI.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.ROI.R 2013-10-17 23:25:32 UTC (rev 3227) +++ pkg/PortfolioAnalytics/R/charts.ROI.R 2013-10-18 01:04:30 UTC (rev 3228) @@ -1,5 +1,5 @@ -chart.Weights.ROI <- function(object, neighbors = NULL, ..., main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8, colorset=NULL, legend.loc="topright", cex.legend=0.8, plot.type="line"){ +chart.Weights.ROI <- function(object, ..., neighbors = NULL, main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8, colorset=NULL, legend.loc="topright", cex.legend=0.8, plot.type="line"){ if(!inherits(object, "optimize.portfolio.ROI")) stop("object must be of class 'optimize.portfolio.ROI'") Modified: pkg/PortfolioAnalytics/R/charts.RP.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.RP.R 2013-10-17 23:25:32 UTC (rev 3227) +++ pkg/PortfolioAnalytics/R/charts.RP.R 2013-10-18 01:04:30 UTC (rev 3228) @@ -10,7 +10,7 @@ # ############################################################################### -chart.Weights.RP <- function(object, neighbors = NULL, ..., main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8, colorset=NULL, legend.loc="topright", cex.legend=0.8, plot.type="line"){ +chart.Weights.RP <- function(object, ..., neighbors = NULL, main="Weights", las = 3, xlab=NULL, cex.lab = 1, element.color = "darkgray", cex.axis=0.8, colorset=NULL, legend.loc="topright", cex.legend=0.8, plot.type="line"){ # Specific to the output of the random portfolio code with constraints if(!inherits(object, "optimize.portfolio.random")){ stop("object must be of class 'optimize.portfolio.random'") Deleted: pkg/PortfolioAnalytics/man/chart.Weights.Rd =================================================================== --- pkg/PortfolioAnalytics/man/chart.Weights.Rd 2013-10-17 23:25:32 UTC (rev 3227) +++ pkg/PortfolioAnalytics/man/chart.Weights.Rd 2013-10-18 01:04:30 UTC (rev 3228) @@ -1,107 +0,0 @@ -\name{chart.Weights} -\alias{chart.Weights} -\alias{chart.Weights.opt.list} -\alias{chart.Weights.optimize.portfolio.DEoptim} -\alias{chart.Weights.optimize.portfolio.GenSA} -\alias{chart.Weights.optimize.portfolio.pso} -\alias{chart.Weights.optimize.portfolio.random} -\alias{chart.Weights.optimize.portfolio.ROI} -\title{boxplot of the weights of the optimal portfolios} -\usage{ - \method{chart.Weights}{optimize.portfolio.DEoptim} (object, neighbors = NULL, ..., main = "Weights", - las = 3, xlab = NULL, cex.lab = 1, - element.color = "darkgray", cex.axis = 0.8, - colorset = NULL, legend.loc = "topright", - cex.legend = 0.8, plot.type = "line") - - \method{chart.Weights}{optimize.portfolio.random} (object, neighbors = NULL, ..., main = "Weights", - las = 3, xlab = NULL, cex.lab = 1, - element.color = "darkgray", cex.axis = 0.8, - colorset = NULL, legend.loc = "topright", - cex.legend = 0.8, plot.type = "line") - - \method{chart.Weights}{optimize.portfolio.ROI} (object, - neighbors = NULL, ..., main = "Weights", las = 3, - xlab = NULL, cex.lab = 1, element.color = "darkgray", - cex.axis = 0.8, colorset = NULL, - legend.loc = "topright", cex.legend = 0.8, - plot.type = "line") - - \method{chart.Weights}{optimize.portfolio.pso} (object, - neighbors = NULL, ..., main = "Weights", las = 3, - xlab = NULL, cex.lab = 1, element.color = "darkgray", - cex.axis = 0.8, colorset = NULL, - legend.loc = "topright", cex.legend = 0.8, - plot.type = "line") - - \method{chart.Weights}{optimize.portfolio.GenSA} (object, - neighbors = NULL, ..., main = "Weights", las = 3, - xlab = NULL, cex.lab = 1, element.color = "darkgray", - cex.axis = 0.8, colorset = NULL, - legend.loc = "topright", cex.legend = 0.8, - plot.type = "line") - - chart.Weights(object, neighbors = NULL, ..., - main = "Weights", las = 3, xlab = NULL, cex.lab = 1, - element.color = "darkgray", cex.axis = 0.8) - - \method{chart.Weights}{opt.list} (object, - neighbors = NULL, ..., main = "Weights", las = 3, - xlab = NULL, cex.lab = 1, element.color = "darkgray", - cex.axis = 0.8, colorset = NULL, - legend.loc = "topright", cex.legend = 0.8, - plot.type = "line") -} -\arguments{ - \item{object}{optimal portfolio object created by - \code{\link{optimize.portfolio}}.} - - \item{neighbors}{set of 'neighbor' portfolios to - overplot. See Details.} - - \item{\dots}{any other passthru parameters .} - - \item{main}{an overall title for the plot: see - \code{\link{title}}} - - \item{las}{numeric in \{0,1,2,3\}; the style of axis - labels \describe{ \item{0:}{always parallel to the axis,} - \item{1:}{always horizontal,} \item{2:}{always - perpendicular to the axis,} \item{3:}{always vertical - [\emph{default}].} }} - - \item{xlab}{a title for the x axis: see - \code{\link{title}}} - - \item{cex.lab}{The magnification to be used for x and y - labels relative to the current setting of \code{cex}} - - \item{element.color}{provides the color for drawing - less-important chart elements, such as the box lines, - axis lines, etc.} - - \item{cex.axis}{The magnification to be used for axis - annotation relative to the current setting of - \code{cex}.} - - \item{colorset}{color palette or vector of colors to - use.} - - \item{legend.loc}{location of the legend. If NULL, the - legend will not be plotted.} - - \item{cex.legend}{The magnification to be used for legend - annotation relative to the current setting of - \code{cex}.} - - \item{plot.type}{"line" or "barplot" to plot.} -} -\description{ - Chart the optimal weights and upper and lower bounds on - weights of a portfolio run via - \code{\link{optimize.portfolio}}. -} -\seealso{ - \code{\link{optimize.portfolio}} -} - From noreply at r-forge.r-project.org Fri Oct 18 03:11:41 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 18 Oct 2013 03:11:41 +0200 (CEST) Subject: [Returnanalytics-commits] r3229 - in pkg/PortfolioAnalytics: . R man Message-ID: <20131018011141.C5C561852A7@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-18 03:11:40 +0200 (Fri, 18 Oct 2013) New Revision: 3229 Modified: pkg/PortfolioAnalytics/NAMESPACE pkg/PortfolioAnalytics/R/charts.risk.R pkg/PortfolioAnalytics/man/chart.RiskBudget.Rd Log: Adding chart.RiskBudget method for optimize.portfolio.rebalancing objects. Modified: pkg/PortfolioAnalytics/NAMESPACE =================================================================== --- pkg/PortfolioAnalytics/NAMESPACE 2013-10-18 01:04:30 UTC (rev 3228) +++ pkg/PortfolioAnalytics/NAMESPACE 2013-10-18 01:11:40 UTC (rev 3229) @@ -79,6 +79,7 @@ S3method(chart.EfficientFrontier,optimize.portfolio.ROI) S3method(chart.EfficientFrontier,optimize.portfolio) S3method(chart.RiskBudget,opt.list) +S3method(chart.RiskBudget,optimize.portfolio.rebalancing) S3method(chart.RiskBudget,optimize.portfolio) S3method(chart.RiskReward,opt.list) S3method(chart.RiskReward,optimize.portfolio.DEoptim) Modified: pkg/PortfolioAnalytics/R/charts.risk.R =================================================================== --- pkg/PortfolioAnalytics/R/charts.risk.R 2013-10-18 01:04:30 UTC (rev 3228) +++ pkg/PortfolioAnalytics/R/charts.risk.R 2013-10-18 01:11:40 UTC (rev 3229) @@ -2,9 +2,11 @@ #' Generic method to chart risk contribution #' #' This function is the generic method to chart risk budget objectives for -#' \code{optimize.portfolio} and \code{opt.list} objects. This function charts -#' the contribution or percent contribution of the resulting objective measures -#' of a \code{risk_budget_objective}. +#' \code{optimize.portfolio}, \code{optimize.portfolio.rebalancing}, and +#' \code{opt.list} objects. This function charts the contribution or percent +#' contribution of the resulting objective measures of a +#' \code{risk_budget_objective}. The risk contributions for \code{optimize.portfolio.rebalancing} +#' objects are plotted through time with \code{\link[PerformanceAnalytics]{chart.StackedBar}}. #' #' @details #' \code{neighbors} may be specified in three ways. @@ -43,6 +45,7 @@ #' @param colorset color palette or vector of colors to use #' @param legend.loc legend.loc NULL, "topright", "right", or "bottomright". If legend.loc is NULL, the legend will not be plotted #' @param cex.legend The magnification to be used for the legend relative to the current setting of \code{cex} +#' @seealso \code{\link{optimize.portfolio}} \code{\link{optimize.portfolio.rebalancing}} \code{\link[PerformanceAnalytics]{chart.StackedBar}} #' @export chart.RiskBudget <- function(object, ...){ UseMethod("chart.RiskBudget") @@ -206,7 +209,30 @@ } # end plot for pct_contrib risk.type } +#' @rdname chart.RiskBudget +#' @method chart.RiskBudget optimize.portfolio.rebalancing +#' @S3method chart.RiskBudget optimize.portfolio.rebalancing +chart.RiskBudget.optimize.portfolio.rebalancing <- function(object, ..., match.col="ES", risk.type="absolute", main="Risk Contribution"){ + + # Get the objective measures at each rebalance period + rebal.obj <- extractObjectiveMeasures(object) + + if(risk.type == "absolute"){ + rbcols <- grep(paste(match.col, "pct_contrib", sep="."), colnames(rebal.obj)) + if(length(rbcols) < 1) stop(paste("No ", match.col, ".contribution columns.", sep="")) + rbdata <- rebal.obj[, rbcols] + chart.StackedBar(w=rbdata, ylab=paste(match.col, "Contribution", sep=" "), main=main, ...) + } + + if(risk.type %in% c("percent", "percentage", "pct_contrib")){ + rbcols <- grep(paste(match.col, "pct_contrib", sep="."), colnames(rebal.obj)) + if(length(rbcols) < 1) stop(paste("No ", match.col, ".pct_contrib columns.", sep="")) + rbdata <- rebal.obj[, rbcols] + chart.StackedBar(w=rbdata, ylab=paste(match.col, "% Contribution", sep=" "), main=main, ...) + } +} + #' @rdname chart.RiskBudget #' @method chart.RiskBudget opt.list #' @S3method chart.RiskBudget opt.list Modified: pkg/PortfolioAnalytics/man/chart.RiskBudget.Rd =================================================================== --- pkg/PortfolioAnalytics/man/chart.RiskBudget.Rd 2013-10-18 01:04:30 UTC (rev 3228) +++ pkg/PortfolioAnalytics/man/chart.RiskBudget.Rd 2013-10-18 01:11:40 UTC (rev 3229) @@ -2,6 +2,7 @@ \alias{chart.RiskBudget} \alias{chart.RiskBudget.opt.list} \alias{chart.RiskBudget.optimize.portfolio} +\alias{chart.RiskBudget.optimize.portfolio.rebalancing} \title{Generic method to chart risk contribution} \usage{ chart.RiskBudget(object, ...) @@ -12,6 +13,10 @@ cex.axis = 0.8, cex.lab = 0.8, element.color = "darkgray", las = 3, ylim = NULL) + \method{chart.RiskBudget}{optimize.portfolio.rebalancing} + (object, ..., match.col = "ES", risk.type = "absolute", + main = "Risk Contribution") + \method{chart.RiskBudget}{opt.list} (object, ..., match.col = "ES", risk.type = "absolute", main = "Risk Budget", plot.type = "line", @@ -78,10 +83,15 @@ } \description{ This function is the generic method to chart risk budget - objectives for \code{optimize.portfolio} and + objectives for \code{optimize.portfolio}, + \code{optimize.portfolio.rebalancing}, and \code{opt.list} objects. This function charts the contribution or percent contribution of the resulting - objective measures of a \code{risk_budget_objective}. + objective measures of a \code{risk_budget_objective}. The + risk contributions for + \code{optimize.portfolio.rebalancing} objects are plotted + through time with + \code{\link[PerformanceAnalytics]{chart.StackedBar}}. } \details{ \code{neighbors} may be specified in three ways. The @@ -96,4 +106,9 @@ \code{\link{extractStats}}, and should contain properly named contribution and pct_contrib columns. } +\seealso{ + \code{\link{optimize.portfolio}} + \code{\link{optimize.portfolio.rebalancing}} + \code{\link[PerformanceAnalytics]{chart.StackedBar}} +} From noreply at r-forge.r-project.org Fri Oct 18 03:21:05 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 18 Oct 2013 03:21:05 +0200 (CEST) Subject: [Returnanalytics-commits] r3230 - pkg/PortfolioAnalytics/man Message-ID: <20131018012105.A59101859B9@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-18 03:21:05 +0200 (Fri, 18 Oct 2013) New Revision: 3230 Added: pkg/PortfolioAnalytics/man/chart.Weights.Rd Modified: pkg/PortfolioAnalytics/man/chart.RiskBudget.Rd Log: Cleaning up some documentation entries. Modified: pkg/PortfolioAnalytics/man/chart.RiskBudget.Rd =================================================================== --- pkg/PortfolioAnalytics/man/chart.RiskBudget.Rd 2013-10-18 01:11:40 UTC (rev 3229) +++ pkg/PortfolioAnalytics/man/chart.RiskBudget.Rd 2013-10-18 01:21:05 UTC (rev 3230) @@ -13,8 +13,7 @@ cex.axis = 0.8, cex.lab = 0.8, element.color = "darkgray", las = 3, ylim = NULL) - \method{chart.RiskBudget}{optimize.portfolio.rebalancing} - (object, ..., match.col = "ES", risk.type = "absolute", + \method{chart.RiskBudget}{optimize.portfolio.rebalancing} (object, ..., match.col = "ES", risk.type = "absolute", main = "Risk Contribution") \method{chart.RiskBudget}{opt.list} (object, ..., Added: pkg/PortfolioAnalytics/man/chart.Weights.Rd =================================================================== --- pkg/PortfolioAnalytics/man/chart.Weights.Rd (rev 0) +++ pkg/PortfolioAnalytics/man/chart.Weights.Rd 2013-10-18 01:21:05 UTC (rev 3230) @@ -0,0 +1,116 @@ +\name{chart.Weights} +\alias{chart.Weights} +\alias{chart.Weights.opt.list} +\alias{chart.Weights.optimize.portfolio.DEoptim} +\alias{chart.Weights.optimize.portfolio.GenSA} +\alias{chart.Weights.optimize.portfolio.pso} +\alias{chart.Weights.optimize.portfolio.random} +\alias{chart.Weights.optimize.portfolio.rebalancing} +\alias{chart.Weights.optimize.portfolio.ROI} +\title{boxplot of the weights of the optimal portfolios} +\usage{ + \method{chart.Weights}{optimize.portfolio.DEoptim} (object, ..., neighbors = NULL, main = "Weights", + las = 3, xlab = NULL, cex.lab = 1, + element.color = "darkgray", cex.axis = 0.8, + colorset = NULL, legend.loc = "topright", + cex.legend = 0.8, plot.type = "line") + + \method{chart.Weights}{optimize.portfolio.random} (object, ..., neighbors = NULL, main = "Weights", + las = 3, xlab = NULL, cex.lab = 1, + element.color = "darkgray", cex.axis = 0.8, + colorset = NULL, legend.loc = "topright", + cex.legend = 0.8, plot.type = "line") + + \method{chart.Weights}{optimize.portfolio.ROI} (object, + ..., neighbors = NULL, main = "Weights", las = 3, + xlab = NULL, cex.lab = 1, element.color = "darkgray", + cex.axis = 0.8, colorset = NULL, + legend.loc = "topright", cex.legend = 0.8, + plot.type = "line") + + \method{chart.Weights}{optimize.portfolio.pso} (object, + ..., neighbors = NULL, main = "Weights", las = 3, + xlab = NULL, cex.lab = 1, element.color = "darkgray", + cex.axis = 0.8, colorset = NULL, + legend.loc = "topright", cex.legend = 0.8, + plot.type = "line") + + \method{chart.Weights}{optimize.portfolio.GenSA} (object, + ..., neighbors = NULL, main = "Weights", las = 3, + xlab = NULL, cex.lab = 1, element.color = "darkgray", + cex.axis = 0.8, colorset = NULL, + legend.loc = "topright", cex.legend = 0.8, + plot.type = "line") + + chart.Weights(object, ...) + + \method{chart.Weights}{optimize.portfolio.rebalancing} (object, ..., main = "Weights") + + \method{chart.Weights}{opt.list} (object, + neighbors = NULL, ..., main = "Weights", las = 3, + xlab = NULL, cex.lab = 1, element.color = "darkgray", + cex.axis = 0.8, colorset = NULL, + legend.loc = "topright", cex.legend = 0.8, + plot.type = "line") +} +\arguments{ + \item{object}{optimal portfolio object created by + \code{\link{optimize.portfolio}}.} + + \item{neighbors}{set of 'neighbor' portfolios to + overplot. See Details.} + + \item{\dots}{any other passthru parameters .} + + \item{main}{an overall title for the plot: see + \code{\link{title}}} + + \item{las}{numeric in \{0,1,2,3\}; the style of axis + labels \describe{ \item{0:}{always parallel to the axis,} + \item{1:}{always horizontal,} \item{2:}{always + perpendicular to the axis,} \item{3:}{always vertical + [\emph{default}].} }} + + \item{xlab}{a title for the x axis: see + \code{\link{title}}} + + \item{cex.lab}{The magnification to be used for x and y + labels relative to the current setting of \code{cex}} + + \item{element.color}{provides the color for drawing + less-important chart elements, such as the box lines, + axis lines, etc.} + + \item{cex.axis}{The magnification to be used for axis + annotation relative to the current setting of + \code{cex}.} + + \item{colorset}{color palette or vector of colors to + use.} + + \item{legend.loc}{location of the legend. If NULL, the + legend will not be plotted.} + + \item{cex.legend}{The magnification to be used for legend + annotation relative to the current setting of + \code{cex}.} + + \item{plot.type}{"line" or "barplot" to plot.} +} +\description{ + This function charts the optimal weights of a portfolio + run via \code{\link{optimize.portfolio}} or + \code{\link{optimize.portfolio.rebalancing}}. The upper + and lower bounds on weights can be plotted for single + period optimizations. The optimal weights will be charted + through time for \code{optimize.portfolio.rebalancing} + objects. For \code{optimize.portfolio.rebalancing} + objects, the weights are plotted with + \code{\link[PerformanceAnalytics]{chart.StackedBar}}. +} +\seealso{ + \code{\link{optimize.portfolio}} + \code{\link{optimize.portfolio.rebalancing}} + \code{\link[PerformanceAnalytics]{chart.StackedBar}} +} + From noreply at r-forge.r-project.org Fri Oct 18 03:36:36 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 18 Oct 2013 03:36:36 +0200 (CEST) Subject: [Returnanalytics-commits] r3231 - in pkg/PortfolioAnalytics: R man Message-ID: <20131018013636.D5EF51861A6@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-18 03:36:36 +0200 (Fri, 18 Oct 2013) New Revision: 3231 Modified: pkg/PortfolioAnalytics/R/generics.R pkg/PortfolioAnalytics/man/print.constraint.Rd pkg/PortfolioAnalytics/man/print.efficient.frontier.Rd pkg/PortfolioAnalytics/man/print.optimize.portfolio.Rd pkg/PortfolioAnalytics/man/print.portfolio.Rd pkg/PortfolioAnalytics/man/print.summary.optimize.portfolio.Rd pkg/PortfolioAnalytics/man/summary.optimize.portfolio.Rd pkg/PortfolioAnalytics/man/summary.portfolio.Rd Log: Cleaning up documentation for generics. Modified: pkg/PortfolioAnalytics/R/generics.R =================================================================== --- pkg/PortfolioAnalytics/R/generics.R 2013-10-18 01:21:05 UTC (rev 3230) +++ pkg/PortfolioAnalytics/R/generics.R 2013-10-18 01:36:36 UTC (rev 3231) @@ -47,6 +47,7 @@ #' #' @param x an object of class \code{portfolio} #' @param \dots any other passthru parameters +#' @seealso \code{\link{portfolio.spec}} #' @author Ross Bennett #' @method print portfolio #' @S3method print portfolio @@ -189,8 +190,9 @@ #' #' summary method for class \code{portfolio} created with \code{\link{portfolio.spec}} #' -#' @param object object of class portfolio +#' @param object an object of class \code{portfolio} #' @param \dots any other passthru parameters +#' @seealso \code{\link{portfolio.spec}} #' @author Ross Bennett #' @method summary portfolio #' @export @@ -238,9 +240,9 @@ } } -#' print method for objects of class 'constraint' +#' print method for constraint objects #' -#' @param x object of class constraint +#' @param x object of class \code{constraint} #' @param \dots any other passthru parameters #' @author Ross Bennett #' @method print constraint @@ -251,11 +253,12 @@ #' Printing output of optimize.portfolio #' -#' print method for optimize.portfolio objects +#' print method for \code{optimize.portfolio} objects #' #' @param x an object used to select a method #' @param \dots any other passthru parameters #' @param digits the number of significant digits to use when printing. +#' @seealso \code{\link{optimize.portfolio}} #' @author Ross Bennett #' @rdname print.optimize.portfolio #' @method print optimize.portfolio.ROI @@ -461,12 +464,13 @@ cat("\n") } -#' Summarizing Output of optimize.portfolio +#' Printing summary output of optimize.portfolio #' -#' summary method for class "optimize.portfolio" +#' print method for objects of class \code{summary.optimize.portfolio} #' -#' @param object an object of class "optimize.portfolio.pso" resulting from a call to optimize.portfolio +#' @param x an object of class \code{summary.optimize.portfolio}. #' @param ... any other passthru parameters. Currently not used. +#' @seealso \code{\link{summary.optimize.portfolio}} #' @author Ross Bennett #' @method print summary.optimize.portfolio #' @S3method print summary.optimize.portfolio @@ -664,10 +668,11 @@ #' Summarizing output of optimize.portfolio #' -#' summary method for class "optimize.portfolio" +#' summary method for class \code{optimize.portfolio} #' -#' @param object an object of class "optimize.portfolio.pso" resulting from a call to optimize.portfolio +#' @param object an object of class \code{optimize.portfolio}. #' @param ... any other passthru parameters. Currently not used. +#' @seealso \code{\link{optimize.portfolio}} #' @author Ross Bennett #' @method summary optimize.portfolio #' @S3method summary optimize.portfolio @@ -798,6 +803,7 @@ #' #' @param x objective of class \code{efficient.frontier} #' @param \dots any other passthru parameters +#' @seealso \code{\link{create.EfficientFrontier}} #' @author Ross Bennett #' @method print efficient.frontier #' @S3method print efficient.frontier Modified: pkg/PortfolioAnalytics/man/print.constraint.Rd =================================================================== --- pkg/PortfolioAnalytics/man/print.constraint.Rd 2013-10-18 01:21:05 UTC (rev 3230) +++ pkg/PortfolioAnalytics/man/print.constraint.Rd 2013-10-18 01:36:36 UTC (rev 3231) @@ -1,16 +1,16 @@ \name{print.constraint} \alias{print.constraint} -\title{print method for objects of class 'constraint'} +\title{print method for constraint objects} \usage{ \method{print}{constraint} (x, ...) } \arguments{ - \item{x}{object of class constraint} + \item{x}{object of class \code{constraint}} \item{\dots}{any other passthru parameters} } \description{ - print method for objects of class 'constraint' + print method for constraint objects } \author{ Ross Bennett Modified: pkg/PortfolioAnalytics/man/print.efficient.frontier.Rd =================================================================== --- pkg/PortfolioAnalytics/man/print.efficient.frontier.Rd 2013-10-18 01:21:05 UTC (rev 3230) +++ pkg/PortfolioAnalytics/man/print.efficient.frontier.Rd 2013-10-18 01:36:36 UTC (rev 3231) @@ -18,4 +18,7 @@ \author{ Ross Bennett } +\seealso{ + \code{\link{create.EfficientFrontier}} +} Modified: pkg/PortfolioAnalytics/man/print.optimize.portfolio.Rd =================================================================== --- pkg/PortfolioAnalytics/man/print.optimize.portfolio.Rd 2013-10-18 01:21:05 UTC (rev 3230) +++ pkg/PortfolioAnalytics/man/print.optimize.portfolio.Rd 2013-10-18 01:36:36 UTC (rev 3231) @@ -30,9 +30,12 @@ when printing.} } \description{ - print method for optimize.portfolio objects + print method for \code{optimize.portfolio} objects } \author{ Ross Bennett } +\seealso{ + \code{\link{optimize.portfolio}} +} Modified: pkg/PortfolioAnalytics/man/print.portfolio.Rd =================================================================== --- pkg/PortfolioAnalytics/man/print.portfolio.Rd 2013-10-18 01:21:05 UTC (rev 3230) +++ pkg/PortfolioAnalytics/man/print.portfolio.Rd 2013-10-18 01:36:36 UTC (rev 3231) @@ -16,4 +16,7 @@ \author{ Ross Bennett } +\seealso{ + \code{\link{portfolio.spec}} +} Modified: pkg/PortfolioAnalytics/man/print.summary.optimize.portfolio.Rd =================================================================== --- pkg/PortfolioAnalytics/man/print.summary.optimize.portfolio.Rd 2013-10-18 01:21:05 UTC (rev 3230) +++ pkg/PortfolioAnalytics/man/print.summary.optimize.portfolio.Rd 2013-10-18 01:36:36 UTC (rev 3231) @@ -1,20 +1,24 @@ \name{print.summary.optimize.portfolio} \alias{print.summary.optimize.portfolio} -\title{Summarizing Output of optimize.portfolio} +\title{Printing summary output of optimize.portfolio} \usage{ \method{print}{summary.optimize.portfolio} (x, ...) } \arguments{ - \item{object}{an object of class "optimize.portfolio.pso" - resulting from a call to optimize.portfolio} + \item{x}{an object of class + \code{summary.optimize.portfolio}.} \item{...}{any other passthru parameters. Currently not used.} } \description{ - summary method for class "optimize.portfolio" + print method for objects of class + \code{summary.optimize.portfolio} } \author{ Ross Bennett } +\seealso{ + \code{\link{summary.optimize.portfolio}} +} Modified: pkg/PortfolioAnalytics/man/summary.optimize.portfolio.Rd =================================================================== --- pkg/PortfolioAnalytics/man/summary.optimize.portfolio.Rd 2013-10-18 01:21:05 UTC (rev 3230) +++ pkg/PortfolioAnalytics/man/summary.optimize.portfolio.Rd 2013-10-18 01:36:36 UTC (rev 3231) @@ -5,16 +5,19 @@ \method{summary}{optimize.portfolio} (object, ...) } \arguments{ - \item{object}{an object of class "optimize.portfolio.pso" - resulting from a call to optimize.portfolio} + \item{object}{an object of class + \code{optimize.portfolio}.} \item{...}{any other passthru parameters. Currently not used.} } \description{ - summary method for class "optimize.portfolio" + summary method for class \code{optimize.portfolio} } \author{ Ross Bennett } +\seealso{ + \code{\link{optimize.portfolio}} +} Modified: pkg/PortfolioAnalytics/man/summary.portfolio.Rd =================================================================== --- pkg/PortfolioAnalytics/man/summary.portfolio.Rd 2013-10-18 01:21:05 UTC (rev 3230) +++ pkg/PortfolioAnalytics/man/summary.portfolio.Rd 2013-10-18 01:36:36 UTC (rev 3231) @@ -5,7 +5,7 @@ \method{summary}{portfolio} (object, ...) } \arguments{ - \item{object}{object of class portfolio} + \item{object}{an object of class \code{portfolio}} \item{\dots}{any other passthru parameters} } @@ -16,4 +16,7 @@ \author{ Ross Bennett } +\seealso{ + \code{\link{portfolio.spec}} +} From noreply at r-forge.r-project.org Fri Oct 18 22:19:39 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 18 Oct 2013 22:19:39 +0200 (CEST) Subject: [Returnanalytics-commits] r3232 - in pkg/PortfolioAnalytics: R demo vignettes Message-ID: <20131018201939.8A5221861A4@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-18 22:19:39 +0200 (Fri, 18 Oct 2013) New Revision: 3232 Modified: pkg/PortfolioAnalytics/R/optFUN.R pkg/PortfolioAnalytics/demo/testing_ROI.R pkg/PortfolioAnalytics/vignettes/ROI_vignette.Rnw Log: Adding handling of Inf and -Inf values for optFUN functions. Modified ROI demo and vignette. Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-10-18 01:36:36 UTC (rev 3231) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-10-18 20:19:39 UTC (rev 3232) @@ -32,7 +32,7 @@ target <- 0 } } else { - tmp_means <- moments$mean + tmp_means <- rep(0, N) target <- 0 } Amat <- tmp_means @@ -76,7 +76,18 @@ # dir.vec <- c(dir.vec, rep(">=", 2 * nrow(t.B))) rhs.vec <- c(rhs.vec, constraints$lower, -constraints$upper) } + + # quadprog cannot handle infinite values so replace Inf with .Machine$double.xmax + # This is the strategy used in ROI + # Amat[ is.infinite(Amat) & (Amat <= 0) ] <- -.Machine$double.xmax + # Amat[ is.infinite(Amat) & (Amat >= 0) ] <- .Machine$double.xmax + # rhs.vec[is.infinite(rhs.vec) & (rhs.vec <= 0)] <- -.Machine$double.xmax + # rhs.vec[is.infinite(rhs.vec) & (rhs.vec >= 0)] <- .Machine$double.xmax + # Remove the rows of Amat and elements of rhs.vec where rhs.vec is Inf or -Inf + Amat <- Amat[!is.infinite(rhs.vec), ] + rhs.vec <- rhs.vec[!is.infinite(rhs.vec)] + # set up the quadratic objective if(!is.null(lambda_hhi)){ if(length(lambda_hhi) == 1 & is.null(conc_groups)){ @@ -112,6 +123,7 @@ # roi.result <- ROI_solve(x=opt.prob, solver="quadprog") result <- try(solve.QP(Dmat=Dmat, dvec=dvec, Amat=t(Amat), bvec=rhs.vec, meq=meq), silent=TRUE) + if(inherits(x=result, "try-error")) stop(paste("No solution found:", result)) weights <- result$solution[1:N] names(weights) <- colnames(R) @@ -139,8 +151,17 @@ N <- ncol(R) # Applying box constraints - bnds <- list(lower=list(ind=seq.int(1L, N), val=as.numeric(constraints$min)), - upper=list(ind=seq.int(1L, N), val=as.numeric(constraints$max))) + # maxret_opt needs non infinite values for upper and lower bounds + lb <- constraints$min + ub <- constraints$max + if(any(is.infinite(lb)) | any(is.infinite(ub))){ + warning("Inf or -Inf values detected in box constraints, maximum return + objectives must have finite box constraint values.") + ub[is.infinite(ub)] <- max(abs(c(constraints$min_sum, constraints$max_sum))) + lb[is.infinite(lb)] <- 0 + } + bnds <- list(lower=list(ind=seq.int(1L, N), val=as.numeric(lb)), + upper=list(ind=seq.int(1L, N), val=as.numeric(ub))) # set up initial A matrix for leverage constraints Amat <- rbind(rep(1, N), rep(1, N)) @@ -615,9 +636,13 @@ d <- rep(-moments$mean, 3) # print(Amat) + # Remove the rows of Amat and elements of rhs.vec where rhs is Inf or -Inf + Amat <- Amat[!is.infinite(rhs), ] + rhs <- rhs.vec[!is.infinite(rhs)] + qp.result <- try(solve.QP(Dmat=make.positive.definite(2*lambda*V), dvec=d, Amat=t(Amat), bvec=rhs, meq=meq), silent=TRUE) - if(inherits(qp.result, "try-error")) stop("No solution found, consider adjusting constraints.") + if(inherits(qp.result, "try-error")) stop(paste("No solution found:", result)) wts <- qp.result$solution # print(round(wts,4)) @@ -734,9 +759,13 @@ d <- rep(-moments$mean, 3) + # Remove the rows of Amat and elements of rhs.vec where rhs is Inf or -Inf + Amat <- Amat[!is.infinite(rhs), ] + rhs <- rhs.vec[!is.infinite(rhs)] + qp.result <- try(solve.QP(Dmat=make.positive.definite(2*lambda*V), dvec=d, Amat=t(Amat), bvec=rhs, meq=meq), silent=TRUE) - if(inherits(qp.result, "try-error")) stop("No solution found, consider adjusting constraints.") + if(inherits(qp.result, "try-error")) stop(paste("No solution found:", result)) wts <- qp.result$solution w.buy <- qp.result$solution[(N+1):(2*N)] Modified: pkg/PortfolioAnalytics/demo/testing_ROI.R =================================================================== --- pkg/PortfolioAnalytics/demo/testing_ROI.R 2013-10-18 01:36:36 UTC (rev 3231) +++ pkg/PortfolioAnalytics/demo/testing_ROI.R 2013-10-18 20:19:39 UTC (rev 3232) @@ -2,14 +2,6 @@ # OPTIMIZATION TESTING: ROI # -library(xts) -library(quadprog) -library(Rglpk) -library(PerformanceAnalytics) -library(ROI) -library(ROI.plugin.glpk) -library(ROI.plugin.quadprog) -library(Ecdat) library(PortfolioAnalytics) # General Parameters for sample code @@ -31,7 +23,7 @@ max.port$min <- rep(0.01,N) max.port$max <- rep(0.30,N) max.port$objectives[[1]]$enabled <- TRUE -max.port$objectives[[1]]$target <- NULL +max.port$objectives[[1]]$target <- NA max.solution <- optimize.portfolio(R=edhec, constraints=max.port, optimize_method="ROI") @@ -77,7 +69,7 @@ # Mean-variance: Fully invested, Global Minimum Variance Portfolio, Groups Constraints # groups.port <- gen.constr -groups <- c(3,3,3,4) +groups <- list(1:3, 4:6, 7:9, 10:13) groups.port$groups <- groups groups.port$cLO <- rep(0.15,length(groups)) groups.port$cUP <- rep(0.30,length(groups)) @@ -90,11 +82,11 @@ # Minimize CVaR with target return and group constraints # group.cvar.port <- gen.constr -groups <- c(3,3,3,4) +groups <- list(1:3, 4:6, 7:9, 10:13) group.cvar.port$groups <- groups group.cvar.port$cLO <- rep(0.15,length(groups)) group.cvar.port$cUP <- rep(0.30,length(groups)) group.cvar.port$objectives[[1]]$enabled <- TRUE group.cvar.port$objectives[[3]]$enabled <- TRUE -group.cvar.solution <- optimize.portfolio(R=edhec, constraints=group.cvar.port, optimize_method="ROI") +group.cvar.solution <- optimize.portfolio(R=edhec, constraints=group.cvar.port, optimize_method="ROI", maxSTARR=FALSE) Modified: pkg/PortfolioAnalytics/vignettes/ROI_vignette.Rnw =================================================================== --- pkg/PortfolioAnalytics/vignettes/ROI_vignette.Rnw 2013-10-18 01:36:36 UTC (rev 3231) +++ pkg/PortfolioAnalytics/vignettes/ROI_vignette.Rnw 2013-10-18 20:19:39 UTC (rev 3232) @@ -23,12 +23,8 @@ Load the necessary packages. <<>>= suppressMessages(library(PortfolioAnalytics)) -suppressMessages(library(Rglpk)) suppressMessages(library(foreach)) suppressMessages(library(iterators)) -suppressMessages(library(ROI)) -suppressMessages(require(ROI.plugin.glpk)) -suppressMessages(require(ROI.plugin.quadprog)) @ \subsection{Data} From noreply at r-forge.r-project.org Sat Oct 19 02:21:16 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 19 Oct 2013 02:21:16 +0200 (CEST) Subject: [Returnanalytics-commits] r3233 - pkg/PerformanceAnalytics/R Message-ID: <20131019002116.962191861D4@r-forge.r-project.org> Author: peter_carl Date: 2013-10-19 02:21:16 +0200 (Sat, 19 Oct 2013) New Revision: 3233 Modified: pkg/PerformanceAnalytics/R/Return.portfolio.R Log: - fixed a bug in the calc of first period of Return.portfolio Modified: pkg/PerformanceAnalytics/R/Return.portfolio.R =================================================================== --- pkg/PerformanceAnalytics/R/Return.portfolio.R 2013-10-18 20:19:39 UTC (rev 3232) +++ pkg/PerformanceAnalytics/R/Return.portfolio.R 2013-10-19 00:21:16 UTC (rev 3233) @@ -1,230 +1,230 @@ -#' @rdname Return.portfolio -#' @export -Return.rebalancing <- function (R, weights, ...) -{ # @author Brian G. Peterson - - if (is.vector(weights)){ - stop("Use Return.portfolio for single weighting vector. This function is for building portfolios over rebalancing periods.") - } - weights=checkData(weights,method="xts") - R=checkData(R,method="xts") - - if(as.Date(first(index(R))) > (as.Date(index(weights[1,]))+1)) { - warning(paste('data series starts on',as.Date(first(index(R))),', which is after the first rebalancing period',as.Date(first(index(weights)))+1)) - } - if(as.Date(last(index(R))) < (as.Date(index(weights[1,]))+1)){ - stop(paste('last date in series',as.Date(last(index(R))),'occurs before beginning of first rebalancing period',as.Date(first(index(weights)))+1)) - } - # loop: - for (row in 1:nrow(weights)){ - from =as.Date(index(weights[row,]))+1 - if (row == nrow(weights)){ - to = as.Date(index(last(R))) # this is correct - } else { - to = as.Date(index(weights[(row+1),])) - } - if(row==1){ - startingwealth=1 - } - tmpR<-R[paste(from,to,sep="/"),] - if (nrow(tmpR)>=1){ - resultreturns=Return.portfolio(tmpR,weights=weights[row,], ...=...) - if(row==1){ - result = resultreturns - } else { - result = rbind(result,resultreturns) - } - } - startingwealth=last(cumprod(1+result)*startingwealth) - } - result<-reclass(result, R) - result -} - -# ------------------------------------------------------------------------------ -# Return.portfolio - - - - -#' Calculates weighted returns for a portfolio of assets -#' -#' Calculates weighted returns for a portfolio of assets. If you have a single -#' weighting vector, or want the equal weighted portfolio, use -#' \code{Return.portfolio}. If you have a portfolio that is periodically -#' rebalanced, and multiple time periods with different weights, use -#' \code{Return.rebalancing}. Both functions will subset the return series to -#' only include returns for assets for which \code{weight} is provided. -#' -#' \code{Return.rebalancing} uses the date in the weights time series or matrix -#' for xts-style subsetting of rebalancing periods. Rebalancing periods can be -#' thought of as taking effect immediately after the close of the bar. So, a -#' March 31 rebalancing date will actually be in effect for April 1. A -#' December 31 rebalancing date will be in effect on Jan 1, and so forth. This -#' convention was chosen because it fits with common usage, and because it -#' simplifies xts Date subsetting via \code{endpoints}. -#' -#' \code{Return.rebalancing} will rebalance only on daily or lower frequencies. -#' If you are rebalancing intraday, you should be using a trading/prices -#' framework, not a weights-based return framework. -#' -#' @aliases Return.portfolio Return.rebalancing -#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of -#' asset returns -#' @param weights a time series or single-row matrix/vector containing asset -#' weights, as percentages -#' @param wealth.index TRUE/FALSE whether to return a wealth index, default -#' FALSE -#' @param contribution if contribution is TRUE, add the weighted return -#' contributed by the asset in this period -#' @param geometric utilize geometric chaining (TRUE) or simple/arithmetic chaining (FALSE) to aggregate returns, -#' default TRUE -#' @param \dots any other passthru parameters -#' @return returns a time series of returns weighted by the \code{weights} -#' parameter, possibly including contribution for each period -#' @author Brian G. Peterson -#' @seealso \code{\link{Return.calculate}} \cr -#' @references Bacon, C. \emph{Practical Portfolio Performance Measurement and -#' Attribution}. Wiley. 2004. Chapter 2\cr -#' @keywords ts multivariate distribution models -#' @examples -#' -#' -#' data(edhec) -#' data(weights) -#' -#' # calculate an equal weighted portfolio return -#' round(Return.portfolio(edhec),4) -#' -#' # now return the contribution too -#' round(Return.portfolio(edhec,contribution=TRUE),4) -#' -#' # calculate a portfolio return with rebalancing -#' round(Return.rebalancing(edhec,weights),4) -#' -#' @export -Return.portfolio <- function (R, weights=NULL, wealth.index = FALSE, contribution=FALSE,geometric=TRUE, ...) -{ # @author Brian G. Peterson - - # Function to calculate weighted portfolio returns - # - # old function pfpolioReturn in RMetrics used continuous compunding, which isn't accurate. - # new function lets weights float after initial period, and produces correct results. - # - # R data structure of component returns - # - # weights usually a numeric vector which has the length of the number - # of assets. The weights measures the normalized weights of - # the individual assets. By default 'NULL', then an equally - # weighted set of assets is assumed. - # - # method: "simple", "compound" - # - # wealth.index if wealth.index is TRUE, return a wealth index, if false, return a return vector for each period - # - # contribution if contribution is TRUE, add the weighted return contributed by the asset in this period - - # Setup: - R=checkData(R,method="xts") - if(!nrow(R)>=1){ - warning("no data passed for R(eturns)") - return(NULL) - } - # take only the first method - if(hasArg(method) & !is.null(list(...)$method)) - method = list(...)$method[1] - else if(!isTRUE(geometric)) - method='simple' - else method=FALSE - - if (is.null(weights)){ - # set up an equal weighted portfolio - weights = t(rep(1/ncol(R), ncol(R))) - warning("weighting vector is null, calulating an equal weighted portfolio") - colnames(weights)<-colnames(R) - } else{ - weights=checkData(weights,method="matrix") # do this to make sure we have columns, and not just a vector - } - if (nrow(weights)>1){ - if ((nrow(weights)==ncol(R) |nrow(weights)==ncol(R[,names(weights)]) ) & (ncol(weights)==1)) { - weights = t(weights) #this was a vector that got transformed - } else { - stop("Use Return.rebalancing for multiple weighting periods. This function is for portfolios with a single set of weights.") - } - } - if (is.null(colnames(weights))) { colnames(weights)<-colnames(R) } - - #Function: - - - # construct the wealth index - if(method=="simple" | nrow(R) == 1) { - # weights=as.vector(weights) - weightedreturns = R[,colnames(weights)] * as.vector(weights) # simple weighted returns - returns = R[,colnames(weights)] %*% as.vector(weights) # simple compound returns - if(wealth.index) { - wealthindex = as.matrix(cumsum(returns),ncol=1) # simple wealth index - } else { - result = returns - } - } else { - #things are a little more complicated for the geometric case - - # first construct an unweighted wealth index of the assets - wealthindex.assets=cumprod(1+R[,colnames(weights)]) - - wealthindex.weighted = matrix(nrow=nrow(R),ncol=ncol(R[,colnames(weights)])) - colnames(wealthindex.weighted)=colnames(wealthindex.assets) - rownames(wealthindex.weighted)=as.character(index(wealthindex.assets)) - # weight the results - for (col in colnames(weights)){ - wealthindex.weighted[,col]=weights[,col]*wealthindex.assets[,col] - } - wealthindex=reclass(apply(wealthindex.weighted,1,sum), R) - result = wealthindex - result[2:length(result)] = result[2:length(result)] / - lag(result)[2:length(result)] - 1 - #result[1] = result[1] - 1 - result[1] = result[1] / sum(abs(weights[1,])) #divide by the sum of the first weighting vector to account for possible leverage - w = matrix(rep(NA), ncol(wealthindex.assets) * nrow(wealthindex.assets), ncol = ncol(wealthindex.assets), nrow = nrow(wealthindex.assets)) - w[1, ] = weights - w[2:length(wealthindex), ] = (wealthindex.weighted / rep(wealthindex, ncol(wealthindex.weighted)))[1:(length(wealthindex) - 1), ] - weightedreturns = R[, colnames(weights)] * w - } - - - if (!wealth.index){ - colnames(result)="portfolio.returns" - } else { - wealthindex=reclass(wealthindex,match.to=R) - result=wealthindex - colnames(result)="portfolio.wealthindex" - } - - if (contribution==TRUE){ - # show the contribution to the returns in each period. - result=cbind(weightedreturns, coredata(result)) - } - rownames(result)<-NULL # avoid a weird problem with rbind, per Jeff - result<-reclass(result, R) - result -} # end function Return.portfolio - -pfolioReturn <- function (x, weights=NULL, ...) -{ # @author Brian G. Peterson - # pfolioReturn wrapper - replaces RMetrics pfolioReturn fn - - Return.portfolio(R=x, weights=weights, ...=...) -} - -############################################################################### -# R (http://r-project.org/) Econometrics for Performance and Risk Analysis -# -# Copyright (c) 2004-2012 Peter Carl and Brian G. Peterson -# -# This R package is distributed under the terms of the GNU Public License (GPL) -# for full details see the file COPYING -# -# $Id$ -# +#' @rdname Return.portfolio +#' @export +Return.rebalancing <- function (R, weights, ...) +{ # @author Brian G. Peterson + + if (is.vector(weights)){ + stop("Use Return.portfolio for single weighting vector. This function is for building portfolios over rebalancing periods.") + } + weights=checkData(weights,method="xts") + R=checkData(R,method="xts") + + if(as.Date(first(index(R))) > (as.Date(index(weights[1,]))+1)) { + warning(paste('data series starts on',as.Date(first(index(R))),', which is after the first rebalancing period',as.Date(first(index(weights)))+1)) + } + if(as.Date(last(index(R))) < (as.Date(index(weights[1,]))+1)){ + stop(paste('last date in series',as.Date(last(index(R))),'occurs before beginning of first rebalancing period',as.Date(first(index(weights)))+1)) + } + # loop: + for (row in 1:nrow(weights)){ + from =as.Date(index(weights[row,]))+1 + if (row == nrow(weights)){ + to = as.Date(index(last(R))) # this is correct + } else { + to = as.Date(index(weights[(row+1),])) + } + if(row==1){ + startingwealth=1 + } + tmpR<-R[paste(from,to,sep="/"),] + if (nrow(tmpR)>=1){ + resultreturns=Return.portfolio(tmpR,weights=weights[row,], ...=...) + if(row==1){ + result = resultreturns + } else { + result = rbind(result,resultreturns) + } + } + startingwealth=last(cumprod(1+result)*startingwealth) + } + result<-reclass(result, R) + result +} + +# ------------------------------------------------------------------------------ +# Return.portfolio + + + + +#' Calculates weighted returns for a portfolio of assets +#' +#' Calculates weighted returns for a portfolio of assets. If you have a single +#' weighting vector, or want the equal weighted portfolio, use +#' \code{Return.portfolio}. If you have a portfolio that is periodically +#' rebalanced, and multiple time periods with different weights, use +#' \code{Return.rebalancing}. Both functions will subset the return series to +#' only include returns for assets for which \code{weight} is provided. +#' +#' \code{Return.rebalancing} uses the date in the weights time series or matrix +#' for xts-style subsetting of rebalancing periods. Rebalancing periods can be +#' thought of as taking effect immediately after the close of the bar. So, a +#' March 31 rebalancing date will actually be in effect for April 1. A +#' December 31 rebalancing date will be in effect on Jan 1, and so forth. This +#' convention was chosen because it fits with common usage, and because it +#' simplifies xts Date subsetting via \code{endpoints}. +#' +#' \code{Return.rebalancing} will rebalance only on daily or lower frequencies. +#' If you are rebalancing intraday, you should be using a trading/prices +#' framework, not a weights-based return framework. +#' +#' @aliases Return.portfolio Return.rebalancing +#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of +#' asset returns +#' @param weights a time series or single-row matrix/vector containing asset +#' weights, as percentages +#' @param wealth.index TRUE/FALSE whether to return a wealth index, default +#' FALSE +#' @param contribution if contribution is TRUE, add the weighted return +#' contributed by the asset in this period +#' @param geometric utilize geometric chaining (TRUE) or simple/arithmetic chaining (FALSE) to aggregate returns, +#' default TRUE +#' @param \dots any other passthru parameters +#' @return returns a time series of returns weighted by the \code{weights} +#' parameter, possibly including contribution for each period +#' @author Brian G. Peterson +#' @seealso \code{\link{Return.calculate}} \cr +#' @references Bacon, C. \emph{Practical Portfolio Performance Measurement and +#' Attribution}. Wiley. 2004. Chapter 2\cr +#' @keywords ts multivariate distribution models +#' @examples +#' +#' +#' data(edhec) +#' data(weights) +#' +#' # calculate an equal weighted portfolio return +#' round(Return.portfolio(edhec),4) +#' +#' # now return the contribution too +#' round(Return.portfolio(edhec,contribution=TRUE),4) +#' +#' # calculate a portfolio return with rebalancing +#' round(Return.rebalancing(edhec,weights),4) +#' +#' @export +Return.portfolio <- function (R, weights=NULL, wealth.index = FALSE, contribution=FALSE,geometric=TRUE, ...) +{ # @author Brian G. Peterson + + # Function to calculate weighted portfolio returns + # + # old function pfpolioReturn in RMetrics used continuous compunding, which isn't accurate. + # new function lets weights float after initial period, and produces correct results. + # + # R data structure of component returns + # + # weights usually a numeric vector which has the length of the number + # of assets. The weights measures the normalized weights of + # the individual assets. By default 'NULL', then an equally + # weighted set of assets is assumed. + # + # method: "simple", "compound" + # + # wealth.index if wealth.index is TRUE, return a wealth index, if false, return a return vector for each period + # + # contribution if contribution is TRUE, add the weighted return contributed by the asset in this period + + # Setup: + R=checkData(R,method="xts") + if(!nrow(R)>=1){ + warning("no data passed for R(eturns)") + return(NULL) + } + # take only the first method + if(hasArg(method) & !is.null(list(...)$method)) + method = list(...)$method[1] + else if(!isTRUE(geometric)) + method='simple' + else method=FALSE + + if (is.null(weights)){ + # set up an equal weighted portfolio + weights = t(rep(1/ncol(R), ncol(R))) + warning("weighting vector is null, calulating an equal weighted portfolio") + colnames(weights)<-colnames(R) + } else{ + weights=checkData(weights,method="matrix") # do this to make sure we have columns, and not just a vector + } + if (nrow(weights)>1){ + if ((nrow(weights)==ncol(R) |nrow(weights)==ncol(R[,names(weights)]) ) & (ncol(weights)==1)) { + weights = t(weights) #this was a vector that got transformed + } else { + stop("Use Return.rebalancing for multiple weighting periods. This function is for portfolios with a single set of weights.") + } + } + if (is.null(colnames(weights))) { colnames(weights)<-colnames(R) } + + #Function: + + + # construct the wealth index + if(method=="simple" | nrow(R) == 1) { + # weights=as.vector(weights) + weightedreturns = R[,colnames(weights)] * as.vector(weights) # simple weighted returns + returns = R[,colnames(weights)] %*% as.vector(weights) # simple compound returns + if(wealth.index) { + wealthindex = as.matrix(cumsum(returns),ncol=1) # simple wealth index + } else { + result = returns + } + } else { + #things are a little more complicated for the geometric case + + # first construct an unweighted wealth index of the assets + wealthindex.assets=cumprod(1+R[,colnames(weights)]) + + wealthindex.weighted = matrix(nrow=nrow(R),ncol=ncol(R[,colnames(weights)])) + colnames(wealthindex.weighted)=colnames(wealthindex.assets) + rownames(wealthindex.weighted)=as.character(index(wealthindex.assets)) + # weight the results + for (col in colnames(weights)){ + wealthindex.weighted[,col]=weights[,col]*wealthindex.assets[,col] + } + wealthindex=reclass(apply(wealthindex.weighted,1,sum), R) + result = wealthindex + result[2:length(result)] = result[2:length(result)] / + lag(result)[2:length(result)] - 1 + #result[1] = result[1] - 1 + result[1] = result[1] / sum(abs(weights[1,])) -1 #divide by the sum of the first weighting vector to account for possible leverage + w = matrix(rep(NA), ncol(wealthindex.assets) * nrow(wealthindex.assets), ncol = ncol(wealthindex.assets), nrow = nrow(wealthindex.assets)) + w[1, ] = weights + w[2:length(wealthindex), ] = (wealthindex.weighted / rep(wealthindex, ncol(wealthindex.weighted)))[1:(length(wealthindex) - 1), ] + weightedreturns = R[, colnames(weights)] * w + } + + + if (!wealth.index){ + colnames(result)="portfolio.returns" + } else { + wealthindex=reclass(wealthindex,match.to=R) + result=wealthindex + colnames(result)="portfolio.wealthindex" + } + + if (contribution==TRUE){ + # show the contribution to the returns in each period. + result=cbind(weightedreturns, coredata(result)) + } + rownames(result)<-NULL # avoid a weird problem with rbind, per Jeff + result<-reclass(result, R) + result +} # end function Return.portfolio + +pfolioReturn <- function (x, weights=NULL, ...) +{ # @author Brian G. Peterson + # pfolioReturn wrapper - replaces RMetrics pfolioReturn fn + + Return.portfolio(R=x, weights=weights, ...=...) +} + +############################################################################### +# R (http://r-project.org/) Econometrics for Performance and Risk Analysis +# +# Copyright (c) 2004-2012 Peter Carl and Brian G. Peterson +# +# This R package is distributed under the terms of the GNU Public License (GPL) +# for full details see the file COPYING +# +# $Id$ +# ############################################################################### \ No newline at end of file From noreply at r-forge.r-project.org Sat Oct 19 07:14:32 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 19 Oct 2013 07:14:32 +0200 (CEST) Subject: [Returnanalytics-commits] r3234 - pkg/PortfolioAnalytics/demo Message-ID: <20131019051432.20338185F52@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-19 07:14:31 +0200 (Sat, 19 Oct 2013) New Revision: 3234 Modified: pkg/PortfolioAnalytics/demo/demo_ROI.R pkg/PortfolioAnalytics/demo/demo_factor_exposure.R pkg/PortfolioAnalytics/demo/demo_return_target.R Log: minor modification to demo scripts Modified: pkg/PortfolioAnalytics/demo/demo_ROI.R =================================================================== --- pkg/PortfolioAnalytics/demo/demo_ROI.R 2013-10-19 00:21:16 UTC (rev 3233) +++ pkg/PortfolioAnalytics/demo/demo_ROI.R 2013-10-19 05:14:31 UTC (rev 3234) @@ -43,7 +43,7 @@ ret_constr <- return_constraint(return_target=0.007) # Group constraint -group_constr <- group_constraint(assets=pspec$assets, groups=c(1, 2, 1), +group_constr <- group_constraint(assets=pspec$assets, groups=list(1, 2:3, 4), group_min=0, group_max=0.5) # Factor exposure constraint @@ -173,11 +173,11 @@ opt_qu # Full investment, long only, target return, and group constraints -opt_qu <- optimize.portfolio(R=ret, portfolio=pspec, - constraints=list(fi_constr, lo_constr, ret_constr, group_constr), - objectives=list(ret_obj, var_obj), - optimize_method="ROI") -opt_qu +# opt_qu <- optimize.portfolio(R=ret, portfolio=pspec, +# constraints=list(fi_constr, lo_constr, ret_constr, group_constr), +# objectives=list(ret_obj, var_obj), +# optimize_method="ROI") +# opt_qu ##### Minimize ETL Optimization ##### # The ROI solver uses the glpk plugin to interface to the Rglpk package for Modified: pkg/PortfolioAnalytics/demo/demo_factor_exposure.R =================================================================== --- pkg/PortfolioAnalytics/demo/demo_factor_exposure.R 2013-10-19 00:21:16 UTC (rev 3233) +++ pkg/PortfolioAnalytics/demo/demo_factor_exposure.R 2013-10-19 05:14:31 UTC (rev 3234) @@ -15,7 +15,7 @@ # box constraint lo_constr <- box_constraint(assets=pspec$assets, min=c(0.01, 0.02, 0.03, 0.04), max=0.65) # group constraint -grp_constr <- group_constraint(assets=pspec$assets, groups=c(2, 1, 1), group_min=0.1, group_max=0.4) +grp_constr <- group_constraint(assets=pspec$assets, groups=list(1:2, 3, 4), group_min=0.1, group_max=0.4) # position limit constraint pl_constr <- position_limit_constraint(assets=pspec$assets, max_pos=4) Modified: pkg/PortfolioAnalytics/demo/demo_return_target.R =================================================================== --- pkg/PortfolioAnalytics/demo/demo_return_target.R 2013-10-19 00:21:16 UTC (rev 3233) +++ pkg/PortfolioAnalytics/demo/demo_return_target.R 2013-10-19 05:14:31 UTC (rev 3234) @@ -8,7 +8,7 @@ # set up portfolio specification object target in the return object pspec1 <- portfolio.spec(assets=colnames(ret)) -pspec1 <- add.constraint(portfolio=pspec1, type="leverage", min_sum=1, max_sum=1) +pspec1 <- add.constraint(portfolio=pspec1, type="leverage", min_sum=0.99, max_sum=1.01) pspec1 <- add.constraint(portfolio=pspec1, type="box") pspec1 <- add.objective(portfolio=pspec1, type="return", name="mean", target=0.007) @@ -20,7 +20,7 @@ # set up portfolio specification object target with the return constraint pspec2 <- portfolio.spec(assets=colnames(ret)) -pspec2 <- add.constraint(portfolio=pspec2, type="leverage", min_sum=1, max_sum=1) +pspec2 <- add.constraint(portfolio=pspec2, type="leverage", min_sum=0.99, max_sum=1.01) pspec2 <- add.constraint(portfolio=pspec2, type="box") pspec2 <- add.constraint(portfolio=pspec2, type="return", return_target=0.007) pspec2 <- add.objective(portfolio=pspec2, type="return", name="mean") From noreply at r-forge.r-project.org Sat Oct 19 16:31:33 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 19 Oct 2013 16:31:33 +0200 (CEST) Subject: [Returnanalytics-commits] r3235 - pkg/PortfolioAnalytics/vignettes Message-ID: <20131019143133.E33AD185916@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-19 16:31:29 +0200 (Sat, 19 Oct 2013) New Revision: 3235 Modified: pkg/PortfolioAnalytics/vignettes/portfolio_vignette.Rnw pkg/PortfolioAnalytics/vignettes/portfolio_vignette.pdf Log: Minor correction to figure captions Modified: pkg/PortfolioAnalytics/vignettes/portfolio_vignette.Rnw =================================================================== --- pkg/PortfolioAnalytics/vignettes/portfolio_vignette.Rnw 2013-10-19 05:14:31 UTC (rev 3234) +++ pkg/PortfolioAnalytics/vignettes/portfolio_vignette.Rnw 2013-10-19 14:31:29 UTC (rev 3235) @@ -584,7 +584,7 @@ print(opt_rb_meanETL) @ -<>= +<>= plot(opt_rb_meanETL, risk.col="ETL", return.col="mean", main="Risk Budget mean-ETL Optimization", xlim=c(0,0.12), ylim=c(0.005,0.009)) @@ -624,7 +624,7 @@ @ Chart the contribution to risk in percentage terms. It is clear in this chart that the optimization results in a near equal risk contribution portfolio. -<>= +<>= chart.RiskBudget(opt_eq_meanETL, risk.type="percentage", neighbors=25) @ Modified: pkg/PortfolioAnalytics/vignettes/portfolio_vignette.pdf =================================================================== (Binary files differ) From noreply at r-forge.r-project.org Wed Oct 23 01:43:37 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 23 Oct 2013 01:43:37 +0200 (CEST) Subject: [Returnanalytics-commits] r3236 - pkg/PortfolioAnalytics/R Message-ID: <20131022234337.C969A183BB0@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-23 01:43:37 +0200 (Wed, 23 Oct 2013) New Revision: 3236 Modified: pkg/PortfolioAnalytics/R/constrained_objective.R Log: Added scaling to actual HHI for min_concentration. Modified: pkg/PortfolioAnalytics/R/constrained_objective.R =================================================================== --- pkg/PortfolioAnalytics/R/constrained_objective.R 2013-10-19 14:31:29 UTC (rev 3235) +++ pkg/PortfolioAnalytics/R/constrained_objective.R 2013-10-22 23:43:37 UTC (rev 3236) @@ -681,7 +681,7 @@ if(isTRUE(objective$min_concentration)){ # use HHI to calculate concentration # actual HHI - act_hhi <- sum(tmp_measure[[3]]^2) + act_hhi <- sum(tmp_measure[[3]]^2)/100 # minimum possible HHI min_hhi <- sum(rep(1/length(tmp_measure[[3]]), length(tmp_measure[[3]]))^2)/100 out <- out + penalty * objective$multiplier * abs(act_hhi - min_hhi) From noreply at r-forge.r-project.org Wed Oct 23 01:45:22 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 23 Oct 2013 01:45:22 +0200 (CEST) Subject: [Returnanalytics-commits] r3237 - pkg/PortfolioAnalytics/R Message-ID: <20131022234522.E384A185C0A@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-23 01:45:22 +0200 (Wed, 23 Oct 2013) New Revision: 3237 Modified: pkg/PortfolioAnalytics/R/extract.efficient.frontier.R pkg/PortfolioAnalytics/R/optFUN.R Log: minor fixes to gmv_opt and meanvar.efficient.frontier Modified: pkg/PortfolioAnalytics/R/extract.efficient.frontier.R =================================================================== --- pkg/PortfolioAnalytics/R/extract.efficient.frontier.R 2013-10-22 23:43:37 UTC (rev 3236) +++ pkg/PortfolioAnalytics/R/extract.efficient.frontier.R 2013-10-22 23:45:22 UTC (rev 3237) @@ -109,7 +109,7 @@ } # for a mean-var efficient frontier, there must be two objectives 1) "mean" and 2) "var" - if(!((length(objnames) >= 2) & ("var" %in% objnames) & ("mean" %in% objnames))){ + if(!((length(objnames) >= 2) & ("var" %in% objnames | "StdDev" %in% objnames | "sd" %in% objnames) & ("mean" %in% objnames))){ stop("The portfolio object must have both 'mean' and 'var' specified as objectives") } @@ -121,7 +121,7 @@ } # get the index number of the var objective - var_idx <- which(unlist(lapply(portfolio$objectives, function(x) x$name)) == "var") + var_idx <- which(unlist(lapply(portfolio$objectives, function(x) x$name)) %in% c("var", "StdDev", "sd")) # get the index number of the mean objective mean_idx <- which(unlist(lapply(portfolio$objectives, function(x) x$name)) == "mean") Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-10-22 23:43:37 UTC (rev 3236) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-10-22 23:45:22 UTC (rev 3237) @@ -29,7 +29,6 @@ tmp_means <- colMeans(R) } else { tmp_means <- moments$mean - target <- 0 } } else { tmp_means <- rep(0, N) @@ -93,7 +92,7 @@ if(length(lambda_hhi) == 1 & is.null(conc_groups)){ # ROI_objective <- Q_objective(Q=2*lambda*(moments$var + lambda_hhi * diag(N)), L=-moments$mean) # ROI Dmat <- 2*lambda*(moments$var + lambda_hhi * diag(N)) # solve.QP - dvec <- -moments$mean # solve.QP + dvec <- moments$mean # solve.QP } else if(!is.null(conc_groups)){ # construct the matrix with concentration aversion values by group hhi_mat <- matrix(0, nrow=N, ncol=N) @@ -109,12 +108,12 @@ } # ROI_objective <- Q_objective(Q=2*lambda*(moments$var + hhi_mat), L=-moments$mean) # ROI Dmat <- 2 * lambda * (moments$var + hhi_mat) # solve.QP - dvec <- -moments$mean # solve.QP + dvec <- moments$mean # solve.QP } } else { # ROI_objective <- Q_objective(Q=2*lambda*moments$var, L=-moments$mean) # ROI Dmat <- 2 * lambda * moments$var # solve.QP - dvec <- -moments$mean # solve.QP + dvec <- moments$mean # solve.QP } # set up the optimization problem and solve # opt.prob <- OP(objective=ROI_objective, @@ -560,7 +559,6 @@ tmp_means <- colMeans(R) } else { tmp_means <- moments$mean - target <- 0 } } else { tmp_means <- moments$mean @@ -900,7 +898,7 @@ fmean <- matrix(moments$mean, ncol=1) # Find the maximum return - max_ret <- PortfolioAnalytics:::maxret_opt(R=R, moments=moments, constraints=constraints, target=NA) + max_ret <- maxret_opt(R=R, moments=moments, constraints=constraints, target=NA) max_mean <- as.numeric(-max_ret$out) # Calculate the sr at the maximum mean return portfolio @@ -911,7 +909,7 @@ ub_sr <- ub_mean / ub_sd # Calculate the sr at the miminum var portfolio - lb_sr <- PortfolioAnalytics:::gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1e6, target=NA, lambda_hhi=lambda_hhi, conc_groups=conc_groups) + lb_sr <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1e6, target=NA, lambda_hhi=lambda_hhi, conc_groups=conc_groups) lb_weights <- matrix(lb_sr$weights) lb_mean <- as.numeric(t(lb_weights) %*% fmean) lb_sd <- as.numeric(sqrt(t(lb_weights) %*% moments$var %*% lb_weights)) @@ -925,7 +923,7 @@ # Find the starr at the mean return midpoint new_ret <- (lb_mean + ub_mean) / 2 - mid <- PortfolioAnalytics:::gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1e6, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups) + mid <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups) mid_weights <- matrix(mid$weights, ncol=1) mid_mean <- as.numeric(t(mid_weights) %*% fmean) mid_sd <- as.numeric(sqrt(t(mid_weights) %*% moments$var %*% mid_weights)) @@ -941,7 +939,7 @@ ub_mean <- mid_mean ub_sr <- mid_sr new_ret <- (lb_mean + ub_mean) / 2 - mid <- PortfolioAnalytics:::gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1e6, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups) + mid <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups) mid_weights <- matrix(mid$weights, ncol=1) mid_mean <- as.numeric(t(mid_weights) %*% fmean) mid_sd <- as.numeric(sqrt(t(mid_weights) %*% moments$var %*% mid_weights)) @@ -951,7 +949,7 @@ lb_mean <- mid_mean lb_sr <- mid_sr new_ret <- (lb_mean + ub_mean) / 2 - mid <- PortfolioAnalytics:::gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1e6, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups) + mid <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups) mid_weights <- matrix(mid$weights, ncol=1) mid_mean <- as.numeric(t(mid_weights) %*% fmean) mid_sd <- as.numeric(sqrt(t(mid_weights) %*% moments$var %*% mid_weights)) From noreply at r-forge.r-project.org Wed Oct 23 15:00:52 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 23 Oct 2013 15:00:52 +0200 (CEST) Subject: [Returnanalytics-commits] r3238 - pkg/PortfolioAnalytics/R Message-ID: <20131023130052.1C810185A13@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-23 15:00:51 +0200 (Wed, 23 Oct 2013) New Revision: 3238 Modified: pkg/PortfolioAnalytics/R/optFUN.R Log: Fixing bug in gmv_opt_toc Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-10-22 23:45:22 UTC (rev 3237) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-10-23 13:00:51 UTC (rev 3238) @@ -348,6 +348,13 @@ bnds <- list(lower=list(ind=seq.int(1L, N), val=as.numeric(constraints$min)), upper=list(ind=seq.int(1L, N), val=as.numeric(constraints$max))) + # Add this check if mean is not an objective and return is a constraints + if(!is.na(target)){ + if(all(moments$mean == 0)){ + moments$mean <- colMeans(R) + } + } + Rmin <- ifelse(is.na(target), 0, target) Amat <- cbind(rbind(1, 1, moments$mean, coredata(R)), rbind(0, 0, 0, cbind(diag(T), 1))) @@ -636,7 +643,7 @@ # Remove the rows of Amat and elements of rhs.vec where rhs is Inf or -Inf Amat <- Amat[!is.infinite(rhs), ] - rhs <- rhs.vec[!is.infinite(rhs)] + rhs <- rhs[!is.infinite(rhs)] qp.result <- try(solve.QP(Dmat=make.positive.definite(2*lambda*V), dvec=d, Amat=t(Amat), bvec=rhs, meq=meq), silent=TRUE) From noreply at r-forge.r-project.org Wed Oct 23 19:54:52 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 23 Oct 2013 19:54:52 +0200 (CEST) Subject: [Returnanalytics-commits] r3239 - pkg/PortfolioAnalytics/R Message-ID: <20131023175452.50B2B18528C@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-23 19:54:52 +0200 (Wed, 23 Oct 2013) New Revision: 3239 Modified: pkg/PortfolioAnalytics/R/extract.efficient.frontier.R pkg/PortfolioAnalytics/R/optFUN.R Log: cleaning up meanvar.efficient.frontier so we no longer approximate max return and min return by manipulating the risk aversion parameter Modified: pkg/PortfolioAnalytics/R/extract.efficient.frontier.R =================================================================== --- pkg/PortfolioAnalytics/R/extract.efficient.frontier.R 2013-10-23 13:00:51 UTC (rev 3238) +++ pkg/PortfolioAnalytics/R/extract.efficient.frontier.R 2013-10-23 17:54:52 UTC (rev 3239) @@ -110,7 +110,7 @@ # for a mean-var efficient frontier, there must be two objectives 1) "mean" and 2) "var" if(!((length(objnames) >= 2) & ("var" %in% objnames | "StdDev" %in% objnames | "sd" %in% objnames) & ("mean" %in% objnames))){ - stop("The portfolio object must have both 'mean' and 'var' specified as objectives") + stop("The portfolio object must have both 'mean' and 'var', 'StdDev', or'sd' specified as objectives") } # If the user has passed in a portfolio object with return_constraint, we need to disable it @@ -125,29 +125,48 @@ # get the index number of the mean objective mean_idx <- which(unlist(lapply(portfolio$objectives, function(x) x$name)) == "mean") + ##### get the maximum return ##### + # set the risk_aversion to a very small number for equivalent to max return portfolio - portfolio$objectives[[var_idx]]$risk_aversion <- 1e-6 + # portfolio$objectives[[var_idx]]$risk_aversion <- 1e-6 + # Disable the risk objective + portfolio$objectives[[var_idx]]$enabled <- FALSE + # run the optimization to get the maximum return tmp <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI") - maxret <- extractObjectiveMeasures(tmp)$mean + mean_ret <- colMeans(R) + maxret <- sum(extractWeights(tmp) * mean_ret) + ##### Get the return at the minimum variance portfolio ##### + # set the risk_aversion to a very large number equivalent to a minvar portfolio - portfolio$objectives[[var_idx]]$risk_aversion <- 1e6 + # portfolio$objectives[[var_idx]]$risk_aversion <- 1e6 + + # Disable the return objective + portfolio$objectives[[mean_idx]]$enabled <- FALSE + + # Enable the risk objective + portfolio$objectives[[var_idx]]$enabled <- TRUE + + # Run the optimization to get the global minimum variance portfolio with the + # given constraints. + # Do we want to disable the turnover or transaction costs constraints here? tmp <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI") stats <- extractStats(tmp) - minret <- stats["mean"] + minret <- sum(extractWeights(tmp) * mean_ret) # length.out is the number of portfolios to create ret_seq <- seq(from=minret, to=maxret, length.out=n.portfolios) -# out <- matrix(0, nrow=length(ret_seq), ncol=length(extractStats(tmp))) -# for(i in 1:length(ret_seq)){ -# portfolio$objectives[[mean_idx]]$target <- ret_seq[i] -# out[i, ] <- extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI")) -# } + # Add target return constraint to step along the efficient frontier for target returns + portfolio <- add.constraint(portfolio=portfolio, type="return", return_target=minret, enabled=FALSE) + ret_constr_idx <- which(unlist(lapply(portfolio$constraints, function(x) inherits(x, "return_constraint")))) + stopifnot("package:foreach" %in% search() || require("foreach",quietly = TRUE)) if(!is.null(risk_aversion)){ + # Enable the return objective so we are doing quadratic utility + portfolio$objectives[[mean_idx]]$enabled <- TRUE out <- foreach(i=1:length(risk_aversion), .inorder=TRUE, .combine=rbind, .errorhandling='remove') %dopar% { portfolio$objectives[[var_idx]]$risk_aversion <- risk_aversion[i] extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI")) @@ -155,11 +174,14 @@ out <- cbind(out, risk_aversion) colnames(out) <- c(names(stats), "lambda") } else { + # Enable the return constraint + portfolio$constraints[[ret_constr_idx]]$enabled <- TRUE out <- foreach(i=1:length(ret_seq), .inorder=TRUE, .combine=rbind, .errorhandling='remove') %dopar% { - portfolio$objectives[[mean_idx]]$target <- ret_seq[i] - extractStats(optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI")) + portfolio$constraints[[ret_constr_idx]]$return_target <- ret_seq[i] + opt <- optimize.portfolio(R=R, portfolio=portfolio, optimize_method="ROI") + c(sum(extractWeights(opt) * mean_ret), extractStats(opt)) } - colnames(out) <- names(stats) + colnames(out) <- c("mean", names(stats)) } return(structure(out, class="frontier")) } Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-10-23 13:00:51 UTC (rev 3238) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-10-23 17:54:52 UTC (rev 3239) @@ -568,7 +568,7 @@ tmp_means <- moments$mean } } else { - tmp_means <- moments$mean + tmp_means <- rep(0, N) target <- 0 } Amat <- c(tmp_means, rep(0, 2*N)) @@ -638,16 +638,20 @@ rhs <- c(rhs, constraints$lower, -constraints$upper) } - d <- rep(-moments$mean, 3) - # print(Amat) + d <- rep(moments$mean, 3) # Remove the rows of Amat and elements of rhs.vec where rhs is Inf or -Inf Amat <- Amat[!is.infinite(rhs), ] rhs <- rhs[!is.infinite(rhs)] - + # print("Amat") + # print(Amat) + # print("rhs") + # print(rhs) + # print("d") + # print(d) qp.result <- try(solve.QP(Dmat=make.positive.definite(2*lambda*V), dvec=d, Amat=t(Amat), bvec=rhs, meq=meq), silent=TRUE) - if(inherits(qp.result, "try-error")) stop(paste("No solution found:", result)) + if(inherits(qp.result, "try-error")) stop(paste("No solution found:", qp.result)) wts <- qp.result$solution # print(round(wts,4)) @@ -770,7 +774,7 @@ qp.result <- try(solve.QP(Dmat=make.positive.definite(2*lambda*V), dvec=d, Amat=t(Amat), bvec=rhs, meq=meq), silent=TRUE) - if(inherits(qp.result, "try-error")) stop(paste("No solution found:", result)) + if(inherits(qp.result, "try-error")) stop(paste("No solution found:", qp.result)) wts <- qp.result$solution w.buy <- qp.result$solution[(N+1):(2*N)] From noreply at r-forge.r-project.org Fri Oct 25 19:05:03 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Oct 2013 19:05:03 +0200 (CEST) Subject: [Returnanalytics-commits] r3240 - pkg/PortfolioAnalytics/R Message-ID: <20131025170503.33BE81853A6@r-forge.r-project.org> Author: rossbennett34 Date: 2013-10-25 19:05:02 +0200 (Fri, 25 Oct 2013) New Revision: 3240 Modified: pkg/PortfolioAnalytics/R/extract.efficient.frontier.R pkg/PortfolioAnalytics/R/optFUN.R pkg/PortfolioAnalytics/R/optimize.portfolio.R Log: Modifications for max Sharpe Ratio, max STARR, and efficient frontiers. Modified: pkg/PortfolioAnalytics/R/extract.efficient.frontier.R =================================================================== --- pkg/PortfolioAnalytics/R/extract.efficient.frontier.R 2013-10-23 17:54:52 UTC (rev 3239) +++ pkg/PortfolioAnalytics/R/extract.efficient.frontier.R 2013-10-25 17:05:02 UTC (rev 3240) @@ -100,7 +100,7 @@ if(objnames == "mean"){ # The user has only passed in a mean objective, add a var objective to the portfolio portfolio <- add.objective(portfolio=portfolio, type="risk", name="var") - } else if(objnames == "var"){ + } else if(objnames %in% c("var", "sd", "StdDev")){ # The user has only passed in a var objective, add a mean objective portfolio <- add.objective(portfolio=portfolio, type="return", name="mean") } Modified: pkg/PortfolioAnalytics/R/optFUN.R =================================================================== --- pkg/PortfolioAnalytics/R/optFUN.R 2013-10-23 17:54:52 UTC (rev 3239) +++ pkg/PortfolioAnalytics/R/optFUN.R 2013-10-25 17:05:02 UTC (rev 3240) @@ -353,14 +353,15 @@ if(all(moments$mean == 0)){ moments$mean <- colMeans(R) } + } else { + moments$mean <- rep(0, N) + target <- 0 } - Rmin <- ifelse(is.na(target), 0, target) - Amat <- cbind(rbind(1, 1, moments$mean, coredata(R)), rbind(0, 0, 0, cbind(diag(T), 1))) dir.vec <- c(">=","<=",">=",rep(">=",T)) - rhs.vec <- c(constraints$min_sum, constraints$max_sum, Rmin ,rep(0, T)) - + rhs.vec <- c(constraints$min_sum, constraints$max_sum, target ,rep(0, T)) + if(try(!is.null(constraints$groups), silent=TRUE)){ n.groups <- length(constraints$groups) Amat.group <- matrix(0, nrow=n.groups, ncol=N) @@ -833,6 +834,7 @@ ub_etl <- as.numeric(ub_etl$out) # starr at the upper bound ub_starr <- ub_mean / ub_etl + if(is.infinite(ub_starr)) stop("Inf value for STARR, objective value is 0") # Find the starr at the minimum etl portfolio if(!is.null(constraints$max_pos)){ @@ -840,20 +842,29 @@ } else { lb_etl <- etl_opt(R=R, constraints=constraints, moments=moments, target=NA, alpha=alpha) } - lb_weights <- matrix(lb_etl$weights) - lb_mean <- as.numeric(t(lb_weights) %*% fmean) + lb_weights <- matrix(lb_etl$weights) + lb_mean <- as.numeric(t(lb_weights) %*% fmean) lb_etl <- as.numeric(lb_etl$out) + # starr at the lower bound lb_starr <- lb_mean / lb_etl + # if(is.infinite(lb_starr)) stop("Inf value for STARR, objective value is 0") + # set lb_starr equal to 0, should this be a negative number like -1e6? + # the lb_* values will be 0 for a dollar-neutral strategy so we need to reset the values + if(is.na(lb_starr) | is.infinite(lb_starr)) lb_starr <- 0 + + # cat("ub_starr", ub_starr, "\n") + # cat("lb_starr", lb_starr, "\n") + # want to find the return that maximizes mean / etl i <- 1 while((abs(ub_starr - lb_starr) > tol) & (i < maxit)){ # bisection method to find the maximum mean / etl # print(i) - # print(ub_starr) - # print(lb_starr) + # cat("ub_starr", ub_starr, "\n") + # cat("lb_starr", lb_starr, "\n") # print("**********") # Find the starr at the mean return midpoint new_ret <- (lb_mean + ub_mean) / 2 @@ -920,13 +931,19 @@ ub_sr <- ub_mean / ub_sd # Calculate the sr at the miminum var portfolio - lb_sr <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1e6, target=NA, lambda_hhi=lambda_hhi, conc_groups=conc_groups) + tmpmoments <- moments + tmpmoments$mean <- rep(0, length(moments$mean)) + lb_sr <- gmv_opt(R=R, constraints=constraints, moments=tmpmoments, lambda=1, target=NA, lambda_hhi=lambda_hhi, conc_groups=conc_groups) lb_weights <- matrix(lb_sr$weights) lb_mean <- as.numeric(t(lb_weights) %*% fmean) lb_sd <- as.numeric(sqrt(t(lb_weights) %*% moments$var %*% lb_weights)) # sr at the lower bound lb_sr <- lb_mean / lb_sd + # cat("lb_mean:", lb_mean, "\n") + # cat("ub_mean:", ub_mean, "\n") + # print("**********") + # want to find the return that maximizes mean / sd i <- 1 while((abs(ub_sr - lb_sr) > tol) & (i < maxit)){ @@ -934,7 +951,7 @@ # Find the starr at the mean return midpoint new_ret <- (lb_mean + ub_mean) / 2 - mid <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups) + mid <- gmv_opt(R=R, constraints=constraints, moments=tmpmoments, lambda=1, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups) mid_weights <- matrix(mid$weights, ncol=1) mid_mean <- as.numeric(t(mid_weights) %*% fmean) mid_sd <- as.numeric(sqrt(t(mid_weights) %*% moments$var %*% mid_weights)) @@ -942,7 +959,8 @@ # tmp_sr <- mid_sr # print(i) - # print(mid_sr) + # cat("new_ret:", new_ret, "\n") + # cat("mid_sr:", mid_sr, "\n") # print("**********") if(mid_sr > ub_sr){ @@ -950,7 +968,7 @@ ub_mean <- mid_mean ub_sr <- mid_sr new_ret <- (lb_mean + ub_mean) / 2 - mid <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups) + mid <- gmv_opt(R=R, constraints=constraints, moments=tmpmoments, lambda=1, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups) mid_weights <- matrix(mid$weights, ncol=1) mid_mean <- as.numeric(t(mid_weights) %*% fmean) mid_sd <- as.numeric(sqrt(t(mid_weights) %*% moments$var %*% mid_weights)) @@ -960,7 +978,7 @@ lb_mean <- mid_mean lb_sr <- mid_sr new_ret <- (lb_mean + ub_mean) / 2 - mid <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=1, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups) + mid <- gmv_opt(R=R, constraints=constraints, moments=tmpmoments, lambda=1, target=new_ret, lambda_hhi=lambda_hhi, conc_groups=conc_groups) mid_weights <- matrix(mid$weights, ncol=1) mid_mean <- as.numeric(t(mid_weights) %*% fmean) mid_sd <- as.numeric(sqrt(t(mid_weights) %*% moments$var %*% mid_weights)) Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R =================================================================== --- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-10-23 17:54:52 UTC (rev 3239) +++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2013-10-25 17:05:02 UTC (rev 3240) @@ -805,6 +805,7 @@ if(hasArg(maxSR)) maxSR=match.call(expand.dots=TRUE)$maxSR else maxSR=FALSE if(maxSR){ target <- max_sr_opt(R=R, constraints=constraints, moments=moments, lambda=lambda, target=target, lambda_hhi=lambda_hhi, conc_groups=conc_groups) + moments$mean <- rep(0, length(moments$mean)) } roi_result <- gmv_opt(R=R, constraints=constraints, moments=moments, lambda=lambda, target=target, lambda_hhi=lambda_hhi, conc_groups=conc_groups) weights <- roi_result$weights From noreply at r-forge.r-project.org Wed Oct 30 22:53:15 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 30 Oct 2013 22:53:15 +0100 (CET) Subject: [Returnanalytics-commits] r3241 - pkg/PerformanceAnalytics/R Message-ID: <20131030215315.A478E1856A2@r-forge.r-project.org> Author: peter_carl Date: 2013-10-30 22:53:15 +0100 (Wed, 30 Oct 2013) New Revision: 3241 Modified: pkg/PerformanceAnalytics/R/chart.TimeSeries.R Log: - repairs a bug in passing cex.lab and cex.main into dots within title Modified: pkg/PerformanceAnalytics/R/chart.TimeSeries.R =================================================================== --- pkg/PerformanceAnalytics/R/chart.TimeSeries.R 2013-10-25 17:05:02 UTC (rev 3240) +++ pkg/PerformanceAnalytics/R/chart.TimeSeries.R 2013-10-30 21:53:15 UTC (rev 3241) @@ -351,8 +351,8 @@ # Add the other titles if(is.null(main)) main=columnnames[1] - title(ylab = ylab, cex = cex.lab) - title(main = main, cex = cex.main) + title(ylab = ylab, cex.lab = cex.lab) + title(main = main, cex.main = cex.main) }