Naive portfolio selection rule

Question

I have a xts file with monthly returns for 17 industry portfolios. The data looks as follows:

             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

My aim is to perform a backtest with a naive portfolio selection rule. Instead of holding an equal-weighted portfolio, i want to assing the weights according to the following naive rule:

Assign weights 2/N to each asset that has above-median historical returns
assign weight 0 if below-median historical returns

Instead of the equal-weighted vector:

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

This weighting vector works well for getting the portfolio returns. To do so I used this function:

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")

I stuck in incorporate a weighting function to a standard backtest script (tidyquant, PerformanceAnalytics, quantmod). In most of these, only optimization-problems can be solved but not simple naive rules.

Does somebody have an idea in how to pursue such a backtest with a simple portfolio selection rule?

Thanks for your help!

In Stack Overflow, your question needs to be more code oriented. You can explain the context of your question, but try to explain in a way that, if possible, people that don't necessarily understand the underlining subject can still answer the code related part of the question. Also, post your data (use the `dput()` function) so we can run code with. — Ricardo Semião e Castro, Mar 22 '21 at 15:54

Enrico Schumann · Answer 1 · 2021-03-23T07:57:29.800

If an alternative package were acceptable, too: here is a sketch how to do it with PMwR, which I maintain. I start with an example dataset: 17 industry portfolios from Kenneth French's website (probably the same dataset that you use).

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 ...

Backtests can be run with function btest. The main "ingredient" of a backtest is a "signal" function that is called at any instant of time and returns the desired portfolio. An example: the function here looks back 250 days, computes the returns of the assets and then keeps those assets that have an above-median return.

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
}

This function is passed to btest with the instruction to call it every quarter.

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)

You can analyse the results.

summary(NAVseries(bt))
journal(bt)

Update, following the comment: btest does not impose restrictions on data frequency. Here is the example with monthly data, starting with monthly returns.

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
## ....

Transform the returns into total-return series:

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

Adjust the signal function for monthly data:

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
}

Run the backtest, with an appropriate burnin 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"
## ....

Thank you very much @Enrico Schumann ! I've just read through your book (portfolio management with R) and your essay about backtesting. Some additional questions arise: 1) is it possible to use only returns (no prices) in your PMwR-package? 2) I tried your function from above and changing the number of days for the median calculation as well as the burnin rate in the bt function to 12 (1 year, i use the monthly returns). I get the message: Fehler in if (max(abs(dXs)) < tol) rebalance <- FALSE else if (!is.na(tol.p) && : Fehlender Wert, wo TRUE/FALSE nötig ist. Thank you for your help! — Ramon, Mar 22 '21 at 21:11
1) No, the function needs prices, but they don't have to be actual prices: you can use `cumprod(1+R)` to create series that can be used as input. 2) `btest` does not care about frequency; monthly data should work as well. But your error suggests that you have `NA`s in your data. (Try `any(is.na(<...>))` on your dataset.) — Enrico Schumann, Mar 23 '21 at 07:48
Thank you very much for your answer and updating your above code. I will have a try on that again! thank you very much! — Ramon, Mar 23 '21 at 08:28

Naive portfolio selection rule

1 Answers1