Portfolio Backtesting

Portfolio Backtesting

This is my note for learning Portfolio Backtesting

A Basic Workflow

Step 1: load package and dataset

The main function portfolioBacktest() requires the argument dataset_list to follow a certain format: it should be a list of several individual datasets, each of them being a list of several xts objects following exactly the same date index. One of those xts objects must contain the historial prices of the stocks, but we can have additional xts objects containing other information such as volume of the stocks or index prices. The package contains a small dataset sample for illustration.

R
1
2
library(portfolioBacktest)
data("dataset10")

Note that each dataset contains an xts object called “adjusted”. By default, portfolioBacktest() will use such adjusted prices to calculate the portfolio return. But one can change this setting with the argument price_name in function portfolioBacktest().

Step 2: define your own portfolio

R
1
2
3
4
5
my_portfolio <- function(dataset){
prices = dataset$adjusted
N = ncol(prices)
return(rep(1/N, N))
}

Step 3: do backtest

R
1
bt <- portfolioBacktest(my_portfolio, dataset10)

Step 4: check your portfolio performance

R
1
backtestSummary(bt)$performance

Details

Loading Data

R
1
2
3
4
5
6
7
8
9
10
11
data("SP500_symbols")
SP500 <- stockDataDownload(
stock_symbols = SP500_symbols,
from = "2008-12-01",
to = "2018-12-01"
)

# Expanding the datasets
for(i in 1:length(dataset10)){
dataset10[[i]]$MACD <- apply(dataset10[[i]]$adjusted, 2, function(x) {TTR::MACD(x)[, "macd"]})
}

Defining Portfolios

The portfolios have to be defined in the form of function that takes as input a dataset (which will be automatically windowed during the backtesting following a rolling-window basis) containing a list of xts objects (following the format of the elements of the argument dataset_list) and returns the portfolio as a numerical of stocks. We give the examples for the quintile portfolio, the global minimum variance portfolio (GMVP), and the Markwitz mean-variance portfolio as follows (under practical constraints $w >= 0$ and $1^T w = 1$):

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
# define quintile portfolio:
quintile_portfolio_fun <- function(dataset){
X <- diff(log(dataset$adjusted))[-1] # compute log returns
N <- ncol(X)
# design quintile portfolio
ranking <- sort(colMeans(X),
decreasing = TRUE, index.return = TRUE)$ix
w <- rep(0, N)
w[ranking[1:round(N/5)]] <- 1/round(N/5)
return(w)
}

# define the GMVP (with heuristic (探索的) not to allow shorting)

GMVP_portfolio_fun <- function(dataset){
X <- diff(log(dataset$adjusted))[-1]
Sigma <- cov(X)
w <- solve(Sigma, rep(1, nrow(Sigma)))
w <- abs(w) / sum(abs(w))
}

# define Markwitz mean-variance portfolio
library(CVXR)
Markowitz_portfolio_fun <- function(dataset){
X <- diff(log(dataset$adjusted))[-1]
Sigma <- cov(X)
mu <- colMeans(X)
w <- Variable(nrow(Sigma))
prob <- Problem(Maximize(t(mu) %*% w - 0.5 * quad_form(w, Sigma)),
constraints = list(w >= 0, sum(w) == 1))
result <- solve(prob)
return(as.vector(result$getValue(w)))
}

Backtesting and Plotting

Backtesting your portfolios

R
1
2
3
4
5
6
7
8
9
10
11
12
portfolios <- list(
"Quintile" = quintile_portfolio_fun,
"GMVP" = GMVP_portfolio_fun,
"Markowitz" = Markowitz_portfolio_fun)
bt <- portfolioBacktest(
portfolios,
dataset10,
benchmark = c("uniform", "index"))
# Result format
names(bt)

#> [1] "Quintile" "GMVP" "Markowitz" "uniform" "index"

Shaping your results

Select several performance measures of one specific portfolio:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
backtestSelector(
bt,
portfolio_name = "Quintile",
measures = c("Sharpe ratio", "max drawdown")
)

#> $performance
#> Sharpe ratio max drawdown
#> dataset 1 1.066989270 0.09384104
#> dataset 2 1.254843826 0.10406013
#> dataset 3 2.582276098 0.06952085
#> dataset 4 1.526569864 0.09921398
#> dataset 5 -0.006082829 0.17328255
#> dataset 6 0.981613296 0.10320105
#> dataset 7 1.778535154 0.08836202
#> dataset 8 -0.242004981 0.27460141
#> dataset 9 1.756090437 0.11288730
#> dataset 10 1.421113265 0.09834212

Tables of several performance measures of the portfolios (classified by performance criteria):

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
backtestTable(bt, measures = c("Sharpe ratio", "max drawdown"))

#> $`Sharpe ratio`
#> Quintile GMVP Markowitz uniform
#> dataset 1 1.066989270 1.357323094 -0.09535393 1.46290397
#> dataset 2 1.254843826 0.087941450 1.02098962 0.36602873
#> dataset 3 2.582276098 1.995213326 1.16826052 2.47349102
#> dataset 4 1.526569864 1.132171348 0.20480420 1.23875303
#> dataset 5 -0.006082829 -0.005772315 -0.29993326 0.24833981
#> dataset 6 0.981613296 2.200974096 0.55860989 1.87215178
#> dataset 7 1.778535154 3.039053665 -0.36846679 2.61728179
#> dataset 8 -0.242004981 0.073465253 1.00012843 0.08820003
#> dataset 9 1.756090437 1.305212811 0.64727039 1.61990151
#> dataset 10 1.421113265 2.109057328 0.37927803 2.02390131
#> index
#> dataset 1 1.31332671
#> dataset 2 0.07019635
#> dataset 3 1.84104358
#> dataset 4 0.86839335
#> dataset 5 0.05727968
#> dataset 6 2.63675781
#> dataset 7 1.60490706
#> dataset 8 -0.16297323
#> dataset 9 1.35084113
#> dataset 10 1.75889262

#> $`max drawdown`
#> Quintile GMVP Markowitz uniform index
#> dataset 1 0.09384104 0.05733409 0.20824525 0.06678369 0.05695256
#> dataset 2 0.10406013 0.13027178 0.23314434 0.13218930 0.12628589
#> dataset 3 0.06952085 0.04947330 0.16813510 0.04800769 0.05848025
#> dataset 4 0.09921398 0.10466982 0.15162912 0.10861575 0.10555293
#> dataset 5 0.17328255 0.08719220 0.64819866 0.11546985 0.10555293
#> dataset 6 0.10320105 0.02596655 0.33947368 0.03869864 0.02819678
#> dataset 7 0.08836202 0.05441919 0.27695971 0.05440115 0.07783609
#> dataset 8 0.27460141 0.16788147 0.28835512 0.19664607 0.18524842
#> dataset 9 0.11288730 0.10417538 0.24967326 0.10097014 0.10555293
#> dataset 10 0.09834212 0.05701569 0.09785354 0.07778765 0.05695256

Summary of performance measures:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
bt_sum <- backtestSummary(bt)
names(bt_sum)

#> [1] "performance_summary" "failure_rate"
#> [3] "cpu_time_summary" "error_message"

bt_sum$performance_summary

#> Quintile GMVP Markowitz uniform
#> Sharpe ratio 1.3379785 1.33126795 0.4689440 1.5414027
#> max drawdown 0.1012075 0.07226314 0.2414088 0.0893789
#> annual return 0.2020522 0.14791703 0.1718549 0.1641528
#> annual volatility 0.1622459 0.11076138 0.3101556 0.1218623
#> Sterling ratio 1.9895887 2.00642486 0.9141968 2.2138192
#> Omega ratio 1.2464178 1.25781815 1.1275569 1.2950904
#> ROT (bps) 261.3730126 223.19910442 181.7531363 699.7663439
#> index
#> Sharpe ratio 1.33208392
#> max drawdown 0.09169451
#> annual return 0.14897463
#> annual volatility 0.12479190
#> Sterling ratio 1.93644619
#> Omega ratio 1.27258183
#> ROT (bps) Inf

Plotting your results:

Performance table:

R
1
2
3
summaryTable(bt_sum, type = "DT",
order_col = "Sharpe ratio",
order_dir = "desc")

Barplot (provides information from summaryTable()) in a visual way:

R
1
2
3
4
5
summaryBarPlot(
bt_sum,
measures = c("Sharpe ratio",
"max drawdown")
) + tidyquant::scale_fill_tq()

Box Plot (probably the best way to properly compare the performance of different portfolios with a single performance measure):

R
1
2
backtestBoxPlot(bt, measure = "Sharpe ratio") + 
tidyquant::scale_fill_tq()

Cumulative return or wealth plot a single backtest:

R
1
2
3
backtestChartCumReturns(
bt, c("Quintile", "GMVP", "index")
) + tidyquant::scale_color_tq()

R
1
2
3
backtestChartDrawdown(
bt, c("Quintile", "GMVP", "index")
) + tidyquant::scale_color_tq()

Portfolio allocation evolution of a particular portfolio over a particular backtest:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
# for better illustration, let's use only the first 5 stocks
dataset10_5stocks <- lapply(
dataset10,
function(x) {x$adjusted <- x$adjusted[, 1:5]; return(x)}
)
bt <- portfolioBacktest(
list("GMVP" = GMVP_portfolio_fun),
dataset10_5stocks,
rebalance_every = 20
)

backtestChartStackedBar(
bt, "GMVP",
legend = TRUE
) + tidyquant::scale_fill_tq()

Advanced Usage

Tansaction costs

By default, transaction costs are not included in the backtesting, but the user can easily specify the cost to be used for a more realistic backtesting:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
library(ggfortify)
# backtest without transaction costs
bt <- portfolioBacktest(
my_portfolio, dataset10
)
# backtest with costs of 15 bps
bt_tc <- portfolioBacktest(
my_portfolio,
dataset10,
cost = list(buy = 15e-4,
sell = 15e-4)
)

# plot wealth time series
wealth <- cbind(bt$fun1$`dataset 1`$wealth, bt_tc$fun1$`dataset 1`$wealth)
colnames(wealth) <- c("without transaction costs", "with transaction costs")

autoplot(wealth, facets = FALSE,
main = "Wealth") +
tidyquant::scale_color_tq() +
theme(legend.title = element_blank()) +
theme(legend.position = "top")

Incorporation benchmarks

R
1
2
3
4
5
6
7
8
bt <- portfolioBacktest(
portfolios,
dataset10,
benchmark = c("uniform", "index")
)
names(bt)

#> [1] "Quintile" "GMVP" "Markowitz" "uniform" "index"

Parameter tuning in portfolio functions

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
quintile_portfolio_fun <- function(dataset){
prices <- tail(dataset$adjusted, lookback)
X <- diff(log(prices))[-1]
mu <- switch(average_type,
"mean" = colMeans(X),
"median" = apply(X, MARGIN = 2, FUN = median))
idx = sort(mu, decreasing = TRUE,
index.return = TRUE)$ix
w <- rep(0, ncol(X))
w[idx[1:ceiling(quintile*ncol(X))]] <- 1/ceiling(quintile*ncol(X))
return(w)
}

portfolio_list <- genRandomFuns(
portfolio_fun = quintile_portfolio_fun,
params_grid = list(
lookback = c(100, 120, 140, 160),
quintile = 1:5 / 10,
average_type = c("mean", "median")
),
name = "Quintile",
N_funs = 40
)

names(portfolio_list[1:5])
[1] "Quintile (lookback=140, quintile=0.4, average_type=mean)"
[2] "Quintile (lookback=140, quintile=0.3, average_type=median)"
[3] "Quintile (lookback=140, quintile=0.1, average_type=median)"
[4] "Quintile (lookback=120, quintile=0.4, average_type=median)"
[5] "Quintile (lookback=160, quintile=0.1, average_type=median)"

# the first function
portfolio_list[[1]]

#> function(dataset){
#> prices <- tail(dataset$adjusted, lookback)
#> X <- diff(log(prices))[-1]
#> mu <- switch(average_type,
#> "mean" = colMeans(X),
#> "median" = apply(X, MARGIN = 2, FUN = median))
#> idx = sort(mu, decreasing = TRUE,
#> index.return = TRUE)$ix
#> w <- rep(0, ncol(X))
#> w[idx[1:ceiling(quintile*ncol(X))]] <- 1/ceiling(quintile*ncol(X))
#> return(w)
#> }
#> <environment: 0x7f83590c6100>
#> attr(,"params")
#> attr(,"params")$lookback
#> [1] 140

#> attr(,"params")$quintile
#> [1] 0.4

#> attr(,"params")$average_type
#> [1] "mean"
R
1
2
3
4
5
bt <- portfolioBacktest(
portfolio_list, dataset10
)

plotPerformanceVsParams(bt)

Progress bar

R
1
2
3
4
5
6
7
8
9
10
11
bt <- portfolioBacktest(
portfolios, dataset10,
show_progress_bar = TRUE
)

#> Backtesting function Quintile (1/3)
#> |======================================================| 100%
#> Backtesting function GMVP (2/3)
#> |======================================================| 100%
#> Backtesting function Markowitz (3/3)
#> |====================================== | 70%

Parallel backtesting

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
portfun <- Markowitz_portfolio_fun
# parallel = 2 for functions
system.time(
bt_nopar <- portfolioBacktest(
list(portfun, portfun), dataset10
)
)

system.time(
bt_parfuns <- portfolioBacktest(
list(portfun, portfun), dataset10,
paral_portfolios = 2
)
)

# patallel = 5 for datasets
system.time(
bt_nopar <- portfolioBacktest(
portfun, dataset10
)
)
system.time(
bt_pardata <- portfolioBacktest(
portfun, dataset10,
paral_datasets = 5
)
)

Tracing where execution errors happen

For example, let’s define a portfolio function that will throw a error:

R
1
2
3
4
5
6
7
8
9
10
11
sub_function2 <- function(x) {
"a" + x # an error will happen here
}
sub_function1 <- function(x) {
return(sub_function2(x))
}
wrong_portfolio_fun <- function(data) {
N <- ncol(data$adjusted)
uni_port <- rep(1/N, N)
return(sub_function1(uni_port))
}

Now, let’s pass the above portfolio function to portfolioBacktest() and see how to check the error trace:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
bt <- portfolioBacktest(
wrong_portfolio_fun,
dataset10
)
res <- backtestSelector(bt, portfolio_index = 1)
error1 <- res$error_message[[1]]
str(error1)

#> chr "non-numeric argument to binary operator"
#> - attr(*, "error_stack")=List of 2
#> ..$ at : chr "\"a\" + x"
#> ..$ stack: chr "sub_function1(uni_port)\nsub_function2(x)"

cat(attr(error1, "error_stack")$at)

#> "a" + x

cat(attr(error1, "error_stack")$stack)

#> sub_function1(uni_port)
#> sub_function2(x)
# R

Comments

Your browser is out-of-date!

Update your browser to view this website correctly. Update my browser now

×