Long-Short Portfolio Calculation in R

Question

I would like to know how to construct a Long-Short portfolio in R as is typical in financial literature.

Say I have the following data:

Head():

# A tibble: 6 x 4
# Groups:   assets [1]
  assets  returns    id quantile
  <fct>     <dbl> <int> <chr>   
1 AEIS   -0.157       1 1       
2 AEIS    0.107       2 1       
3 AEIS    0.140       3 1       
4 AEIS   -0.111       4 1       
5 AEIS   -0.160       5 1       
6 AEIS   -0.00566     6 1 

Tail():

# A tibble: 6 x 4
# Groups:   assets [1]
  assets returns    id quantile
  <fct>    <dbl> <int> <chr>   
1 GIB     0.0742   110 8       
2 GIB     0.0201   111 8       
3 GIB     0.0255   112 8       
4 GIB     0.0446   113 8       
5 GIB     0.0143   114 8       
6 GIB     0.0537   115 8

How does one construct the L-S portfolio such that I long portfolio/quantile 1 and short portfolio/quantile 8?

Data/Code:

library(quantmod)
library(reshape2)
library(dplyr)
library(tidyr)
stocks <- c('AEIS', 'ABC', 'AMGN', 'BBY', 'HRB', 'BKE', 'CPLA', 'GIB')
getSymbols(stocks, from = "2010-01-01")

prices.data <- do.call(merge, lapply(stocks, function(x) Cl(get(x))))
returns <- setNames(do.call(cbind, lapply(prices.data, monthlyReturn)), stocks)


data <- returns %>%
  data.frame() %>%
  gather(assets, returns, 1:8, factor_key=TRUE) %>%
  group_by(assets) %>%
  mutate(id = 1:n(),
         quantile = as.numeric(assets))

head(data)

Answer 1

The following code illustrates how to do a LS return calculation (and hopefully assist others keen to see how LS portfolio returns can be calculated).

I show you also qhat the quantile portfolio is all about - it is typically a ranking exercise (by e.g. a factor score), which implies certain stocks are long, and other short based on the score.

Would be great to see if someone can poke holes in the LS calculation below, but my simple check seems to indicate it works well.

library(quantmod)
library(reshape2)
library(dplyr)
library(tidyr)
if(!require(tbl2xts)) install.packages("tbl2xts")
if(!require(rmsfuns)) install.packages("rmsfuns")

stocks <- c('AEIS', 'ABC', 'AMGN', 'BBY', 'HRB', 'BKE', 'GIB') # CPLA doesn't fetch
getSymbols(stocks, from = "2016-01-01")

prices.data <- do.call(merge, lapply(stocks, function(x) Cl(get(x))))
returns <- setNames(do.call(cbind, lapply(prices.data, monthlyReturn)), stocks)

FactorInfo <- 
tibble(assets = stocks, FactorScore = rnorm(n = length(stocks)))

data <- 
  returns %>% xts_tbl() %>% 
  gather(assets, returns, -date) %>%
  left_join(., FactorInfo, by = "assets") %>% 
  mutate(RankPctile = percent_rank(FactorScore))

LongStocks <- data %>% select(assets, FactorScore) %>% unique() %>% arrange(FactorScore) %>% head(2) # pick two worst to short, as example
ShortStocks <- data %>% select(assets, FactorScore) %>% unique() %>% arrange(FactorScore) %>% tail(2) # pick two best to long, as example

Long_Port <- data %>% filter(assets %in% unique(LongStocks$assets)) %>%     tbl_xts(cols_to_xts = "returns", spread_by = "assets")
Short_Port <- data %>% filter(assets %in% unique(ShortStocks$assets)) %>% tbl_xts(cols_to_xts = "returns", spread_by = "assets")

# Fully funded long-short position
W_Long <- data %>% filter(assets %in% unique(LongStocks$assets)) %>% filter(date == first(date)) %>% mutate(Weight = 1 / n()) %>% tbl_xts(cols_to_xts = "Weight", spread_by = "assets")
W_Short <- data %>% filter(assets %in% unique(ShortStocks$assets)) %>% filter(date == first(date)) %>% mutate(Weight = -1 / n()) %>% tbl_xts(cols_to_xts = "Weight", spread_by = "assets")

# Now calculate LS portfolio using PerformanceAnalytics:
# I recommend using rmsfuns::Safe_Return.portfolio, a wrapper for PerformanceAnalytics that makes it safer to use:

Port <- cbind(Long_Port, Short_Port)
Port_W <- cbind(W_Long, W_Short)

Port <- 
  rmsfuns::Safe_Return.portfolio(R = Port, weights = Port_W, lag_weights = TRUE, geometric = TRUE, verbose = TRUE)
LS_Port <- Port$returns %>% xts_tbl() %>% summarise(Cum = prod(1+portfolio.returns)) %>% .[[1]]

# Check correctness with direct calculation (can be done if only rebalanced once at the start):
all.equal( bind_rows(Long_Port %>% xts_tbl() %>% gather(assets, Ret, -date) %>% mutate(Weight = 1 / n_distinct(assets)),
                    Short_Port  %>% xts_tbl() %>% gather(assets, Ret, -date) %>% mutate(Weight = -1 / n_distinct(assets))) %>% 
           group_by(assets, Weight) %>% summarise(Ret = prod(1+Ret) - 1) %>% ungroup() %>% summarise(Ret = sum(Ret*Weight)) %>% .[[1]], 

           LS_Port-1)

# To see your daily positions:
LS_Daily <- Port$EOP.Value %>% xts_tbl %>% gather(stocks, eop.val, -date) %>% group_by(date) %>% summarise(return = sum(eop.val)) 

# Of course - you can further rebalance to other positions by adjusting Port_W