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.
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.
