r - 如果 PF 权重偏离阈值以上，则动态投资组合重新平衡

Question

用给定的权重和设定的重新平衡频率（例如每天/每周......）对投资组合进行回测并不难。有 R 包执行此操作，例如 PerformanceAnalytics 或tq_portfolio使用该功能的 tidyquant。

我想回测当权重偏离以百分比给出的某个阈值时重新平衡的投资组合。

假设我有两只同等权重的股票和 +/-15 个百分点的阈值，当其中一个权重超过 65% 时，我会重新平衡到初始权重。

例如，我有 3 支相同权重的股票（我们也应该能够设置其他权重）。

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

以下是未重新平衡的实际权重：

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

所以我希望，如果在任何时期任何股票的权重超过或低于阈值（例如 0.33+/-0.1），则应将投资组合权重设置回初始权重。

这必须动态完成，所以我们可以有很多时期和很多股票。可能需要多次重新平衡。

我试图解决的问题：lag当实际权重超过阈值时，我尝试使用并设置初始权重，但是我无法动态地这样做，因为权重取决于重新平衡权重的回报。

Answer 1

在偏离超过某个阈值时进行再平衡的方法称为投资组合再平衡百分比。

我的解决方案是逐周期迭代并检查是否通过了上限或下限。如果是这样，我们将重置为初始权重。

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

在这里，我们将重新平衡 11 次。

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)

该方法很慢，并且使用循环远非优雅。如果有人有更好的解决方案，我很乐意投票并接受。