Наивное правило выбора портфеля

У меня есть файл xts с ежемесячной доходностью для 17 отраслевых портфелей. Данные выглядят следующим образом:

             Cars Chems Clths Cnstr Cnsum Durbl FabPr Finan  Food Machn Mines   Oil Other Rtail Steel Trans
1926-07-31   4.77  1.20 -0.09  4.20  2.05  1.33  0.61  0.44  0.46  2.06  2.65 -2.57  1.99  1.46  3.05 -0.69
1926-08-31  -1.11  3.55  3.57  0.85  4.10  0.75 -0.49  8.84  4.72  5.57  1.16  3.85  4.81  0.63 -0.58  4.96
1926-09-30  -3.39  1.85 -4.89 -1.06  2.50  1.27 -3.10 -2.55  1.66  0.52  1.44 -4.93 -2.09 -1.20  2.28  0.06
1926-10-31 -10.66 -9.15  0.49 -6.49 -1.41 -5.02 -3.92 -4.40 -4.79 -4.52  5.73  0.23 -3.50 -2.44 -4.98 -2.79
1926-11-30  -0.73  4.98  2.66  2.91  8.35  0.12  1.36 -0.27  7.04 -0.75  1.13  2.92 -0.47  1.72  1.81  1.38
1926-12-31   5.14  2.59  2.30  3.37  1.96  4.23  2.22  2.40 -1.39  2.93 -1.38  6.39  2.59  3.06  2.17  2.18
           Utils
1926-07-31  4.85
1926-08-31 -2.00
1926-09-30  2.06
1926-10-31 -2.98
1926-11-30  5.71
1926-12-31  1.72

Моя цель — провести бэктест с наивным правилом выбора портфеля. Вместо того, чтобы держать портфель с равным весом, я хочу оценивать веса в соответствии со следующим наивным правилом:

  • Присвойте веса 2/N каждому активу с исторической доходностью выше средней.
  • присвоить вес 0, если историческая доходность ниже медианы

Вместо равновзвешенного вектора:

w <- c(rep(1/17,17))

Этот вектор взвешивания хорошо работает для получения доходности портфеля. Для этого я использовал эту функцию:

portfolio_returns_tq_rebl <- 
  returns %>% 
  tq_portfolio(assets_col = symbol,
               returns_col = return,
               weights = w, # here i want to have a weighting function?!
               col_rename = "returns",
               rebalance_on = "months")

Я решил включить функцию взвешивания в стандартный сценарий тестирования (tidyquant, PerformanceAnalytics, quantmod). В большинстве из них можно решить только проблемы оптимизации, а не простые наивные правила.

Есть ли у кого-нибудь идея, как провести такой бэктест с помощью простого правила выбора портфеля?

Спасибо за вашу помощь!


person Ramon    schedule 22.03.2021    source источник
comment
В Stack Overflow ваш вопрос должен быть больше ориентирован на код. Вы можете объяснить контекст своего вопроса, но постарайтесь объяснить так, чтобы, если это возможно, люди, которые не обязательно понимают подчеркнутую тему, все же могли ответить на часть вопроса, связанную с кодом. Кроме того, опубликуйте свои данные (используйте функцию dput()), чтобы мы могли запускать код.   -  person Ricardo Semião e Castro    schedule 22.03.2021


Ответы (1)


Если бы альтернативный пакет тоже был приемлем: вот набросок, как это сделать с PMwR, который я поддерживать. Я начну с примера набора данных: 17 отраслевых портфолио с веб-сайта Кеннета Френча (вероятно, тот же набор данных, который вы используете).

library("PMwR")
library("NMOF")

P <- French(tempdir(),
            "17_Industry_Portfolios_daily_CSV.zip",
            frequency = "daily",
            price.series = TRUE)


str(P)
## 'data.frame':    24935 obs. of  17 variables:
##  $ Food : num  1 1 1 1 1.01 ...
##  $ Mines: num  1 1 1.01 1 1 ...
##  $ Oil  : num  1 1.01 1.01 1.02 1.01 ...
##  $ Clths: num  1 1 1 1 1.01 ...
##  $ Durbl: num  1 0.989 0.983 0.965 0.964 ...
##  $ Chems: num  1 1.01 1.02 1.02 1.03 ...
##  $ Cnsum: num  1 1 1.01 1.01 1.01 ...
##  $ Cnstr: num  1 1 1 1.01 1.01 ...
##  $ Steel: num  1 0.994 1.006 1.007 1.007 ...
##  $ FabPr: num  1 0.992 1.002 1.008 1.032 ...
##  $ Machn: num  1 0.999 1.003 1.008 1.006 ...
##  $ Cars : num  1 0.999 1.009 1.018 1.019 ...
##  $ Trans: num  1 1 1 1 1 ...
##  $ Utils: num  1 1.01 1.01 1.02 1.02 ...
##  $ Rtail: num  1 1 1 0.998 0.992 ...
##  $ Finan: num  1 1.01 1.01 1.01 1 ...
##  $ Other: num  1 1 1 1.01 1.01 ...

Бэктесты можно запускать с помощью функции btest. Основным компонентом бэктеста является сигнальная функция, которая вызывается в любой момент времени и возвращает желаемый портфель. Пример: функция здесь просматривает 250 дней назад, вычисляет доходность активов, а затем сохраняет те активы, доходность которых выше средней.

above_median <- function() {
    ## get the most recent 250 days
    H <- Close(n = 250)

    ## compute total return of industries
    R <- H[nrow(H), ] / H [1L, ]

    ## include only those with an above-median return
    include <- R > median(R)
    w <- numeric(ncol(H))
    w[include] <- 1/sum(include)
    w
}

Эта функция передается btest с инструкцией вызывать ее каждый квартал.

bt <- btest(prices = list(as.matrix(P)),
            timestamp = as.Date(row.names(P)),
            signal = above_median,
            do.signal = "lastofquarter",
            b = 250, ## burnin
            initial.cash = 100,
            convert.weights = TRUE)

Вы можете проанализировать результаты.

summary(NAVseries(bt))
journal(bt)

Обновление после комментария: btest не накладывает ограничений на частоту данных. Вот пример с ежемесячными данными, начиная с ежемесячных доходов.

P <- French(tempdir(),
            "17_Industry_Portfolios_CSV.zip",
            price.series = FALSE)
head(P)  ## returns
##               Food   Mines     Oil  Clths   Durbl   Chems  Cnsum   Cnstr
## 1926-07-31  0.0048  0.0378 -0.0141 0.0602 -0.0162  0.0846 0.0142  0.0231
## 1926-08-31  0.0291  0.0069  0.0360 0.0015 -0.0196  0.0570 0.0584  0.0433
## ....

Преобразуйте доходность в ряд совокупной доходности:

P <- apply(P + 1, 2, cumprod)
head(P)  ## returns => 'prices'
##                Food    Mines       Oil    Clths     Durbl    Chems    Cnsum
## 1926-07-31 1.004800 1.037800 0.9859000 1.060200 0.9838000 1.084600 1.014200
## 1926-08-31 1.034040 1.044961 1.0213924 1.061790 0.9645175 1.146422 1.073429

Настройте функцию сигнала для месячных данных:

above_median <- function() {
    ## get the most recent 12 months
    H <- Close(n = 12)

    ## compute total return of industries
    R <- H[nrow(H), ] / H [1L, ]

    ## include only those with an above-median return
    include <- R > median(R)
    w <- numeric(ncol(H))
    w[include] <- 1/sum(include)
    w
}

Запустите бэктест с соответствующим прожигом b.

bt <- btest(prices = list(as.matrix(P)),
            timestamp = as.Date(row.names(P)),
            signal = above_median,
            do.signal = "lastofquarter",
            b = 12, ## burnin
            initial.cash = 100,
            convert.weights = TRUE)

unique(journal(bt)$timestamp)  ## timestamps of trades 
## [1] "1927-09-30" "1927-12-31" "1928-03-31" "1928-06-30" "1928-09-30"
## [6] "1928-12-31" "1929-03-31" "1929-06-30" "1929-09-30" "1929-12-31"
## ....
person Enrico Schumann    schedule 22.03.2021
comment
Большое спасибо @Enrico Schumann! Я только что прочитал вашу книгу (управление портфелем с помощью R) и ваше эссе о тестировании на исторических данных. Возникают дополнительные вопросы: 1) можно ли в вашем PMwR-пакете использовать только возвраты (без цен)? 2) Я попробовал вашу функцию сверху и изменил количество дней для расчета медианы, а также скорость выгорания в функции bt на 12 (1 год, я использую ежемесячные доходы). Я получаю сообщение: Fehler in if (max(abs(dXs)) ‹ tol) rebalance ‹- FALSE else if (!is.na(tol.p) && : Fehlender Wert, wo TRUE/FALSE nötig ist. Спасибо за твоя помощь! - person Ramon; 23.03.2021
comment
1) Нет, функции нужны цены, но они не обязательно должны быть реальными ценами: вы можете использовать cumprod(1+R) для создания рядов, которые можно использовать в качестве входных данных. 2) btest не волнует частота; ежемесячные данные также должны работать. Но ваша ошибка предполагает, что у вас есть NAs в ваших данных. (Попробуйте any(is.na(<...>)) в своем наборе данных.) - person Enrico Schumann; 23.03.2021
comment
Большое спасибо за ваш ответ и обновление кода выше. Я попробую это снова! большое спасибо! - person Ramon; 23.03.2021