## Friday, August 10, 2012

### Universal portfolio, part 10

Part 9 compared the wealth of Universal against other portfolio selection algorithms by using the experimental cumulative distribution function of the relative wealth.  This leads to a very compact representation, but it completely hides the absolute level evolution as the number of stocks in a portfolio increases.

The code below uses a slightly different approach, it uses a scatterplot where the final absolute wealth of two different algorithms are used for the x and y axes.  The main diagonal corresponds to both algorithms having an equal final wealth.  To provide more information, side graphs with the marginal probability of final wealth are included.

Finally, an other reference is added, the best CRP, using the optimization code in package logopt.

As in part 9, the code recalculates the value of Universal final wealth across all 4-tuples and thus takes one day to run if you did not have yet the results in your environment, be warned. Also, the code presentation uses Syntax Highlighter, I am still experimenting with the best way to present R code.

# Performance of Universal compared to some references

library(logopt)
x <- coredata(nyse.cover.1962.1984)
w <- logopt:::x2w(x)
nDays <- dim(x)[1]
nStocks <- dim(x)[2]
Days <- 1:nDays
iWin <- 1 ; plot(1:10)

TupleSizes <- c(2,3,4)
EvaluateOnAllTuples <- function(ListName, TupleSizes, fFinalWealth, ...) {
if (exists(ListName) == FALSE) {
LocalList <- list()
for (i in 1:length(TupleSizes)) {
TupleSize <- TupleSizes[i]
ws <- combn(x=(1:nStocks), m=(TupleSize), FUN=fFinalWealth, simplify=TRUE, ...)
LocalList[[i]] <- ws
}
assign(ListName, LocalList, pos=parent.frame())
}
}

UniversalFinalWealth <- function(cols, ...) {
x <- list(...)[[1]] ; n <- list(...)[[2]]
uc <- universal.cover(x[,cols], 20)
return(uc[length(uc)])
}
EvaluateOnAllTuples("lUniversalFinalWealth", TupleSizes, UniversalFinalWealth, x, 20)

BestStockFinalWealth <- function(cols, ...) {
w <- list(...)[[1]]
return(max(w[nDays,cols]))
}
EvaluateOnAllTuples("lBestStockFinalWealth", TupleSizes, BestStockFinalWealth, w)

UcrpFinalWealth <- function(cols, ...) {
x <- list(...)[[1]]
ucrp <- crp(x[,cols])
return(ucrp[length(ucrp)])
}
EvaluateOnAllTuples("lUcrpFinalWealth", TupleSizes, UcrpFinalWealth, x)

BhFinalWealth <- function(cols, ...) {
x <- list(...)[[1]]
ubh <- bh(x[,cols])
return(ubh[length(ubh)])
}
EvaluateOnAllTuples("lBhFinalWealth", TupleSizes, BhFinalWealth, x)

BestCrpFinalWealth <- function(cols, ...) {
x <- list(...)[[1]]
bopt <- bcrp.optim(x[,cols])
bcrp <- crp(x[,cols],bopt)
return(bcrp[length(bcrp)])
}
EvaluateOnAllTuples("lBestCrpFinalWealth", TupleSizes, BestCrpFinalWealth, x)

Colors <- c("blue","green","red")

CompareFinalAbsoluteWealth <- function( L0, L1, MainString, TupleSizes=TupleSizes, clip=0.01,
Colors=c("blue","green","red"), PlotChar = 19, PlotSize = 0.5,
XLabel="Universal wealth", YLabel="Other wealth") {
nLines <- min(length(L0),length(L1))
if (clip > 0) { MaxUp <- quantile(c(L0[[nLines]], L1[[nLines]]), 1-clip) }
else          { MaxUp <- max(L0, L1) }
XLims = c(0, MaxUp)
layout( matrix( c(0,2,2,1,3,3,1,3,3),ncol=3) )
d.x <- density(L0[[1]])
plot(d.x$x, d.x$y, xlim=XLims, type='l', col=Colors[1], main="Density on x axis", xlab="", ylab="")
grid()
for (i in 1:nLines) {
d.x <- density(L0[[i]])
lines(d.x$x, d.x$y, type='l', col=Colors[i])
abline(v=mean(L0[[i]]), col=Colors[i])
}
d.y <- density(L1[[1]])
plot(d.y$y, d.y$x, ylim=XLims, xlim=rev(range(d.y$y)), type='l', col=Colors[1], , main="Density on y axis", xlab="", ylab="") grid() for (i in 1:nLines) { d.y <- density(L1[[i]]) lines(d.y$y, d.y\$x, type='l', col=Colors[i])
abline(h=mean(L1[[i]]), col=Colors[i])
}
plot(L0[[nLines]], L1[[nLines]], col=Colors[nLines], pch=PlotChar, cex=PlotSize,
xlab=XLabel, ylab=YLabel, xlim= XLims, ylim= XLims, type="p", main=MainString)
for (j in 1:nLines) {
i <- nLines - j + 1
points(L0[[i]], L1[[i]], col=Colors[i], pch=PlotChar, cex=PlotSize)
rug(L0[[i]], col=Colors[i],ticksize=0.01*i)
rug(L1[[i]], col=Colors[i],ticksize=0.01*i, side=2)
}
abline(0,1,col="lightgray",lwd=2)
legend("topright", legend=c("2 stocks","3 stocks","4 stocks"), pch=PlotChar, col=Colors, bg="white")
grid()
}

if(length(dev.list()) < iWin) { x11() } ; iWin <- iWin + 1 ; dev.set(iWin) ;
CompareFinalAbsoluteWealth(lUniversalFinalWealth, lBestStockFinalWealth, "Universal relative to best stock final wealth", TupleSizes)

if(length(dev.list()) < iWin) { x11() } ; iWin <- iWin + 1 ; dev.set(iWin) ;
CompareFinalAbsoluteWealth(lUniversalFinalWealth, lBhFinalWealth, "Universal relative to uniform buy and hold final wealth", TupleSizes)

if(length(dev.list()) < iWin) { x11() } ; iWin <- iWin + 1 ; dev.set(iWin) ;
CompareFinalAbsoluteWealth(lUniversalFinalWealth, lUcrpFinalWealth, "Universal relative to uniform CRP final wealth", TupleSizes)

if(length(dev.list()) < iWin) { x11() } ; iWin <- iWin + 1 ; dev.set(iWin) ;
CompareFinalAbsoluteWealth(lUniversalFinalWealth, lBestCrpFinalWealth, "Universal relative to best CRP final wealth", TupleSizes)

# a function to compare the ECDF of two lists of final wealths
CompareFinalRelativeWealth <- function( L0, L1, MainString, TupleSizes=TupleSizes,
Colors=c("blue","green","red"), PlotChar = ".",
XLabel="Ratio of final wealths", YLabel="Cumulative probability") {
nLines <- min(length(L0),length(L1))
LR <- list() ; XLims = c()
for(i in 1:nLines) { LR[[i]] <- L0[[i]]/L1[[i]] ; XLims <- range(XLims, LR[[i]]) }
plot(ecdf(L0[[1]]/L1[[1]]), pch=PlotChar, col=Colors[1], main=MainString,
xlab=XLabel, ylab=YLabel, xlim= XLims)
abline(v=1,col="gray",lwd=2)
for (i in 1:nLines) {
lines(ecdf(L0[[i]]/L1[[i]]), pch=PlotChar, col=Colors[i])
}
legend("bottomright", legend=c("2 stocks","3 stocks","4 stocks"), fill=Colors)
grid()
# show best relative wealth and its composition
for (i in 1:length(TupleSizes)) {
TupleSize <- TupleSizes[i]
BestTuple <- which.max(LR[[i]])
BestStocks <- combn(1:nStocks, TupleSize)[,BestTuple]
cat(sprintf("Max final relative wealth %.4f for stocks: ", LR[[i]][BestTuple]))
cat(colnames(x)[BestStocks]) ; cat("\n")
}
}

if(length(dev.list()) < iWin) { x11() } ; iWin <- iWin + 1 ; dev.set(iWin) ;
CompareFinalRelativeWealth(lUniversalFinalWealth, lBestCrpFinalWealth, "Universal relative to best CRP final wealth", TupleSizes)


The first graph compares Universal to the best stock in the portfolio.  It also shows that the density function is not an ideal solution when the set of possible outcomes is discrete.  The ecdf function would be a better choice in this case.  The plot is also slightly misleading when compared to the equivalent plot of relative wealth in part 9.  The problem is that points overlap and so the 2D density cannot be assessed except for the set of blue points.

The next graph shows a comparison of Universal and Uniform CRP.  The graph works reasonably well in this case because both axes have smooth marginal distributions.  As for the corresponding graph of relative wealth, we can clearly see that UCRP is simply better, but now we can also see that this is especially true for the best performing portfolios.

The comparison between Universal and Uniform Buy and Hold below also works well.  And this time also we can see that the ratio gets better for better performing portfolios, but now with Universal the better algorithm

Finally the comparison between the Best CRP (in hindsight) and Universal shows that BCRP is always better.  Because the probability density function of the best CRP is less smooth, the comparison is not perfect, but it seems that the ratio degrades as the number of stocks in the portfolio increases.  This is expected given that the performance bound of Universal decreases as the number of stocks increase.

Plotting the ECDF of the relative wealth shows this effect much more vividly, clearly illustrating the advantage of looking at the same data in different fashions.

1. This has also impacted my code, as R studio automatically stacks your plots. Best PPI Claims Service

2. Great post!!
Compared with UCRP and BCRP, UP does not seem to work as Cover described in his paper, does it?

1. No, UP works as expected, but the original article selected examples that were presenting UP in the best possible way for obvious reasons.

3. Hello,
assignment help
assignment help australia

4. Hi,
This is really great work. Thank you for sharing such a useful piece of information here in the blog.
Assignment Help UK
Assignment Writing Help UK

5. I will be really glad my spouse and I witnessed an excellent web site. I have to thank a lot a lot of information! I enjoy we have saved your website for brand new things to examine sand on the roads.
Advertising agencies in UK | Mobile apps for university

6. Things are very open and intensely clear explanation of issues. was truly information. Your website is very beneficial.
Dissertation Guidance
Online Dissertation Help

7. This is really great work. Thank you for sharing such a useful information here in the blog for students.Operations Management Project

8. This site and the resources you provide is really nice keep it up. my homework help

9. I appreciate this work amazing post for us I like it. Key Elements Sociology Homework

10. Great info! I recently came across your blog and have been reading along. I thought I would leave my first comment. I don’t know what to say except that I have Traditional Authority Sociology Help

11. This was a great and interesting article to read. I have really enjoyed all of this very cool information Tomato Nutrition

12. Well thanks for posting such an outstanding idea. I like this blog & I like the topic and thinking of making it right. Accounting Assignment Help