Nothing
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
################################################################################
# FUNCTION: DESCRIPTION:
# backtestPlot Creates a summary of backtesting plots
# backtestAssetsPlot Plots assets used in a portfolio backtest
# backtestWeightsPlot Plots recommended weights from a backtest
# backtestRebalancePlot Plots rebalanced weights of a backtest
# backtestPortfolioPlot Plots benchmark and portfolio series
# backtestDrawdownPlot Plots the drawdown of the portfolio backtest
# backtestReportPlot Prints backtest report
################################################################################
backtestPlot <-
function(object, which = "all", labels = TRUE, legend = TRUE,
at = NULL, format = NULL, cex=0.6, font=1, family="mono")
{
# A function implemented by Diethelm Wuertz and William Chen
# Description:
# Creates a summary of backtesting plots
# Arguments:
# object - a list as returned by the function portfolioSmoothing()
# which - which plots should be displayed
# labels - a logical flag, should automated labels added to the plot
# FUNCTION:
# Frame:
if (any(which == "all"))
par(mfrow = c(3, 2), mar = c(1.5, 4, 5, 2), oma = c(5, 1, 0, 1))
# Plot:
if(any(which == "1") || which == "all")
backtestAssetsPlot (object, labels, legend, at, format)
if(any(which == "2") || which == "all")
backtestWeightsPlot (object, labels, legend, at, format)
if(any(which == "3") || which == "all")
backtestRebalancePlot (object, labels, legend, at, format)
if(any(which == "4") || which == "all")
backtestPortfolioPlot(object, labels, legend, at, format)
if(any(which == "5") || which == "all")
backtestDrawdownPlot(object, labels, legend, at, format)
if(any(which == "6" )|| which == "all")
backtestReportPlot(object, cex=cex, font=font, family=family)
# Return Value:
invisible()
}
# ------------------------------------------------------------------------------
# Plot 1:
backtestAssetsPlot <-
function(object, labels=TRUE, legend=TRUE, at=NULL, format=NULL)
{
# A function implemented by Diethelm Wuertz and William Chen
# Description:
# Plots assets used in a portfolio backtest
# Arguments:
# object - a list as returned by the function portfolioSmoothing()
# labels - a logical flag, should automated labels added to the plot
# FUNCTION:
# Settings:
data <- object$data
benchmark <- object$benchmarkName
assets <- object$assetsNames
# Time Axis:
if (is.null(at)) at <- paste(unique(atoms(time(data))[,1]), "12-31", sep="-")
if (is.null(format)) Format <- "%b/%y" else Format <- format
# Labels ?
if (labels) {
main <- "Index Series"
xlab <- ""
ylab <- "Cumulated log Returns"
} else {
main <- ""
xlab <- ""
ylab <- ""
}
# Series:
X <- data[, benchmark]
# ylim - Plot Range:
nAssets <- length(assets)
MAX <- -1.0e99
for (i in 1:nAssets) MAX = max(c(MAX, cumsum(data[, assets[i]])) )
MAX <- max(MAX, cumsum(data[, benchmark]))
MIN <- 1.0e99
for (i in 1:nAssets) MIN <- min(MIN, cumsum(data[, assets[i]]))
MIN <- min(MIN, cumsum(data[, benchmark]))
rangeY <- c(MIN, MAX)
# xlim - Plot Range:
xlim <- range(time(colCumsums(data[, benchmark])))
shift <- round(0.20 *as.integer(diff(xlim)), 0) * 24 * 60 * 60
rangeX <- c(round(xlim[1]-shift), xlim[2])
Days <- 1:as.integer(diff(xlim))
Time <- as.character(xlim[1] + Days*24*60*60)
range.tS <- timeSeries(data = matrix(rep(0, length(Time))), as.character(Time))
# Limits:
xlim <- rangeX
ylim <- rangeY
# Plot:
plot(X, type = "n", xaxt = "n", at = at, format = Format,
xlim = xlim, ylim = ylim, main = "", xlab = "", ylab = "")
grid(NA, ny = NULL)
abline(v = as.POSIXct(at), lty = 3, col = "brown")
# Add Lines:
lines(colCumsums(data[, benchmark]), col = "black")
lines(colCumsums(data[, benchmark]), col = "black")
for (i in 1:nAssets) lines( colCumsums(data[, assets[i]]), col = i+1)
# Asset Names:
Benchmark <- abbreviate(benchmark, 4)
Assets <- abbreviate(assets, 4)
assetsList <- c(Benchmark, Assets)
assetsTitle <- paste(Benchmark, " ~ ",
paste( Assets, collapse = " - ", sep = ""), sep="")
# Add Title:
if (labels) {
title(main = main, xlab = xlab, ylab = ylab)
}
# Add Legend and Subtitle:
if (legend) {
mtext(assetsTitle, line = 0.5, cex = 0.7)
legend("topleft",
legend = assetsList,
bty = "n",
text.col = 1:(nAssets+1),
cex = 0.8)
}
# Return Value:
invisible()
}
# ------------------------------------------------------------------------------
# Plot 2:
backtestWeightsPlot <-
function(object, labels=TRUE, legend=TRUE, at=NULL, format=NULL)
{
# A function implemented by Diethelm Wuertz and William Chen
# Description:
# Plots recommended weights from a portfolio backtest
# Arguments:
# object - a list as returned by the function portfolioSmoothing()
# labels - a logical flag, should automated labels added to the plot
# FUNCTION:
# Settings:
data <- object$data
weights <- object$smoothWeights
assets <- object$assetsNames
benchmark <- object$benchmarkName
horizon <- getWindowsHorizon(object$backtest)
smoothing <- getSmootherLambda(object$backtest)
startup <- "1m"
horizonLength = as.numeric(substr(horizon, 1, nchar(horizon)-1))
horizonUnit = substr(horizon, nchar(horizon), nchar(horizon))
stopifnot(horizonUnit == "m")
# Time Axis:
if (is.null(at)) at <- paste(unique(atoms(time(data))[,1]), "12-31", sep="-")
if (is.null(format)) Format <- "%b/%y" else Format <- format
# Labels ?
if (labels) {
main <- "Weights Recommendation"
xlab <- ""
ylab <- "Asset Weights %"
} else {
main <- ""
xlab <- ""
ylab <- ""
}
# Series:
X <- data[, benchmark]
nAssets <- length(assets)
naWeights <- matrix(rep(NA, times=horizonLength*nAssets), ncol=nAssets)
# Lmits:
xlim <- range(data)
ylim <- c(0, 100)
# Plot:
plot(X, type = "n", xaxt = "n", las = 2, at = at, format = Format,
xlim = xlim, ylim = ylim, main = "", xlab = "", ylab = "")
grid(NA, ny = NULL)
abline(v = as.POSIXct(at), lty = 3, col = "brown")
# Add Lines:
lines(X, col = "black")
tS <- 100 * timeSeries(weights)
for (i in 1:nAssets) lines(tS[, i], col = i+1)
# Asset Names:
Benchmark <- abbreviate(benchmark, 4)
Assets <- abbreviate(assets, 4)
assetsList <- c(Benchmark, Assets)
assetsTitle <- paste(Benchmark, " ~ ",
paste(Assets, collapse = " - ", sep = ""), sep="")
# Add Title:
if (labels) {
title(main = main, xlab = xlab, ylab = ylab)
text <- paste(
"Horizon = ", horizon,
"| Smoothing:", smoothing,
"| Startup:", startup,
"| Shift 1m")
mtext(text, line = 0.5, cex = 0.7)
}
# Add Legend:
if (legend) {
legend("topleft",
legend = assetsList,
bty = "n",
text.col = 1:(nAssets+1),
cex = 0.8)
}
# Return Value:
invisible()
}
# ------------------------------------------------------------------------------
# Plot 3:
backtestRebalancePlot <-
function(object, labels=TRUE, legend=TRUE, at=NULL, format=NULL)
{
# A function implemented by Diethelm Wuertz and William Chen
# Description:
# Plots rebalanced weights of a backtest
# Arguments:
# object - a list as returned by the function portfolioSmoothing()
# labels - a logical flag, should automated labels added to the plot
# FUNCTION:
# Settings:
data <- object$data
weights <- object$smoothWeights
assets <- object$assetsNames
benchmark <- object$benchmarkName
horizon <- getWindowsHorizon(object$backtest)
smoothing <- getSmootherLambda(object$backtest)
startup <- "1m"
horizonLength <- as.numeric(substr(horizon, 1, nchar(horizon)-1))
horizonUnit <- substr(horizon, nchar(horizon), nchar(horizon))
stopifnot(horizonUnit == "m")
horizon <- horizonLength
# Time Axis:
if (is.null(at)) at <- paste(unique(atoms(time(data))[,1]), "12-31", sep="-")
if (is.null(format)) Format <- "%b/%y" else Format <- format
# Labels ?
if (labels) {
main <- "Weights Rebalance"
xlab <- ""
ylab <- "Weights Changes %"
} else {
main <- ""
xlab <- ""
ylab <- ""
}
# Series:
X <- data[, benchmark]
nAssets <- length(assets)
naWeights <- matrix(rep(NA, times = horizon * nAssets), ncol = nAssets)
naWeights <- rbind(naWeights, rep(NA, times = nAssets))
diffWeights <- rbind(naWeights, diff(weights))
absSum <- function(x) { sum(abs(x)) }
diffWeights <- apply(diffWeights, 1, FUN = absSum)
diffWeights <- cbind(diffWeights, rbind(naWeights, diff(weights)))
tS <- 100 * timeSeries(diffWeights[-seq(horizon + 1),],
charvec = rownames(diffWeights)[-seq(horizon + 1)])
# Limits:
xlim <- range(time(data))
ylim <- range(tS)
# Plot:
plot(X, type = "n", xaxt = "n", las = 2, at = at, format = Format,
xlim = xlim, ylim = ylim, main = "", xlab = "", ylab = "")
grid(NA, ny = NULL)
abline(v = as.POSIXct(at), lty = 3, col = "brown")
abline(h=0, col="darkgrey")
# Add Lines:
# lines(X)
lines(tS[, 1], type = "h", lwd = 1, col = "darkgrey")
for (i in 2:NCOL(tS)) lines(tS[, i], col = i)
# Asset Names:
Benchmark <- abbreviate(benchmark, 4)
Assets <- abbreviate(assets, 4)
assetsList <- c(Benchmark, Assets)
assetsTitle <- paste(Benchmark, " ~ ",
paste(Assets, collapse = " - ", sep = ""), sep="")
# Add Title:
if (labels) {
title(main = main, xlab = xlab, ylab = ylab)
text <- paste(
"Horizon = ", horizon,
"| Smoothing:", smoothing,
"| Startup:", startup,
"| Shift 1m")
mtext(text, line = 0.5, cex = 0.7)
# mText = paste("Start:", rownames(object$smoothWeights)[1])
# mtext(mText, side = 4, line = 0, adj = 0, col = "darkgrey", cex = 0.65)
}
# Add Legend:
if (legend) {
legend("topleft",
legend = assetsList,
bty = "n",
text.col = 1:(nAssets+1),
cex = 0.8)
}
# Return Value:
invisible()
}
# ------------------------------------------------------------------------------
# Plot 4:
backtestPortfolioPlot <-
function(object, labels=TRUE, legend=TRUE, at=NULL, format=NULL)
{
# A function implemented by Diethelm Wuertz and William Chen
# Description:
# Plots daily, benchmark and portfolio series of a portfolio backtest
# Arguments:
# object - a list as returned by the function portfolioSmoothing()
# labels - a logical flag, should automated labels added to the plot
# FUNCTION:
# Settings:
data <- object$data
portfolioReturns <- object$portfolioReturns
benchmarkReturns <- object$benchmarkReturns
assets <- object$assetsNames
benchmark <- object$benchmarkName
horizon <- getWindowsHorizon(object$backtest)
smoothing <- getSmootherLambda(object$backtest)
startup <- "1m"
offsetReturn <- object$offsetReturn
# Time Axis:
if (is.null(at)) at <- paste(unique(atoms(time(data))[,1]), "12-31", sep="-")
if (is.null(format)) Format <- "%b/%y" else Format <- format
# Labels ?
if (labels) {
main <- "Portfolio vs Benchmark"
xlab <- ""
ylab <- "Cumulated log Returns"
} else {
main <- ""
xlab <- ""
ylab <- ""
}
# Series:
X <- data[, benchmark]
# Cumulated Return Series:
cumX <- colCumsums(X)
cumP <- portfolioReturns + offsetReturn
cumB <- benchmarkReturns + offsetReturn
offsetTS <- timeSeries(offsetReturn, charvec = names(offsetReturn),
units = "offsetReturn")
cumP <- rbind(offsetTS, cumP)
cumB <- rbind(offsetTS, cumB)
MAX <- max(as.vector(series(cumP)), as.vector(series(cumB)),
as.vector(series(cumX)))
MIN <- min(as.vector(series(cumP)), as.vector(series(cumB)),
as.vector(series(cumX)))
# Limits:
xlim <- c(as.POSIXct(start(X)), as.POSIXct(end(X)))
ylim <- c(MIN, MAX)
# Plot:
plot(X, type = "n", xaxt = "n", at = at, format = Format,
xlim = xlim, ylim = ylim, main = "", xlab = "", ylab = "")
grid(NA, ny = NULL)
abline(v = as.POSIXct(at), lty = 3, col = "brown")
abline(h=0, col="darkgrey")
# Add Lines:
lines(cumX, col = "black")
lines(cumP-cumB, type = "h", col = "grey")
lines(cumP, col = "red", lwd = 2)
lines(cumB, col = "blue", lwd = 2)
# Asset Names:
Benchmark <- abbreviate(benchmark, 4)
Assets <- abbreviate(assets, 4)
assetsList <- c(Benchmark, Assets)
assetsTitle <- paste(Benchmark, " ~ ",
paste(Assets, collapse = " - ", sep = ""), sep="")
nAssets <- length(assetsList)
# Add Title:
if (labels) {
title(main = main, xlab = xlab, ylab = ylab)
text <- paste(
"Horizon = ", horizon,
"| Smoothing:", smoothing,
"| Startup:", startup,
"| Shift 1m")
mtext(text, line = 0.5, cex = 0.7)
# mText <- Type = getType(object$spec)
# Estimator <- getEstimator(object$spec)
# if (Type == "MV") mText = paste(mText, "|", Estimator)
# mtext(mText, side = 4, line = 0, adj = 0, col = "darkgrey", cex = 0.7)
}
# Add Legend:
if (legend) {
legend("topleft",
legend = assetsList,
bty = "n",
text.col = 1:(nAssets+1),
cex = 0.8)
}
# Return Value:
invisible()
}
# ------------------------------------------------------------------------------
# Plot 5:
backtestDrawdownPlot <-
function(object, labels=TRUE, legend=TRUE, at=NULL, format=NULL)
{
# A function implemented by Diethelm Wuertz and William Chen
# Description:
# Creates Backtest Portfolio Plot
# Arguments:
# object - a list as returned by the function portfolioSmoothing()
# labels - a logical flag, should automated labels added to the plot
# FUNCTION:
# Settings:
data <- object$data
assets <- object$assetsNames
benchmark <- object$benchmarkName
horizon <- getWindowsHorizon(object$backtest)
smoothing <- getSmootherLambda(object$backtest)
startup <- getSmootherInitialWeights(object$backtest)
weights <- as.timeSeries(object$smoothWeights)
# Align Data:
## 2022-10-11 GNB: was: Data <- .align.timeSeries(data)/100
## assuming that data is a 'timeSeries' objec, which seems it is,
## but I was not able to verify this since there are no examples with it
## and the documentation is unclear (or rather, I got lost).
## Note: the timeSeries method for align() is '.align.timeSeries'
Data <- align(data)/100
# Time Axis:
if (is.null(at)) at <- paste(unique(atoms(time(data))[,1]), "12-31", sep="-")
if (is.null(format)) Format <- "%b/%y" else Format <- format
# Labels ?
if (labels) {
main <- "Portfolio vs Benchmark"
xlab <- ""
ylab <- "Drawdown"
} else {
main <- ""
xlab <- ""
ylab <- ""
}
# Extract the Time Stamps:
tS <- time(Data)
tW <- time(weights)
# Problem when rebalance day lands on a Weekend -
# need to change the date to the nearest Monday
if (any(isWeekend(tW))){
weekend.tW <- tW[isWeekend(tW)]
# WC: check timeNdayOnOrAfter function, the nday = 2 is a Monday!???
tW <- sort(c(tW[!isWeekend(tW)], timeNdayOnOrAfter(weekend.tW, 2)))
# replace old times with new times
time(weights) <- tW
}
# Extract the Updated Revalance Dates:
Dates <- time(weights)
# Subsetting the Data:
data <- window(Data, start(weights), end(weights))
# Check whether we have data past the last balance date
# i.e. last balance date won't take place if we don't have the return series
if (end(data) < end(weights)){
n <- length(Dates)-1
} else {n = length(Dates)
Dates <- c(Dates, end(data))
}
# Calculate the portfolio returns for the given weights:
# assume we start investing the new weights on the rebalance date
pf <- NULL
a <- NULL
for (i in 1:n){
temp <- window(data, Dates[i], Dates[i+1])[,assets]
nr <- nrow(temp)
if (i != n) temp = temp[-nr,]
a <- c(a, nrow(temp))
pf <- c(pf, pfolioReturn(temp, as.numeric(weights[i,])))
}
# Drawdown Plot Settings:
stopifnot(length(pf) == length(rownames(data)))
pf <- timeSeries(pf, charvec = rownames(data))
pf.DD <- drawdowns(pf)
benchmark.DD <- drawdowns(data[,benchmark])
# Series:
X <- Data[, benchmark]
# Limits:
xlim <- c(as.POSIXct(start(X)), as.POSIXct(end(X)))
ylim <- range(c(pf.DD, benchmark.DD))
# Plot:
plot(X, type = "n", xaxt = "n", at = at, format = Format,
xlim = xlim, ylim = ylim, main = "", xlab = "", ylab = "")
grid(NA, ny = NULL)
abline(v = as.POSIXct(at), lty = 3, col = "brown")
# Add Lines:
lines(benchmark.DD, col = "blue", lwd = 2)
lines(pf.DD, col = "red", lwd = 2)
# Asset Names:
Benchmark <- abbreviate(benchmark, 4)
Assets <- abbreviate(assets, 4)
assetsList <- c(Benchmark, Assets)
assetsTitle <- paste(Benchmark, " ~ ",
paste(Assets, collapse = " - ", sep = ""), sep="")
# Add Title:
if (labels) {
title(main = main, xlab = xlab, ylab = ylab)
text <- paste("(Max)", "Portfolio DD =", round(min(pf.DD),2),
"|", "Benchmark DD =", round(min(benchmark.DD),2))
mtext(text, line = 0.5, cex = 0.7)
}
# Add Legend:
if (legend) {
legend("bottomleft",
legend = c("Benchmark", "Portfolio"),
bty = "n",
text.col = c("blue", "red"),
cex = 0.8)
}
# Return Value:
invisible()
}
# ------------------------------------------------------------------------------
# Plot 6 - Report:
backtestReportPlot <-
function(object, cex=0.6, font=1, family="mono")
{
# A function implemented by Diethelm Wuertz and William Chen
# Description:
# Prints backtest report as graphical plot
# Arguments:
# object - a list as returned by the function portfolioSmoothing()
# FUNCTION:
# Settings:
CEX <- cex
# Start Plot:
plot.new()
plot.window(xlim = c(0, 1), ylim = c(0, 1))
# Vertical Adjustment:
z <- -2
TEXT <- paste("Strategy:", getStrategyFun(object$backtest))
mtext(TEXT, side = 3, line = z + 3, adj = 0, font=2, family="sans",
cex=CEX)
TEXT <- capture.output(round(object$stats, 2))
mtext(TEXT[1], side = 3, line = z + +2, adj = 0, font=font, family="mono", cex=CEX)
mtext(TEXT[2], side = 3, line = z + +1, adj = 0, font=font, family="mono", cex=CEX)
mtext(TEXT[3], side = 3, line = z + +0, adj = 0, font=font, family="mono", cex=CEX)
mtext(TEXT[4], side = 3, line = z + -1, adj = 0, font=font, family="mono", cex=CEX)
mtext(TEXT[5], side = 3, line = z + -2, adj = 0, font=font, family="mono", cex=CEX)
TEXT <- capture.output(object$spec)[c(2,3,4,5,8)]
mtext("Portfolio Specification:", side = 3, line = z + -4, adj = 0, font=2, family="sans", cex=CEX)
if (length(grep("CVaR",TEXT[2]))!=0) TEXT[2] =
gsub("CVaR", paste("CVaR |", getAlpha(object$spec)), TEXT[2])
mtext(TEXT[2], side = 3, line = z + -5, adj = 0, font=font, family=family, cex=CEX)
mtext(TEXT[3], side = 3, line = z + -6, adj = 0, font=font, family=family, cex=CEX)
mtext(TEXT[4], side = 3, line = z + -7, adj = 0, font=font, family=family, cex=CEX)
#text(TEXT[5], side = 3, line = z + -8, adj = 0, font=font, family=family, cex=CEX)
TEXT <- capture.output(object$constraints)[1]
mtext("Constraints:", side = 3, line = z + -9, adj = 0, font=2, family="sans", cex=CEX)
TEXT <- substr(TEXT[1], 4, 99)
mtext(TEXT, side = 3, line = z + -10, adj = 0, font=font, family=family, cex=CEX)
# Return Value:
invisible()
}
################################################################################
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.