Dynamic portfolio re-balancing if PF weights deviate by more than a threshold

Question

It's not so hard to backtest a portfolio with given weights and a set rebalancing frequency (e.g. daily/weekly...). There are R packages doing this, for example PerformanceAnalytics, or tidyquant's tq_portfolio which uses that function.

I would like to backtest a portfolio that is re-balanced when the weights deviate by a certain threshold given in percentage points.

Say I have two equally-weighted stocks and a threshold of +/-15 percentage points, I would rebalance to the initial weights when one of the weights exceeds 65%.

For example I have 3 stocks with equal weights (we should also be able to set other weights).

library(dplyr)
set.seed(3)
n <- 6

rets <- tibble(period = rep(1:n, 3),
               stock = c(rep("A", n), rep("B", n), rep("C", n)),
               ret = c(rnorm(n, 0, 0.3), rnorm(n, 0, 0.2), rnorm(n, 0, 0.1)))

target_weights <- tibble(stock = c("A", "B", "C"), target_weight = 1/3)

rets_weights <- rets %>% 
  left_join(target_weights, by = "stock")

rets_weights

# # A tibble: 18 x 4
# period stock      ret target_weight
# <int> <chr>    <dbl>         <dbl>
#   1      1 A     -0.289           0.333
# 2      2 A     -0.0878          0.333
# 3      3 A      0.0776          0.333
# 4      4 A     -0.346           0.333
# 5      5 A      0.0587          0.333
# 6      6 A      0.00904         0.333
# 7      1 B      0.0171          0.333
# 8      2 B      0.223           0.333
# 9      3 B     -0.244           0.333
# 10      4 B      0.253           0.333
# 11      5 B     -0.149           0.333
# 12      6 B     -0.226           0.333
# 13      1 C     -0.0716          0.333
# 14      2 C      0.0253          0.333
# 15      3 C      0.0152          0.333
# 16      4 C     -0.0308          0.333
# 17      5 C     -0.0953          0.333
# 18      6 C     -0.0648          0.333

Here are the actual weights without rebalancing:

rets_weights_actual <- rets_weights %>% 
  group_by(stock) %>% 
  mutate(value = cumprod(1+ret)*target_weight[1]) %>% 
  group_by(period) %>% 
  mutate(actual_weight = value/sum(value))

rets_weights_actual

# # A tibble: 18 x 6
# # Groups:   period [6]
# period stock      ret target_weight value actual_weight
# <int> <chr>    <dbl>         <dbl> <dbl>         <dbl>
#   1      1 A     -0.289           0.333 0.237         0.268
# 2      2 A     -0.0878          0.333 0.216         0.228
# 3      3 A      0.0776          0.333 0.233         0.268
# 4      4 A     -0.346           0.333 0.153         0.178
# 5      5 A      0.0587          0.333 0.162         0.207
# 6      6 A      0.00904         0.333 0.163         0.238
# 7      1 B      0.0171          0.333 0.339         0.383
# 8      2 B      0.223           0.333 0.415         0.437
# 9      3 B     -0.244           0.333 0.314         0.361
# 10      4 B      0.253           0.333 0.393         0.458
# 11      5 B     -0.149           0.333 0.335         0.430
# 12      6 B     -0.226           0.333 0.259         0.377
# 13      1 C     -0.0716          0.333 0.309         0.349
# 14      2 C      0.0253          0.333 0.317         0.335
# 15      3 C      0.0152          0.333 0.322         0.371
# 16      4 C     -0.0308          0.333 0.312         0.364
# 17      5 C     -0.0953          0.333 0.282         0.363
# 18      6 C     -0.0648          0.333 0.264         0.385

So I want that if in any period any stock's weight goes over or under the threshold (for example 0.33+/-0.1), the portfolio weights should be set back to the initial weights.

This has to be done dynamically, so we could have a lot of periods and a lot of stocks. Rebalancing could be necessary several times.

What I tried to solve it: I tried to work with lag and set the initial weights when the actual weights exceed the threshold, however I was unable to do so dynamically, as the weights depend on the returns given the rebalanced weights.

Answer 1

The approach to rebalance upon deviation by more than a certain threshold is called percentage-of-portfolio rebalancing.

My solution is to iterate period-by-period and check if the upper or lower threshold was passed. If so we reset to the initial weights.

library(tidyverse)
library(tidyquant)

rets <- FANG %>% 
  group_by(symbol) %>% 
  mutate(ret = adjusted/lag(adjusted)-1) %>% 
  select(symbol, date, ret) %>% 
  pivot_wider(names_from = "symbol", values_from = ret)
 
weights <- rep(0.25, 4)
threshold <- 0.05

r_out <- tibble()
i0 <- 1
trade_rebalance <- 1
pf_value <- 1
for (i in 1:nrow(rets)) {
  r <- rets[i0:i,]
  
  j <- 0
  r_i <- r %>% 
    mutate_if(is.numeric, replace_na, 0) %>%
    mutate_if(is.numeric, list(v = ~ pf_value * weights[j <<- j + 1] * cumprod(1 + .))) %>%
    mutate(pf = rowSums(select(., contains("_v")))) %>% 
    mutate_at(vars(ends_with("_v")), list(w = ~ ./pf))
  
  touch_upper_band <- any(r_i[nrow(r_i),] %>% select(ends_with("_w")) %>% unlist() > weights + threshold)
  touch_lower_band <- any(r_i[nrow(r_i),] %>% select(ends_with("_w")) %>% unlist() < weights - threshold)
  
  if (touch_upper_band | touch_lower_band | i == nrow(rets)) {
    i0 <- i + 1
    r_out <- bind_rows(r_out, r_i %>% mutate(trade_rebalance = trade_rebalance))
    pf_value <- r_i[[nrow(r_i), "pf"]]
    trade_rebalance <- trade_rebalance + 1
  }
}

r_out %>% head()
# # A tibble: 6 x 15
# date             FB      AMZN     NFLX      GOOG  FB_v AMZN_v NFLX_v GOOG_v    pf FB_v_w AMZN_v_w NFLX_v_w GOOG_v_w trade_rebalance
# <date>        <dbl>     <dbl>    <dbl>     <dbl> <dbl>  <dbl>  <dbl>  <dbl> <dbl>  <dbl>    <dbl>    <dbl>    <dbl>           <dbl>
#   1 2013-01-02  0        0         0        0        0.25   0.25   0.25   0.25   1     0.25     0.25     0.25     0.25                1
# 2 2013-01-03 -0.00821  0.00455   0.0498   0.000581 0.248  0.251  0.262  0.250  1.01  0.245    0.248    0.259    0.247               1
# 3 2013-01-04  0.0356   0.00259  -0.00632  0.0198   0.257  0.252  0.261  0.255  1.02  0.251    0.246    0.255    0.249               1
# 4 2013-01-07  0.0229   0.0359    0.0335  -0.00436  0.263  0.261  0.270  0.254  1.05  0.251    0.249    0.257    0.243               1
# 5 2013-01-08 -0.0122  -0.00775  -0.0206  -0.00197  0.259  0.259  0.264  0.253  1.04  0.251    0.250    0.255    0.245               1
# 6 2013-01-09  0.0526  -0.000113 -0.0129   0.00657  0.273  0.259  0.261  0.255  1.05  0.261    0.247    0.249    0.244               1

r_out %>% tail()
# # A tibble: 6 x 15
# date             FB      AMZN       NFLX     GOOG  FB_v AMZN_v NFLX_v GOOG_v    pf FB_v_w AMZN_v_w NFLX_v_w GOOG_v_w trade_rebalance
# <date>        <dbl>     <dbl>      <dbl>    <dbl> <dbl>  <dbl>  <dbl>  <dbl> <dbl>  <dbl>    <dbl>    <dbl>    <dbl>           <dbl>
#   1 2016-12-22 -0.0138  -0.00553  -0.00727   -0.00415 0.945   1.10   1.32   1.08  4.45  0.213    0.247    0.297    0.243              10
# 2 2016-12-23 -0.00111 -0.00750   0.0000796 -0.00171 0.944   1.09   1.32   1.08  4.43  0.213    0.246    0.298    0.243              10
# 3 2016-12-27  0.00631  0.0142    0.0220     0.00208 0.950   1.11   1.35   1.08  4.49  0.212    0.247    0.301    0.241              10
# 4 2016-12-28 -0.00924  0.000946 -0.0192    -0.00821 1.11    1.12   1.10   1.11  4.45  0.250    0.252    0.247    0.250              11
# 5 2016-12-29 -0.00488 -0.00904  -0.00445   -0.00288 1.11    1.11   1.10   1.11  4.42  0.250    0.252    0.248    0.251              11
# 6 2016-12-30 -0.0112  -0.0200   -0.0122    -0.0140  1.09    1.09   1.08   1.09  4.36  0.251    0.250    0.248    0.251              11

Here we would have rebalanced 11 times.

r_out %>% 
  mutate(performance = pf-1) %>% 
  ggplot(aes(x = date, y = performance)) +
  geom_line(data = FANG %>% 
              group_by(symbol) %>% 
              mutate(performance = adjusted/adjusted[1L]-1),
            aes(color = symbol)) +
  geom_line(size = 1)

The approach is slow and using a loop is far from elegant. If anyone has a better solution, I would happily upvote and accept.