library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.4.4     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.0
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(Quandl)

## Loading required package: xts
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## 
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## 
## 
## ######################### Warning from 'xts' package ##########################
## #                                                                             #
## # The dplyr lag() function breaks how base R's lag() function is supposed to  #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or       #
## # source() into this session won't work correctly.                            #
## #                                                                             #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop           #
## # dplyr from breaking base R's lag() function.                                #
## #                                                                             #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning.  #
## #                                                                             #
## ###############################################################################
## 
## Attaching package: 'xts'
## 
## The following objects are masked from 'package:dplyr':
## 
##     first, last

library(ggplot2)
library(stringr)
library(DescTools)
Quandl.api_key("EsFRJz6Xd3CxmytxKgCB")

Introduction

The purpose of this analysis is to study the profit opportunity of different “quantamental” long-short models, where position sizing is based on the ranking of different financial ratios. For the analysis, three standalone financial ratios are created, and a fourth is generated based on a combination of two. The financial ratios are created using a combination of financial metrics from company 10-K and 10-Q filings, as well as price performance since filing. The financial metrics are adjusted to be “Point in Time” (PIT), by only using financial data 1 day after the reporting date.

The three standalone financial ratios are debt to market cap, return on investment, and price to earnings. The details on how these ratios are developed are described later. The fourth financial ratio is a combination of debt to market cap and return on investment. The goal of the fourth metric is to positively weight companies that are either high debt to market cap and high return on investment, or low debt to market cap and low return on investment. The goal of the fourth metric is to also negatively weight companies that are either high debt to market cap and low return on investment, or low debt to market cap and high return on investment.

After the four financial ratios are created, the performance of a long-short portfolio based on buying an equal weighted basket of the top decile companies and shorting an equal weighted basket of the bottom decile companies is analysed. The performance of a Z-Score weighted long-short portfolio is also looked at for comparison. The Z-score weighted portfolio assigns weights based on the Z-Score of the financial metrics vs the universe. The portfolios are rebalanced on the first trading day of each month.

For the analysis, I looked at companies that are identified by Zacks as being in the S&P 500, that are not in the Financials or Autos, Tires, and Trucks sectors, have end of day adjusted prices through the entire analysis period, have a debt to market cap ratio greater than 0.1 at some point during the analysis period, and have a feasible calculation of all metrics. There is considerable look ahead and survivalship bias in this method, since we wouldn’t know the ending S&P 500 constituents at the beginning of the period, we wouldn’t know all of the financial metrics at the beginning of the analysis period, we assume to know the sector classification for the entire analysis period at the start, and the companies have all survived the analysis period.

Assumptions

For the analysis we will be looking at performance from Jan 1, 2016 through Jun 30, 2023. The portfolio is rebalanced at the first trading day of each month. At each portfolio rebalancing, there are no transaction costs, and we will limit the gross notional invested to 1/10 the capital. The return on cash not invested (90% of capital) will earn 1% annually which is 1% / 360 daily. The cash generated from shorting (5% of capital) will earn the cash rate - 100bps or 0%. The initial capital for the strategy is set to $1,000,000.

# The analysis will be over the period from Jan 1, 2016 through Jun 30, 2023
analysis_start <- as.Date("2016-01-01")
analysis_end <- as.Date("2023-06-30")

# This this the initial capital all quantile portfolios will be started with
# Each rebalance date, the portfolio will trade a gross amount of 10% of the Capital
initial_capital <- 1000000

# This is the return on cash. The capital not invested will return this value
# The capital used in shorting will earn a short rebate of 0.01 (0.02 - 100bps)
cash_return <- 0.01

Function and Classes for Analysis

Below are functions used to calculate the Z-Score and Quantile ranks of data series.

ctq <- function(x, qtile){
  b<-sum(!is.na(unique(x)))
  labels<-gettextf("Q%s", 1:qtile)
  if(b>=qtile){
    xnames <- names(x)
    qs<-round(rank(x, na.last = "keep")/sum(!is.na(x))/(1/qtile)+.4999)
    qs<-ifelse(qs<1,1,qs)
    ftile<-factor(ggplot2::cut_interval(qs,n=qtile,labels=labels), ordered = T)
    ftile<-forcats::fct_na_value_to_level(ftile, level = "NA")
    names(ftile) <- xnames
  }else{
    ftile<-factor(
      rep(NA, times = length(x)),
      levels = labels,
      ordered = T)
    ftile<-forcats::fct_na_value_to_level(retval, level = "NA")
  }
  return(ftile)
}

ctz <- function(x, win.prob = c(0,1)){
  win.x <- DescTools::Winsorize(x = x, probs = win.prob, na.rm = T)
  norm.x <- (win.x - mean(win.x, na.rm = T)) / sd(win.x, na.rm = T)
  return(norm.x)
}

Below are functions provided by professor for downloading data from Quandl.

grab_quandl_table <- function(
  root_data_dir = NULL,
  table_path, avoid_download=F, replace_existing=F,
  date_override=NULL, allow_old_file=F,...)
  {
  
  if(is.null(root_data_dir)){
    root_data_dir <- file.path(Sys.getenv("HOME"), "quandl_data_table_downloads")
  }
  
  
  data_symlink <- file.path(root_data_dir, paste0(table_path, "_latest.zip"))
  
  # If root data directory doesnt exist
  # create root data directory
  if(!dir.exists(root_data_dir)){
    cat("Creating new root dir", root_data_dir)
    dir.create(root_data_dir)}
  
  # If avoiding downloads and the data file already exists
  # return the existind data
  if(avoid_download && file.exists(data_symlink)){
    cat("Skipping any possible download of", table_path)
    return(data_symlink)}
  
  # If the table directory does not already exist
  # create the table directory
  table_dir <- dirname(data_symlink)
  if(!dir.exists(table_dir)){
    cat("Creating new data dir", table_path)
    dir.create(table_dir)}
  
  # If date_override is NULL
  # set my_date to system date
  # else set my_date to date_override
  if(is.null(date_override)){
    my_date <- format(Sys.Date(), "%Y%m%d")
  }else{
    my_date <- paste(format(date_override, "%Y%m%d"), collapse = "%2C")
  }
  
  
  # Set data zip file path 
  data_file <- file.path(root_data_dir, paste0(table_path, "_", my_date, ".zip"))
  
  # If file already exists
  # and if replace existing is trye or the filse size > 0
  # Remove old file
  if(file.exists(data_file)){
    file_info <- file.info(data_file)
    file_size <- file_info$size
    if(replace_existing || !file_size >0){
      cat("Removing old file", data_file, "size", file_size)
    }else{
      cat("Data file", data_file, "size", file_size, "exists already, no need to download")
      return(data_file)
    }}
  
  dl <- Quandl.datatable.bulk_download_to_file(table_path, filename = data_file, ...)
  file_size <- file.info(data_file)$size
  
  if(file.exists(data_file) && file_size > 0) {
    cat("Download finished:", file_size,"bytes")
    #if(is.null(date_override)) {
    #  if(file.exists(data_symlink)) {
    #    cat("Removing old symlink")
    #    file.remove(data_symlink)}
    #  
    #  cat("Creating symlink:"data_file," -> " data_symlink))
    #  system2("ln", args = c("-s", data_file, data_symlink), stdout = TRUE)
    #}
    return(data_file)
  }else{
    cat("Data file",date_file,"failed download")
    return()
  }
  
  if(is.null(date_override) || allow_old_file){
    return(data_file)
  }else{
    return("NoFileAvailable")
  }
}

fetch_quandl_table <- function(
    table_path, root_data_dir = NULL,
    date_override = NULL, avoid_download=T,
    replace_existing=F, ...){
  results <- readr::read_csv(
    grab_quandl_table(
      table_path, 
      root_data_dir = root_data_dir,
      avoid_download = avoid_download,
      date_override = date_override,
      replace_existing = replace_existing, 
      ...))
  return(results)
}

Below are classes and methods used for the portfolio analysis. For this analysis I decided to create 2 S4 classes. The first, PeriodicPortfolioWeights, holds information about a portfolios creation date, exit date, tickers, weights, and adjusted prices from the entry date through exit date. The second class is PeriodicPortfolio, which holds more information about the value of the security holdings and cash balances.

A PeriodicPortfolio class can be created from a PeriodicPortfolioWeights class by using the calcReturn method supplied with capital and cash return arguments.

By setting up the class structure this way, I can create a shell portfolio with just weights, and then sequentially pass the capital + cumulative P&L as the starting capital for the next period. I can also use different functions to create portfolios with different weighting schemes. I have created such functions for long-only equally weighted, top quantile - bottom quantile equally weighted, and long-short Z-Score weighted.

There is also a function to get return metrics from a list of PeriodicPortfolio objects. This function links the P&L from each object to get series and metrics over the entire analysis period.

# PeriodPortfolioWeights S4 Class
# Shell to hold portfolio rebalance data and corresponding necessary price data
setClass("PeriodicPortfolioWeights",
  representation(
    entry_date = "Date",
    exit_date = "Date",
    tickers = "character",
    weights = "numeric",
    adj_prices = "matrix"))

# PeriodicPortfolio S4 Class
# Holds data from PeroiodPortfolioWeights as well as additional fields that represent changes in values
setClass("PeriodicPortfolio",
  representation(
    entry_date = "Date",
    exit_date = "Date",
    entry_capital = "numeric",
    cash_return = "numeric",
    entry_gross = "numeric",
    tickers = "character",
    weights = "numeric",
    shares = "numeric",
    dates = "Date",
    value_positions = "numeric",
    shortrebate_value_cum = "numeric",
    value_cash = "numeric",
    value_net = "numeric",
    cum_pnl = "numeric",
    pnl = "numeric"))


# Function to create PeriodicPortfolioWeights S4 Object
# Equally Weighted L/S Qn-Q1
createEWQLSPortfolio <- function(entry_date, exit_date, gross_w, data){
  data_weights <- data %>%
    dplyr::mutate(`n` = n(),.by = `value_q`) %>%
    dplyr::mutate(
      `ls` = case_when(
        `value_q` == last(levels(factor(data$value_q))) ~ 1,
        `value_q` == first(levels(factor(data$value_q))) ~ -1,
        .default = 0),
      `weight` = `ls`/ `n`) %>%
    dplyr::filter(`weight` != 0)
  
  w <- data_weights$weight
  weights <- w * (gross_w / sum(abs(w)))
  names(weights) <- data_weights$ticker
  
  new("PeriodicPortfolioWeights",
    entry_date = entry_date,
    exit_date = exit_date,
    tickers = data_weights$ticker,
    weights = weights,
    adj_prices = as.matrix(NA))
}

# Function to create PeriodicPortfolioWeights S4 Object
# Equal Weighted Long Only
createEWQLOPortfolio <- function(entry_date, exit_date, data){
  data_weights <- data %>%
    dplyr::mutate(`n` = n()) %>%
    dplyr::mutate(`weight` = 1/`n`)

  weights <- data_weights$weight
  names(weights) <- data_weights$ticker
  
  new("PeriodicPortfolioWeights",
    entry_date = entry_date,
    exit_date = exit_date,
    tickers = data_weights$ticker,
    weights = weights,
    adj_prices = as.matrix(NA))
}


# Function to create PeriodicPortfolioWeights S4 Object
# Weights are weighred by Z-Score
createZWPortfolio <- function(entry_date, exit_date, gross_w, data){
  data_weights <- 
    data %>%
    dplyr::mutate(
      `value_2z` = ctz(`value`, c(0.05, 0.95)),
      `weight` = `value_2z` / sum(abs(`value_2z`)) *2)
  
  w <- data_weights$weight
  weights <- w * (gross_w / sum(abs(w)))
  names(weights) <- data_weights$ticker
  
  new("PeriodicPortfolioWeights",
    entry_date = entry_date,
    exit_date = exit_date,
    tickers = data_weights$ticker,
    weights = weights,
    adj_prices = as.matrix(NA))
}

# Function to create PeriodicPortfolio S4 Object
# Meant to be used with accumulate function from purrr packages
# Takes either the previous PeriodicPortfolio and converts next PeriodicPortfolioWeights object to PeriodicPortfolio
# or uses provided init_capital (initial capital) to conver first PeriodicPortfolioWeights object to PeriodicPortfolio
convertWeightstoPortfolio <- function(obj1, obj2, init_capital, cash_return){
  if(class(obj1) == "PeriodicPortfolio"){
    capital <- last(obj1@value_net)
  }else{
    a <- calcReturn(obj1, capital = init_capital, cash_return = cash_return)
    capital <- last(a@value_net)
  }
  g <- calcReturn(obj2, capital = capital, cash_return = cash_return)
  return(g)
}


# Add adjusted prices to PeriodicPortfolioWeights Object
setGeneric("addAdjPrices", function(object, prices_df, ...) standardGeneric("addAdjPrices"))

## [1] "addAdjPrices"

setMethod("addAdjPrices", signature(object = "PeriodicPortfolioWeights"),
  function(object, prices_df, ...){
    
    entry_date <- object@entry_date
    exit_date <- object@exit_date
    
    adj_prices <- 
      prices_df %>%
      dplyr::select(`ticker`, `date`, `adj_close`) %>%
      dplyr::filter(`ticker` %in% object@tickers) %>%
      dplyr::filter(between(`date`, entry_date, exit_date)) %>%
      tidyr::pivot_wider(names_from = `ticker`, values_from = `adj_close`) %>%
      dplyr::arrange(`date`) %>%
      tibble::column_to_rownames("date") %>%
      dplyr::select(object@tickers) %>%
      as.matrix()
    
    object@adj_prices <- adj_prices
    return(object)
    })

# Method to convert PeriodicPortfolioWeights object to PeriodicPortfolio
setGeneric("calcReturn", function(object, capital, cash_return, ...) standardGeneric("calcReturn"))

## [1] "calcReturn"

setMethod("calcReturn", signature(object = "PeriodicPortfolioWeights"),
  function(object, capital, cash_return, ...){
    
    # Pull data
    entry_date <- object@entry_date
    exit_date <- object@exit_date
    tickers <- object@tickers
    weights <- object@weights
    adj_prices <- object@adj_prices
    
    shares <- capital * weights / adj_prices[1,]
    gross_trade <- sum(shares * adj_prices[1,])
    
    w <- shares * adj_prices[1,]
    
    # calculate new single data
    untraded_capital <- capital - sum(w[which(w>0)])
    entry_short_rebate_cash <- -sum(w[which(w<0)])
    
    daily_cash_return <- cash_return / 360
    daily_shortrebate_return <- (cash_return - 0.01) / 360
    
    # calculate new time series data
    dates <- as.Date(rownames(adj_prices))
    dates_chg <- as.numeric(dates - dplyr::lag(dates, 1, default = dates[1]))
    value_pos <- as.numeric(adj_prices %*% shares)
    cash_value_cum <- untraded_capital * cumprod(1 + dates_chg * daily_cash_return)
    shortrebate_value_cum <- entry_short_rebate_cash * cumprod(1 + dates_chg * daily_shortrebate_return)
    value_cash <- cash_value_cum + shortrebate_value_cum
    value_net <- value_pos + value_cash 
    cum_pnl <- value_net - capital
    pnl <- cum_pnl - lag(cum_pnl, 1, default = 0)
    
    new("PeriodicPortfolio",
      entry_date = entry_date,
      exit_date = exit_date,
      entry_capital = capital,
      cash_return = cash_return,
      entry_gross = gross_trade,
      tickers = tickers,
      weights = weights,
      shares = shares,
      dates = dates,
      value_positions = value_pos,
      shortrebate_value_cum = shortrebate_value_cum,
      value_cash = value_cash,
      value_net = value_net,
      cum_pnl = value_net - capital,
      pnl = pnl)
  })

# Method to get P&L of PeriodicPortfolio Object
# Returns vector of daily P&L with dates as names
setGeneric("getPNL", function(object, ...) standardGeneric("getPNL"))

## [1] "getPNL"

setMethod("getPNL", signature(object = "PeriodicPortfolio"),
  function(object, ...){
    dates <- object@dates
    pnl <- object@pnl
    names(pnl) <- dates
    return(pnl)
  })

# Function to get metrics of list of PeriodicPortfolios
getMetrics <- function(list){
  
  # Get Inputs
  init_capital <- list[[1]]@entry_capital
  cash_return <- list[[1]]@cash_return
  
  # Get Dates
  dates <- as.Date(unlist(sapply(list, \(x) as.character(x@dates))))
  
  # Get Return on Capital from Each Rebalance
  roc_periodic <- sapply(list,\(x) last(x@cum_pnl) / x@entry_capital)
  
  # Calculate P&L Statistics
  pnl_vec <- unlist(sapply(list, getPNL))
  pnl <- 
    data.frame("date" = names(pnl_vec), "pnl" = as.numeric(pnl_vec)) %>%
    dplyr::summarise(`pnl` = sum(`pnl`), .by = `date`) %>%
    dplyr::mutate(
      `cum_pnl` = cumsum(`pnl`),
      `cum_pnl_roc` = `cum_pnl` / init_capital,
      `pnl_roc` = (1+`cum_pnl_roc`) / (1+lag(`cum_pnl_roc`, 1, default = 0)) - 1)
  
  # Calculate Output Statistics
  TotalPNL <- last(pnl$cum_pnl)
  ReturnonCapital <- last(pnl$cum_pnl_roc)
  RFReturn <- (1+cash_return/360) ^ as.numeric(last(dates) - first(dates)) - 1
  ExReturn <- ReturnonCapital - RFReturn
  pnlpct <- pnl$pnl_roc
  annmean <- mean(pnlpct) * 252
  annvol <- sd(pnlpct) * sqrt(252)
  downside_vol <- sd(ifelse(pnlpct <0 , pnlpct, 0)) * sqrt(252)
  skew <- Skew(pnlpct)
  kurtosis <- Kurt(pnlpct)
  
  Sharpe <- (annmean - cash_return) / annvol
  Sortino <- (annmean - cash_return) / downside_vol
  
  NAV <- pnl$cum_pnl + init_capital
  previous_peaks <- cummax(NAV)
  drawdowns <- (NAV - previous_peaks) / previous_peaks
  max_drawdown <- min(drawdowns)
  
  NRebalances <- length(roc_periodic)
  PctProfitTrades <- length(which(roc_periodic > 0))/ NRebalances
  BestTrade <- max(roc_periodic)
  WorstTrade <- min(roc_periodic)
  
  summary <- paste(
    paste("Total Profit/Loss:", paste0("$",formatC(TotalPNL, format="f", digits = 2, big.mark = ",")), sep = "\t"),
    paste("Return on Capital:", paste0(formatC(ReturnonCapital * 100, digits = 2),"%"), sep = "\t"),
    paste("Excess Return to Cash:", paste0(formatC(ExReturn * 100, digits = 2), "%"), sep = "\t"),
    paste("Ann. Mean Returns:", paste0(formatC(annmean * 100, digits = 2),"%"), sep = "\t"),
    paste("Ann. Return Vol:", paste0(formatC(annvol * 100, digits = 3),"%"), sep = "\t"),
    paste("Sharpe Ratio:", formatC(Sharpe, digits = 3), sep = "\t\t"),
    paste("Sortino Ratio:", formatC(Sortino, digits = 3), sep = "\t\t"),
    paste("Skewness:", formatC(skew, digits = 3), sep = "\t\t"),
    paste("Excess Kurtosis", formatC(kurtosis, digits = 3), sep = "\t\t"),
    paste("Max Drawdown:", paste0(formatC(max_drawdown * 100, digits = 3),"%"), sep = "\t\t"),
    paste("# of Rebalances:", NRebalances, sep = "\t"),
    paste("% of Trades Profitable:", paste0(formatC(PctProfitTrades*100, digits = 3),"%"), sep = "\t"),
    paste("Best Trade Return:",paste0(formatC(BestTrade * 100, digits = 3),"%"), sep = "\t"),
    paste("Worst Trade Return:", paste0(formatC(WorstTrade * 100, digits = 3),"%"), sep = "\t"),
    sep = "\n")
  
  return(
    list(
      "pnl_data" = pnl,
      "summary" = summary))
}

Data

To start, I downloaded the Zacks MT data table, and filtered for companies in the S&P 500. I then downloaded the following tables for companies that are in the S&P 500: 1) Quotemedia Prices 2) Zacks FC 3) Zacks FR 4) Zacks SHRS 5) Zacks MKTV (this is not actually used)

# Download Zacks MT data table
# Filter for companies on the S&P 500
Zacks_MT <- Quandl.datatable('ZACKS/MT', paginate = T)
Zacks_MT_SPX <- dplyr::filter(Zacks_MT, `sp500_member_flag` == "Y")

# Download the price data for all companies identified as S&P 500 Constituents
# From QUOTEMEDIA PRICES table
Prices_SPX_raw <- 
  fetch_quandl_table(
    table_path = "QUOTEMEDIA/PRICES",
    date_override = analysis_end,
    date.gte=as.character(analysis_start %m-% months(13)), 
    date.lte=as.character(analysis_end),
    ticker = paste(Zacks_MT_SPX$ticker, collapse=","))

## Data file /Users/taylor/quandl_data_table_downloads/QUOTEMEDIA/PRICES_20230630.zip size 47609111 exists already, no need to download

## Rows: 1052865 Columns: 14
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr   (1): ticker
## dbl  (12): open, high, low, close, volume, dividend, split, adj_open, adj_hi...
## date  (1): date
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

# Get trading dates from prices data
trading_dates <- unique(Prices_SPX_raw$date[which(Prices_SPX_raw$date>=analysis_start & Prices_SPX_raw$date <= analysis_end)])

# Return Tickers that have price data on all trading days
Prices_Avail <-
  Prices_SPX_raw %>%
  dplyr::select(`ticker`, `date`, `adj_close`) %>%
  dplyr::full_join(
    tidyr::expand(Prices_SPX_raw, `ticker`, `date`), 
    by = c("ticker", "date")) %>%
  dplyr::filter(between(`date`, analysis_start, analysis_end)) %>%
  dplyr::summarise(`missing` = sum(is.na(`adj_close`)), .by = `ticker`) %>%
  dplyr::filter(`missing` == 0) %>%
  dplyr::pull(`ticker`)

# Create a combination of all dates and tickers
AllDateTickers <-
  merge(
    Prices_Avail,
    seq.Date(min(Prices_SPX_raw$date), max(Prices_SPX_raw$date), "day"))
    
# Return prices for all S&P 500 companies and combine with all days (including non-trading)
# Fill down the adj_close price. This will be important for matching financial data 
# with price data
Prices_SPX <-
  Prices_SPX_raw %>%
  dplyr::select(`ticker`, `date`, `close`, `adj_close`) %>%
  dplyr::full_join(
    AllDateTickers, 
    by = c("ticker" = "x", "date" = "y")) %>%
  dplyr::filter(`ticker` %in% Prices_Avail) %>%
  dplyr::group_by(`ticker`) %>%
  dplyr::arrange(`date`) %>%
  tidyr::fill(`adj_close`, .direction = "down") %>%
  tidyr::fill(`close`, .direction = "down")
  
# Download the Zacks FC data for all S&P 500 companies
Zacks_FC_SPX <-
  fetch_quandl_table(
    table_path = "ZACKS/FC",
    date_override = analysis_end,
    per_end_date.gte=as.character(analysis_start %m-% months(13)), 
    per_end_date.lte=as.character(analysis_end), 
    ticker = paste(Zacks_MT_SPX$ticker, collapse=",")) %>%
  dplyr::select(
    `zacks_sector_code`, 
    `m_ticker`, `ticker`,
    `per_end_date`, `per_type`, `filing_date`,
    `comm_stock_net`,
    `income_cont_oper`,
    `tot_lterm_debt`, `net_lterm_debt`,`cash_sterm_invst`,
    `eps_diluted_net`, `eps_basic_net`)

## Data file /Users/taylor/quandl_data_table_downloads/ZACKS/FC_20230630.zip size 7229720 exists already, no need to download

## Warning: One or more parsing issues, call `problems()` on your data frame for details,
## e.g.:
##   dat <- vroom(...)
##   problems(dat)

## Rows: 21731 Columns: 249
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr   (38): m_ticker, ticker, comp_name, comp_name_2, exchange, currency_cod...
## dbl  (194): per_fisc_year, per_fisc_qtr, per_cal_year, per_cal_qtr, qtr_nbr,...
## lgl   (10): per_code, data_type_ind, rental_income, impair_goodwill, stock_d...
## date   (7): per_end_date, filing_date, last_changed_date, shares_out_date, r...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

# Download Zacks FR data tables for all S&P 500 companies 
Zacks_FR_SPX <-
  fetch_quandl_table(
    table_path = "ZACKS/FR",
    date_override = analysis_end,
    per_end_date.gte=as.character(analysis_start %m-% months(13)), 
    per_end_date.lte=as.character(analysis_end), 
    ticker = paste(Zacks_MT_SPX$ticker, collapse=",")) %>%
  dplyr::select(
    `m_ticker`, `ticker`,
    `per_end_date`, `per_type`,
    `tot_debt_tot_equity`, `ret_invst`)

## Data file /Users/taylor/quandl_data_table_downloads/ZACKS/FR_20230630.zip size 1481682 exists already, no need to download

## Rows: 21731 Columns: 40
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr   (7): m_ticker, ticker, comp_name, comp_name_2, exchange, currency_code...
## dbl  (31): per_fisc_year, per_fisc_qtr, per_cal_year, per_cal_qtr, form_7_ty...
## lgl   (1): per_code
## date  (1): per_end_date
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

# Download Zacks Shares Data
Zacks_SHRS_SPX <-
  fetch_quandl_table(
    table_path = "ZACKS/SHRS",
    date_override = analysis_end,
    per_end_date.gte=as.character(analysis_start %m-% months(13)), 
    per_end_date.lte=as.character(analysis_end), 
    ticker = paste(Zacks_MT_SPX$ticker, collapse=",")) %>%
  dplyr::select(
    `ticker`, `m_ticker`,
    `per_end_date`, `per_type`,
    `shares_out`)

## Data file /Users/taylor/quandl_data_table_downloads/ZACKS/SHRS_20230630.zip size 164094 exists already, no need to download

## Rows: 17546 Columns: 9
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (5): ticker, m_ticker, comp_name, per_type, active_ticker_flag
## dbl  (3): fye, shares_out, avg_d_shares
## date (1): per_end_date
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

# Download Zacks Market Value Data
Zacks_MKTV_SPX <-
  fetch_quandl_table(
    table_path = "ZACKS/MKTV",
    date_override = analysis_end,
    per_end_date.gte=as.character(analysis_start %m-% months(13)), 
    per_end_date.lte=as.character(analysis_end), 
    ticker = paste(Zacks_MT_SPX$ticker, collapse=",")) %>%
  dplyr::select(
    `ticker`, `m_ticker`, 
    `per_end_date`, `per_type`,
    `mkt_val`, `ep_val`)

## Data file /Users/taylor/quandl_data_table_downloads/ZACKS/MKTV_20230630.zip size 236532 exists already, no need to download

## Rows: 17605 Columns: 9
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (5): ticker, m_ticker, comp_name, per_type, active_ticker_flag
## dbl  (3): fye, mkt_val, ep_val
## date (1): per_end_date
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Once the data is downloaded, I combine the Zacks FC and Zacks FR data sets by ticker, period end date, and period type. I then combine the Zacks SHRS data set by ticker and period end date. The SHRS data is not delineated by fiscal quarter or fiscal end, so where there is a quarter and annual fiscal end on the same data, the data is duplicated.

To calculate the financial ratios, I first split the data into Quarterly vs Annual data. For the quarterly data I calculated a trailing 4 quarter sum of the eps and income from continued operations, but otherwise the rest of the adjustments are the same.

I replaced missing eps_diluted_net with eps_basic_net, replaced negative EPS with 0.001, and set missing tot_lterm_debt and missing cash_sterm_invst to 0. I calculated net_debt as tot_lterm_debt - cash_sterm_invst.

Next, I joined the adjusted prices to the data by the fiscal end date, and calculated market cap (mkt_val) as adj price * shares_out. I opted to not use the market value data set from Zacks because the date is provided on a calendar quarterly data and not the fiscal quarter. For companies with fiscal quarters and annuals that do not report on the calendar quarter and annual end, the market value would not correspond with the market value at the fiscal end period.

I then joined the prices datatable for every date in the prices datatable by the report date + 1, and filled down the financial data and the adjusted price on the fiscal end date. Once the adjusted price from the fiscal end date was filled down, I calculated the change in the adjusted price from the last fiscal report date for every date (adj_close_chg).

Below are the formuals I used to calculate the fiscal metrics used in the analysis:

Debt_To_Mktcap = tot_debt_to_equity / (1 + adj_close_chg)
Return_On_Inv = income_cont_oper / (net_debt + (mkt_val * (1 + adj_close_chg))))
Price_To_Earnings = (mkt_val * (1 + adj_close_chg)) / (eps * shares_out))

After the metrics were calculated for each day using quarterly and annual data, I combined the two, and used quarterly data where available, otherwise annual data. From there I remove companies in the Financials or Autos, Tires, and Trucks sectors, has missing adjusted prices, had a debt to market cap ratio that was always below 0.01, or did not have a feasible calculation of all metrics.

# Combine Zacks FC, FR, and SHRS tables
Zacks_data_raw <-
  Zacks_FC_SPX %>%
  full_join(
    Zacks_FR_SPX,
    by = c("m_ticker", "ticker", "per_end_date", "per_type")) %>%
  full_join(
    Zacks_SHRS_SPX %>%
      dplyr::select(-c(`per_type`)),
    by = c("m_ticker", "ticker", "per_end_date"))

# Calculate the Quarterly Financial Ratios for all calendar dates
Zacks_data_Qtr <-
  Zacks_data_raw %>%
  dplyr::filter(`per_type` == "Q") %>%
  dplyr::filter(!is.na(`filing_date`)) %>%
  dplyr::mutate(`date` = `filing_date` + 1) %>%
  dplyr::group_by(`ticker`) %>%
  dplyr::arrange(`date`, `per_end_date`) %>%
  # Deal with missing EPS data
  dplyr::mutate(
    `eps` = ifelse(!is.na(`eps_diluted_net`), `eps_diluted_net`, `eps_basic_net`),
    .keep = "unused") %>%
  # Make quarterly income statement items LTM
  dplyr::mutate(
    `income_cont_oper` = zoo::rollapplyr(`income_cont_oper`, 4, sum, fill = NA),
    `eps` = zoo::rollapplyr(`eps`, 4, sum, fill = NA)) %>%
  # Replace Negative Earnings
  dplyr::mutate(`eps` = ifelse(`eps`<0, 0.001, `eps`)) %>%
  # Compute Net Debt
  dplyr::mutate(
    `tot_lterm_debt` = ifelse(is.na(`tot_lterm_debt`),0,`tot_lterm_debt`),
    `cash_sterm_invst` = ifelse(is.na(`cash_sterm_invst`),0,`cash_sterm_invst`),
    `net_debt` = `tot_lterm_debt` - `cash_sterm_invst`) %>%
  # Remove Duplicate Filing Dates
  dplyr::group_by(`ticker`, `date`) %>%
  dplyr::filter(`per_end_date` == max(`per_end_date`)) %>%
  dplyr::group_by(`ticker`) %>%
  # Join prices for period end
  dplyr::left_join(Prices_SPX, by = c("per_end_date" = "date", "ticker" = "ticker")) %>%
  dplyr::mutate(`mkt_val` = `close` * `shares_out`) %>%
  dplyr::rename(`adj_close_per` = `adj_close`) %>%
  dplyr::select(-`close`) %>%
  # Join prices for inter-period dates
  dplyr::full_join(select(Prices_SPX, -`close`), by = c("ticker" = "ticker", "date" = "date")) %>%
  dplyr::arrange(`ticker`, `date`)%>%
  # Fill down
  tidyr::fill(everything(), .direction = "down") %>%
  # Calculate Change in Adj Price
  dplyr::mutate(`adj_close_chg` = `adj_close`/ `adj_close_per` - 1, .keep = "unused") %>%
  # Filter dates to analysis period
  dplyr::filter(between(date, analysis_start, analysis_end)) %>%
  # Create Debt to Market Cap Metric
  dplyr::mutate(`Debt_To_Mktcap` = `tot_debt_tot_equity` / (1 + adj_close_chg)) %>%
  # Create Price to Earnings Metric
  dplyr::mutate(`Price_To_Earnings` = (`mkt_val` * (1 + `adj_close_chg`))/ (`eps` * `shares_out`)) %>%
  # Create Return on Investment Metric
  dplyr::mutate(`Return_On_Inv` = `income_cont_oper` / (`net_debt` + (`mkt_val` * (1+`adj_close_chg`)))) %>%
  # Select Necessary Columns
  dplyr::select(
    `date`, `per_end_date`, `filing_date`,
    `ticker`, `zacks_sector_code`,
    `Debt_To_Mktcap`, `Return_On_Inv`, `Price_To_Earnings`) 

# Calculate the Annual Financial Ratios for all calendar dates
Zacks_data_Ann <-
  Zacks_data_raw %>%
  dplyr::filter(`per_type` == "A") %>%
  dplyr::filter(!is.na(`filing_date`)) %>%
  dplyr::mutate(`date` = `filing_date` + 1) %>%
  dplyr::group_by(`ticker`) %>%
  dplyr::arrange(`date`, `per_end_date`) %>%
  # Deal with missing EPS data
  dplyr::mutate(
    `eps` = ifelse(!is.na(`eps_diluted_net`), `eps_diluted_net`, `eps_basic_net`),
    .keep = "unused") %>%
  # Replace Negative Earnings
  dplyr::mutate(`eps` = ifelse(`eps`<0, 0.001, `eps`)) %>%
  # Compute Net Debt
  dplyr::mutate(
    `tot_lterm_debt` = ifelse(is.na(`tot_lterm_debt`),0,`tot_lterm_debt`),
    `cash_sterm_invst` = ifelse(is.na(`cash_sterm_invst`),0,`cash_sterm_invst`),
    `net_debt` = `tot_lterm_debt` - `cash_sterm_invst`) %>%
  # Remove Duplicate Filing Dates
  dplyr::group_by(`ticker`, `date`) %>%
  dplyr::filter(`per_end_date` == max(`per_end_date`)) %>%
  dplyr::group_by(`ticker`) %>%
  # Join prices for period end
  dplyr::left_join(Prices_SPX, by = c("per_end_date" = "date", "ticker" = "ticker")) %>%
  dplyr::mutate(`mkt_val` = `close` * `shares_out`) %>%
  dplyr::rename(`adj_close_per` = `adj_close`) %>%
  dplyr::select(-`close`) %>%
  # Join prices for inter-period dates
  dplyr::full_join(select(Prices_SPX, -`close`), by = c("ticker" = "ticker", "date" = "date")) %>%
  dplyr::arrange(`ticker`, `date`)%>%
  # Fill down
  tidyr::fill(everything(), .direction = "down") %>%
  # Calculate Change in Adj Price
  dplyr::mutate(`adj_close_chg` = `adj_close`/ `adj_close_per` - 1, .keep = "unused") %>%
  # Filter dates to analysis period
  dplyr::filter(between(date, analysis_start, analysis_end)) %>%
  # Create Debt to Market Cap Metric
  dplyr::mutate(`Debt_To_Mktcap` = `tot_debt_tot_equity` / (1 + `adj_close_chg`)) %>%
  # Create Price to Earnings Metric
  dplyr::mutate(`Price_To_Earnings` = (`mkt_val` * (1 + `adj_close_chg`))/ (`eps` * `shares_out`)) %>%
  # Create Return on Investment Metric
  dplyr::mutate(`Return_On_Inv` = `income_cont_oper` / (`net_debt` + (`mkt_val` * (1+`adj_close_chg`)))) %>%
  # Select Necessary Columns
  dplyr::select(
    `date`, `per_end_date`, `filing_date`,
    `ticker`,
    `Debt_To_Mktcap`, `Return_On_Inv`, `Price_To_Earnings`) 

# Combine the Quarterly and Annual Financial Ratios Data
# Choose the quarterly data when available, otherwise the Annual
# Remove companies that are:
# 1) financials or autos,
# 2) don't have full data,
# 3) are missing data, or
# 4) Debt_To_Mktcap is never above 0.1
Zacks_data <-
  dplyr::full_join(
    Zacks_data_Qtr,
    Zacks_data_Ann,
    by = c("date" = "date", "ticker" = "ticker"),
    suffix = c(".Qtr", ".Ann")) %>%
  dplyr::mutate(
    `Debt_To_Mktcap` = 
      ifelse(!is.na(`Debt_To_Mktcap.Qtr`), `Debt_To_Mktcap.Qtr`, `Debt_To_Mktcap.Ann`),
    `Return_On_Inv` = 
      ifelse(!is.na(`Return_On_Inv.Qtr`), `Return_On_Inv.Qtr`, `Return_On_Inv.Ann`),
    `Price_To_Earnings` = 
      ifelse(!is.na(`Price_To_Earnings.Qtr`), `Price_To_Earnings.Qtr`, `Price_To_Earnings.Ann`),
    .keep = "unused") %>%
  dplyr::select(`date`, `ticker`, `zacks_sector_code`, 
         `Debt_To_Mktcap`, `Return_On_Inv`, `Price_To_Earnings`) %>%
  dplyr::group_by(`ticker`) %>%
  nest() %>%
  dplyr::mutate(
    `sector_remove` = purrr::map(`data`, \(x) any(x$zacks_sector_code %in% c(5,13))),
    `missing_date` = purrr::map(`data`, \(x) nrow(x)!=2738),
    `missing_data` = purrr::map(`data`, \(x) anyNA(x)),
    `min_debt2cap` = purrr::map(`data`, \(x) any(x$`Debt_To_Mktcap` >0.1))) %>%
  dplyr::filter(`sector_remove` == F) %>%
  dplyr::filter(`missing_date` == F) %>%
  dplyr::filter(`missing_data` == F) %>%
  dplyr::filter(`min_debt2cap` == T) %>%
  dplyr::select(c(`ticker`,`data`)) %>%
  unnest(cols = everything())

With the financial metrics data, I then Z-Scored all the metrics, and calculated the new metric Leverage_And_ROI. Leverage_And_ROI is calculated as the Z-Score of Debt_To_Mktcap * the Z-Score of Return_On_Inv. By multiplying the Z-Scores, companies with relatively high Debt_To_Mktcap and relatively high Return_On_Inv as well as companies with relatively low Debt_To_Mktcap and relatively low Return_On_Inv will rank high, while companies with relatively high Debt_To_Mktcap and relatively low Return_On_Inv as well as companies with relatively low Debt_To_Mktcap and relatively high Return_On_Inv will rank low. In doing so I am trying to find companies with high leverage and high ROI or low leverage and low ROI to buy, and companies with high leverage and low ROI or companies with low leverage and high ROI to sell. My hypothesis is that leverage should be good for companies that can generate return on the leverage, but bad for companies that can’t.

# Using trading dates calculated previously from the prices data
# Find the first trading date of each month.
# This will be used for our rebalance dates for the quantile trading
month_start <- 
  data_frame("trading_date" = trading_dates) %>%
  mutate(
    `year` = year(`trading_date`),
    `month` = month(`trading_date`)) %>%
  group_by(`year`, `month`) %>%
  summarize(`min` = min(`trading_date`)) %>%
  pull(`min`)

## Warning: `data_frame()` was deprecated in tibble 1.1.0.
## ℹ Please use `tibble()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

# Using the Zacks_data calculated above
# Filter to our rebalance dates, so we have the known financial ratios as of the rebalance date
# Z-Score each metric we will be looking at
# Calculate a new metric, Leverage_And_ROI, which is the z-score of Debt_To_Mktcap * z-score of Return_On_Inv
# Pivot the data longer
Metrics_data <- 
  Zacks_data %>%
  # Filter out only the re-balance Dates
  dplyr::filter(`date` %in% month_start) %>%
  # Figure out the next re-balance date
  dplyr::group_by(`ticker`) %>%
  dplyr::arrange(`date`) %>%
  dplyr::mutate(`date_next` = dplyr::lead(`date`, 1, default = analysis_end)) %>%
  # Z-Score all the Metrics
  dplyr::group_by(`date`) %>%
  dplyr::mutate(across(c(`Debt_To_Mktcap`, `Return_On_Inv`, `Price_To_Earnings`), ctz)) %>%
  # Compute New Metric Leverage_And_ROI = Z-Score Debt_To_MktCap * Z-Score Return_On_Inv
  dplyr::mutate(`Leverage_And_ROI` = ctz(`Debt_To_Mktcap` * `Return_On_Inv`)) %>%
  # Pivot to Longer
  tidyr::pivot_longer(
    cols = c(`Debt_To_Mktcap`, `Return_On_Inv`, `Price_To_Earnings`, `Leverage_And_ROI`),
    names_to = "metric",
    values_to = "value") %>%
  ungroup()

# Using the Z-Scores values for each metric, calculate the declie rank
Metrics_Decile <-
  Metrics_data %>%
  dplyr::group_by(`date`, `metric`) %>%
  dplyr::mutate(`value_q` = ctq(`value`, 10)) %>%
  dplyr::ungroup()

Analysis - Debt_To_Mktcap

The first analysis will be on the Debt_To_Mktcap metric. To start I looked at the performance of each decile as a long-only portfolio investing 100% of the $1,000,000 capital each period. The chart below shows the performance of these decile portfolios. Interestingly, the top performing decile was the highest Debt_To_Mktcap, but the second bet performing was the lowest Debt_To_Mktcap. I believe this is due to my hypothesis that leverage is only good if you can generate returns on the enterprise value, but otherwise not good.

# Start by selecting the Debt_To_Mktcap metrics and removing unnecessary columns.
# Split securities by declie
# Calculate the weights based on buying 1/n of each security within each declie (Equal Weighted Long Only)
# Add the daily adjPclose price data to the portfolio weights
# Calculate the portfolio values based on the capital from the previous trade beig passed down
# Calculate the P&L for each quantile portfolio
Debt2Cap_Decile <-
  Metrics_Decile %>%
  dplyr::arrange(`date`) %>%
  dplyr::filter(`metric` == "Debt_To_Mktcap") %>%
  dplyr::select(-c(`metric`, `zacks_sector_code`)) %>%
  tidyr::nest(.by = c("value_q")) %>%
  dplyr::mutate(
    `data_l` = purrr::map(
      `data`, 
      \(x) x %>%
        tidyr::nest(.by = c("date", "date_next")) %>%
        dplyr::mutate(
          `p_weights_ew` = purrr::pmap(list(`date`, `date_next`, `data`), createEWQLOPortfolio),
          `p_ew` = purrr::map(`p_weights_ew`, addAdjPrices, prices_df = Prices_SPX_raw),
          `p_ew_ret` = purrr::accumulate(
            `p_ew`, 
            convertWeightstoPortfolio, 
            cash_return = cash_return,
            init_capital = initial_capital),
          `p_ew_ret` = purrr::modify_in(
            `p_ew_ret`, 1, calcReturn, cash_return = cash_return, capital = initial_capital)) %>%
        dplyr::pull(`p_ew_ret`))) %>%
  dplyr::mutate(`metrics` = purrr::map(`data_l`, getMetrics)) %>%
  dplyr::mutate(`pnl` = purrr::map(`metrics`, \(x) x$pnl_data)) %>%
  dplyr::select(`value_q`, `pnl`) %>%
  tidyr::unnest(cols=c(`pnl`))

Debt2Cap_Decile %>%
  dplyr::mutate(`date` = as.Date(`date`)) %>%
  ggplot() +
  aes(x = date, y = cum_pnl_roc, colour = value_q) +
  geom_line() +
  scale_color_hue(direction = 1) +
  scale_y_continuous(labels = scales::percent_format()) + 
  labs(
    title = "Debt_To_Mktcap - Equal Weighted Decile Total Return",
    subtitle = "Month Start Rebalance from 1/1/2016 through 6/30/2023",
    x = "Date",
    y = "Quantile Total Return",
    color = "Quantile") +
  theme_minimal()

Next I generated returns on a long-short portfolio where the strategy went long the top decile of Debt_To_Mktcap and short the bottom decile. In each period gross notional equity exposure was limited to 10% of the initial capital at the rebalance. The uninvested cash earned an annual return of 1%.

The results below show that that while the portfolio generated positive returns of $80,845.58, the excess return to cash was only 0.19%. Unlike investing in cash though, the strategy had volatility, causing the Sharpe ratio to only be 0.08. Of the 90 rebalances, 74% generated positive returns. The returns where positively skewed with very high excess kurtosis.

# Start by selecting the Debt_To_Mktcap metrics and removing unnecessary columns.
# Calculate the weights based on buying 1/n % in the top decile and shorting 1/n % in the bottom decile.
# Add the daily adj_close price data to the portfolio weights.
# Calculate portfolio values based on the capital from the previous trade being passed down.
Debt2Cap_DecileLS <- 
  Metrics_Decile %>%
  dplyr::filter(`metric` == "Debt_To_Mktcap") %>%
  dplyr::select(-c(`metric`, `zacks_sector_code`)) %>%
  tidyr::nest(.by = c("date", "date_next")) %>%
  dplyr::mutate(
    `p_weights_ew` = purrr::pmap(list(`date`, `date_next`, `data`), createEWQLSPortfolio, gross_w = 0.1),
    `p_ew` = purrr::map(`p_weights_ew`, addAdjPrices, prices_df = Prices_SPX_raw),
    `p_ew_ret` = purrr::accumulate(
      `p_ew`, 
      convertWeightstoPortfolio, 
      cash_return = cash_return,
      init_capital = initial_capital),
    # Accumulate is annoying in that it doesn't do a great job for the first value
    `p_ew_ret` = purrr::modify_in(
      `p_ew_ret`,
      1, 
      calcReturn,
      cash_return = cash_return, 
      capital = initial_capital)) %>%
  dplyr::pull(`p_ew_ret`)

Debt_2Cap_DecileLS_Metrics <- getMetrics(Debt2Cap_DecileLS)
cat(Debt_2Cap_DecileLS_Metrics$summary)

## Total Profit/Loss:   $80,845.58
## Return on Capital:   8.1%
## Excess Return to Cash:   0.19%
## Ann. Mean Returns:     1%
## Ann. Return Vol: 0.472%
## Sharpe Ratio:        0.0846
## Sortino Ratio:       0.16
## Skewness:        0.68
## Excess Kurtosis      8.59
## Max Drawdown:        -0.397%
## # of Rebalances: 90
## % of Trades Profitable:  74.4%
## Best Trade Return:   0.715%
## Worst Trade Return:  -0.151%

The chart below shows the return on capital for strategy.

Debt_2Cap_DecileLS_Metrics$pnl_data %>%
  dplyr::mutate(`date` = as.Date(`date`)) %>%
  ggplot() +
  aes(x = date, y = cum_pnl_roc) +
  geom_line(colour = "#112446") +
  scale_y_continuous(labels = scales::percent_format()) + 
  labs(
    title = "Cumulative Return on Capital
Debt_To_Mktcap - Equal Weighted Top - Bottom Decile Return",
    subtitle = 
      paste("Month Start Rebalance from 1/1/2016 through 6/30/2023",
            "Gross Traded 10% of Capital at Rebalance",
            "Cash Rate 1%, Short Rebate Rate 0%",
            sep = "\n"),
    x = "Date",
    y = "Return on Capital") +
  theme_minimal()

I then generated a long short portfolio using the Z-Scores of the Debt_To_Mktcap ratios. The Z-Scores where then Z-Scored again, with windsorization at 5% and 95%, to keep the outliers from getting too much of the weight. Once this second windsorized Z-Score is calculated, a weight is generated by taking the Z-Score and dividing it by the sum of the absolute values of all the Z-Scores and multiplying by 2. Now we have weights that add up to zero, where the positive weights add up to 1, and the negative weights add up to -1. These weights are proportional to the degree to which the Debt_to_Mktcap differs from the average metric value.

The summary results below show that Z-Score weighted portfolio generates slightly better returns than the top-bottom decile equal weighted scheme, with less volatility. By incorporating more securities, the portfolio should have better diversification. The Sharpe was 0.386, and more had a small draw down.

# Start by selecting the Debt_To_Mktcap metrics and removing unnecessary columns.
# Calculate the weights based on weighted z-score
# Add the daily adj_close price data to the portfolio weights.
# Calculate portfolio values based on the capital from the previous trade being passed down.
Debt2Cap_ZWLS <- 
  Metrics_Decile %>%
  dplyr::filter(`metric` == "Debt_To_Mktcap") %>%
  dplyr::select(-c(`metric`, `zacks_sector_code`)) %>%
  tidyr::nest(.by = c("date", "date_next")) %>%
  dplyr::mutate(
    `p_weights_ew` = purrr::pmap(list(`date`, `date_next`, `data`), createZWPortfolio, gross_w = 0.1),
    `p_ew` = purrr::map(`p_weights_ew`, addAdjPrices, prices_df = Prices_SPX_raw),
    `p_ew_ret` = purrr::accumulate(
      `p_ew`, 
      convertWeightstoPortfolio, 
      cash_return = cash_return,
      init_capital = initial_capital),
    # Accumulate is annoying in that it doesn't do a great job for the first value
    `p_ew_ret` = purrr::modify_in(
      `p_ew_ret`,
      1, 
      calcReturn,
      cash_return = cash_return, 
      capital = initial_capital)) %>%
  dplyr::pull(`p_ew_ret`)

Debt_2Cap_ZWLS_Metrics <- getMetrics(Debt2Cap_ZWLS)
cat(Debt_2Cap_ZWLS_Metrics$summary)

## Total Profit/Loss:   $87,926.39
## Return on Capital:   8.8%
## Excess Return to Cash:   0.9%
## Ann. Mean Returns:   1.1%
## Ann. Return Vol: 0.328%
## Sharpe Ratio:        0.386
## Sortino Ratio:       0.76
## Skewness:        0.752
## Excess Kurtosis      13.1
## Max Drawdown:        -0.282%
## # of Rebalances: 90
## % of Trades Profitable:  85.6%
## Best Trade Return:   0.556%
## Worst Trade Return:  -0.087%

The chart below shows the cumulative return on capital for the Z-Score weighted vs the top-bottom quantile equal weighted schemes.

bind_rows(
  "Top - Bottom Decile EW" = Debt_2Cap_DecileLS_Metrics$pnl_data,
  "ZScore Long - Short" = Debt_2Cap_ZWLS_Metrics$pnl_data,
  .id = "Portfolio Construction") %>%
  dplyr::mutate(`date` = as.Date(`date`)) %>%
  ggplot() +
  aes(x = date, y = cum_pnl_roc, colour = `Portfolio Construction`) +
  geom_line() +
  scale_color_hue(direction = 1) +
  scale_y_continuous(labels = scales::percent_format()) + 
  labs(
    title = "Cumulative Return on Capital
Debt_To_Mktcap
Equal Weighted Top - Bottom Decile vs Z-Score Weighted Return",
    subtitle = 
      paste("Month Start Rebalance from 1/1/2016 through 6/30/2023",
            "Gross Traded 10% of Capital at Rebalance",
            "Cash Rate 1%, Short Rebate Rate 0%",
            sep = "\n"),
    x = "Date",
    y = "Return on Capital") +
  theme_minimal()

Analysis - Return_On_Inv

The second analysis will be on the Return_On_Inv metric. To start I looked at the performance of each decile as a long-only portfolio investing 100% of the $1,000,000 capital each period. The chart below shows the performance of these decile portfolios. Unlike the Debt_To_Mkcap metric, the performance of the Return_On_Inv deciles is a lot more monotonic but in reverse order, with decile 1 and decile 2 (bottom decile) being the top 2 performing, and declie 9 and declie 10 (top decile) being the bottom 2.

# Start by selecting the Return_On_Inv metrics and removing unnecessary columns.
# Split securities by declie
# Calculate the weights based on buying 1/n of each security within each declie (Equal Weighted Long Only)
# Add the daily adjPclose price data to the portfolio weights
# Calculate the portfolio values based on the capital from the previous trade being passed down
# Calculate the P&L for each quantile portfolio
RetOnInv_Decile <-
  Metrics_Decile %>%
  dplyr::arrange(`date`) %>%
  dplyr::filter(`metric` == "Return_On_Inv") %>%
  dplyr::select(-c(`metric`, `zacks_sector_code`)) %>%
  tidyr::nest(.by = c("value_q")) %>%
  dplyr::mutate(
    `data_l` = purrr::map(
      `data`, 
      \(x) x %>%
        tidyr::nest(.by = c("date", "date_next")) %>%
        dplyr::mutate(
          `p_weights_ew` = purrr::pmap(list(`date`, `date_next`, `data`), createEWQLOPortfolio),
          `p_ew` = purrr::map(`p_weights_ew`, addAdjPrices, prices_df = Prices_SPX_raw),
          `p_ew_ret` = purrr::accumulate(
            `p_ew`, 
            convertWeightstoPortfolio, 
            cash_return = cash_return,
            init_capital = initial_capital),
          `p_ew_ret` = purrr::modify_in(
            `p_ew_ret`, 1, calcReturn, cash_return = cash_return, capital = initial_capital)) %>%
        dplyr::pull(`p_ew_ret`))) %>%
  dplyr::mutate(`metrics` = purrr::map(`data_l`, getMetrics)) %>%
  dplyr::mutate(`pnl` = purrr::map(`metrics`, \(x) x$pnl_data)) %>%
  dplyr::select(`value_q`, `pnl`) %>%
  tidyr::unnest(cols=c(`pnl`))

RetOnInv_Decile %>%
  dplyr::mutate(`date` = as.Date(`date`)) %>%
  ggplot() +
  aes(x = date, y = cum_pnl_roc, colour = value_q) +
  geom_line() +
  scale_color_hue(direction = 1) +
  scale_y_continuous(labels = scales::percent_format()) + 
  labs(
    title = "Return_On_Inv - Equal Weighted Decile Total Return",
    subtitle = "Month Start Rebalance from 1/1/2016 through 6/30/2023",
    x = "Date",
    y = "Quantile Total Return",
    color = "Quantile") +
  theme_minimal()

Next I generated returns on a long-short portfolio where the strategy went long the top decile of Return_On_Inv and short the bottom decile. In each period gross notional equity exposure was limited to 10% of the initial capital at the rebalance. The uninvested cash earned an annual return of 1%.

The results below show that that while the portfolio generated positive returns of $25,938.18, the excess return to cash was negative, underperforming a 1% annual return. Of the 90 rebalances, only 56.7% generated positive returns. The returns where negatively skewed with very high excess kurtosis.

# Start by selecting the Return_On_Inv metrics and removing unnecessary columns.
# Calculate the weights based on buying 1/n % in the top decile and shorting 1/n % in the bottom decile.
# Add the daily adj_close price data to the portfolio weights.
# Calculate portfolio values based on the capital from the previous trade being passed down.
RetOnInv_DecileLS <- 
  Metrics_Decile %>%
  dplyr::filter(`metric` == "Return_On_Inv") %>%
  dplyr::select(-c(`metric`, `zacks_sector_code`)) %>%
  tidyr::nest(.by = c("date", "date_next")) %>%
  dplyr::mutate(
    `p_weights_ew` = purrr::pmap(list(`date`, `date_next`, `data`), createEWQLSPortfolio, gross_w = 0.1),
    `p_ew` = purrr::map(`p_weights_ew`, addAdjPrices, prices_df = Prices_SPX_raw),
    `p_ew_ret` = purrr::accumulate(
      `p_ew`, 
      convertWeightstoPortfolio, 
      cash_return = cash_return,
      init_capital = initial_capital),
    # Accumulate is annoying in that it doesn't do a great job for the first value
    `p_ew_ret` = purrr::modify_in(
      `p_ew_ret`,
      1, 
      calcReturn,
      cash_return = cash_return, 
      capital = initial_capital)) %>%
  dplyr::pull(`p_ew_ret`)

RetOnInv_DecileLS_Metrics <- getMetrics(RetOnInv_DecileLS)
cat(RetOnInv_DecileLS_Metrics$summary)

## Total Profit/Loss:   $25,938.18
## Return on Capital:   2.6%
## Excess Return to Cash:   -5.3%
## Ann. Mean Returns:   0.35%
## Ann. Return Vol: 0.882%
## Sharpe Ratio:        -0.741
## Sortino Ratio:       -1.12
## Skewness:        -1.53
## Excess Kurtosis      18.6
## Max Drawdown:        -2.06%
## # of Rebalances: 90
## % of Trades Profitable:  56.7%
## Best Trade Return:   0.611%
## Worst Trade Return:  -0.942%

The chart below shows the return on capital for strategy.

RetOnInv_DecileLS_Metrics$pnl_data %>%
  dplyr::mutate(`date` = as.Date(`date`)) %>%
  ggplot() +
  aes(x = date, y = cum_pnl_roc) +
  geom_line(colour = "#112446") +
  scale_y_continuous(labels = scales::percent_format()) + 
  labs(
    title = "Cumulative Return on Capital
Return_On_Inv - Equal Weighted Top - Bottom Decile Return",
    subtitle = 
      paste("Month Start Rebalance from 1/1/2016 through 6/30/2023",
            "Gross Traded 10% of Capital at Rebalance",
            "Cash Rate 1%, Short Rebate Rate 0%",
            sep = "\n"),
    x = "Date",
    y = "Return on Capital") +
  theme_minimal()

I then generated a long short portfolio using the Z-Scores of the Return_On_Inv ratios, using the same process as done with Debt_To_Mktcap.

# Start by selecting the Return_On_Inv metrics and removing unnecessary columns.
# Calculate the weights based on weighted z-score
# Add the daily adj_close price data to the portfolio weights.
# Calculate portfolio values based on the capital from the previous trade being passed down.
RetOnInv_ZWLS <- 
  Metrics_Decile %>%
  dplyr::filter(`metric` == "Return_On_Inv") %>%
  dplyr::select(-c(`metric`, `zacks_sector_code`)) %>%
  tidyr::nest(.by = c("date", "date_next")) %>%
  dplyr::mutate(
    `p_weights_ew` = purrr::pmap(list(`date`, `date_next`, `data`), createZWPortfolio, gross_w = 0.1),
    `p_ew` = purrr::map(`p_weights_ew`, addAdjPrices, prices_df = Prices_SPX_raw),
    `p_ew_ret` = purrr::accumulate(
      `p_ew`, 
      convertWeightstoPortfolio, 
      cash_return = cash_return,
      init_capital = initial_capital),
    # Accumulate is annoying in that it doesn't do a great job for the first value
    `p_ew_ret` = purrr::modify_in(
      `p_ew_ret`,
      1, 
      calcReturn,
      cash_return = cash_return, 
      capital = initial_capital)) %>%
  dplyr::pull(`p_ew_ret`)

RetOnInv_ZWLS_Metrics <- getMetrics(RetOnInv_ZWLS)
cat(RetOnInv_ZWLS_Metrics$summary)

## Total Profit/Loss:   $38,914.26
## Return on Capital:   3.9%
## Excess Return to Cash:    -4%
## Ann. Mean Returns:   0.51%
## Ann. Return Vol: 0.659%
## Sharpe Ratio:        -0.74
## Sortino Ratio:       -1.12
## Skewness:        -1.71
## Excess Kurtosis      21.7
## Max Drawdown:        -1.92%
## # of Rebalances: 90
## % of Trades Profitable:  66.7%
## Best Trade Return:   0.514%
## Worst Trade Return:  -0.836%

The chart below shows the cumulative return on capital for the Z-Score weighted vs the top-bottom quantile equal weighted schemes.

bind_rows(
  "Top - Bottom Decile EW" = RetOnInv_DecileLS_Metrics$pnl_data,
  "ZScore Long - Short" = RetOnInv_ZWLS_Metrics$pnl_data,
  .id = "Portfolio Construction") %>%
  dplyr::mutate(`date` = as.Date(`date`)) %>%
  ggplot() +
  aes(x = date, y = cum_pnl_roc, colour = `Portfolio Construction`) +
  geom_line() +
  scale_color_hue(direction = 1) +
  scale_y_continuous(labels = scales::percent_format()) + 
  labs(
    title = "Cumulative Return on Capital
Return_On_Inv
Equal Weighted Top - Bottom Decile vs Z-Score Weighted Return",
    subtitle = 
      paste("Month Start Rebalance from 1/1/2016 through 6/30/2023",
            "Gross Traded 10% of Capital at Rebalance",
            "Cash Rate 1%, Short Rebate Rate 0%",
            sep = "\n"),
    x = "Date",
    y = "Return on Capital") +
  theme_minimal()

Analysis - Price_To_Earnings

The third analysis will be on the Price_To_Earnings metric. To start I looked at the performance of each decile as a long-only portfolio investing 100% of the $1,000,000 capital each period. The chart below shows the performance of these decile portfolios. Like the performance of the Return_On_Inv deciles, Price_To_Earnings is somewhat monotonic but in reverse order, with decile 9 and decile 10 (top decile) being the top 2 performing, and declie 1 and declie 2 (bottom decile) being among the bottom. This makes somewhat sense, because during the analysis period there were major rallies in more speculative names following the covid-19 stimulus. We also have massive survivorship bias, and inclusivity bias (we know what companies will have large market caps at the end).

# Start by selecting the Price_To_Earnings metrics and removing unnecessary columns.
# Split securities by declie
# Calculate the weights based on buying 1/n of each security within each declie (Equal Weighted Long Only)
# Add the daily adjPclose price data to the portfolio weights
# Calculate the portfolio values based on the capital from the previous trade being passed down
# Calculate the P&L for each quantile portfolio
PriceToEarnings_Decile <-
  Metrics_Decile %>%
  dplyr::arrange(`date`) %>%
  dplyr::filter(`metric` == "Price_To_Earnings") %>%
  dplyr::select(-c(`metric`, `zacks_sector_code`)) %>%
  tidyr::nest(.by = c("value_q")) %>%
  dplyr::mutate(
    `data_l` = purrr::map(
      `data`, 
      \(x) x %>%
        tidyr::nest(.by = c("date", "date_next")) %>%
        dplyr::mutate(
          `p_weights_ew` = purrr::pmap(list(`date`, `date_next`, `data`), createEWQLOPortfolio),
          `p_ew` = purrr::map(`p_weights_ew`, addAdjPrices, prices_df = Prices_SPX_raw),
          `p_ew_ret` = purrr::accumulate(
            `p_ew`, 
            convertWeightstoPortfolio, 
            cash_return = cash_return,
            init_capital = initial_capital),
          `p_ew_ret` = purrr::modify_in(
            `p_ew_ret`, 1, calcReturn, cash_return = cash_return, capital = initial_capital)) %>%
        dplyr::pull(`p_ew_ret`))) %>%
  dplyr::mutate(`metrics` = purrr::map(`data_l`, getMetrics)) %>%
  dplyr::mutate(`pnl` = purrr::map(`metrics`, \(x) x$pnl_data)) %>%
  dplyr::select(`value_q`, `pnl`) %>%
  tidyr::unnest(cols=c(`pnl`))

PriceToEarnings_Decile %>%
  dplyr::mutate(`date` = as.Date(`date`)) %>%
  ggplot() +
  aes(x = date, y = cum_pnl_roc, colour = value_q) +
  geom_line() +
  scale_color_hue(direction = 1) +
  scale_y_continuous(labels = scales::percent_format()) + 
  labs(
    title = "Price_To_Earnings - Equal Weighted Decile Total Return",
    subtitle = "Month Start Rebalance from 1/1/2016 through 6/30/2023",
    x = "Date",
    y = "Quantile Total Return",
    color = "Quantile") +
  theme_minimal()

Next I generated returns on a long-short portfolio where the strategy went long the top decile of Price_To_Earnings and short the bottom decile. In each period gross notional equity exposure was limited to 10% of the initial capital at the rebalance. The uninvested cash earned an annual return of 1%.

The results below are surprising, with the strategy generating the better results than the previous two ratios. The summary metrics below show that the Excess return vs cash was 2.8%.

# Start by selecting the Price_To_Earnings metrics and removing unnecessary columns.
# Calculate the weights based on buying 1/n % in the top decile and shorting 1/n % in the bottom decile.
# Add the daily adj_close price data to the portfolio weights.
# Calculate portfolio values based on the capital from the previous trade being passed down.
PriceToEarnings_DecileLS <- 
  Metrics_Decile %>%
  dplyr::filter(`metric` == "Price_To_Earnings") %>%
  dplyr::select(-c(`metric`, `zacks_sector_code`)) %>%
  tidyr::nest(.by = c("date", "date_next")) %>%
  dplyr::mutate(
    `p_weights_ew` = purrr::pmap(list(`date`, `date_next`, `data`), createEWQLSPortfolio, gross_w = 0.1),
    `p_ew` = purrr::map(`p_weights_ew`, addAdjPrices, prices_df = Prices_SPX_raw),
    `p_ew_ret` = purrr::accumulate(
      `p_ew`, 
      convertWeightstoPortfolio, 
      cash_return = cash_return,
      init_capital = initial_capital),
    # Accumulate is annoying in that it doesn't do a great job for the first value
    `p_ew_ret` = purrr::modify_in(
      `p_ew_ret`,
      1, 
      calcReturn,
      cash_return = cash_return, 
      capital = initial_capital)) %>%
  dplyr::pull(`p_ew_ret`)

PriceToEarnings_DecileLS_Metrics <- getMetrics(PriceToEarnings_DecileLS)
cat(PriceToEarnings_DecileLS_Metrics$summary)

## Total Profit/Loss:   $106,818.17
## Return on Capital:    11%
## Excess Return to Cash:   2.8%
## Ann. Mean Returns:   1.4%
## Ann. Return Vol: 0.728%
## Sharpe Ratio:        0.493
## Sortino Ratio:       0.905
## Skewness:        0.915
## Excess Kurtosis      12.6
## Max Drawdown:        -0.779%
## # of Rebalances: 90
## % of Trades Profitable:  74.4%
## Best Trade Return:   0.744%
## Worst Trade Return:  -0.334%

The chart below shows the return on capital for strategy.

PriceToEarnings_DecileLS_Metrics$pnl_data %>%
  dplyr::mutate(`date` = as.Date(`date`)) %>%
  ggplot() +
  aes(x = date, y = cum_pnl_roc) +
  geom_line(colour = "#112446") +
  scale_y_continuous(labels = scales::percent_format()) + 
  labs(
    title = "Cumulative Return on Capital
Price_To_Earnings - Equal Weighted Top - Bottom Decile Return",
    subtitle = 
      paste("Month Start Rebalance from 1/1/2016 through 6/30/2023",
            "Gross Traded 10% of Capital at Rebalance",
            "Cash Rate 1%, Short Rebate Rate 0%",
            sep = "\n"),
    x = "Date",
    y = "Return on Capital") +
  theme_minimal()

I then generated a long short portfolio using the Z-Scores of the Return_On_Inv ratios, using the same process as done with Debt_To_Mktcap and Return_On_Inv.

The summary results below show that Z-Score weighted portfolio generates worse returns than the top-bottom decile equal weighted scheme, with similar volatility. The scheme generated an excess return to cash of 0.82%. The worst monthly reblance return was nearly 2x that of the top-bottom decile scheme.

# Start by selecting the Price_To_Earnings metrics and removing unnecessary columns.
# Calculate the weights based on weighted z-score
# Add the daily adj_close price data to the portfolio weights.
# Calculate portfolio values based on the capital from the previous trade being passed down.
PriceToEarnings_ZWLS <- 
  Metrics_Decile %>%
  dplyr::filter(`metric` == "Price_To_Earnings") %>%
  dplyr::select(-c(`metric`, `zacks_sector_code`)) %>%
  tidyr::nest(.by = c("date", "date_next")) %>%
  dplyr::mutate(
    `p_weights_ew` = purrr::pmap(list(`date`, `date_next`, `data`), createZWPortfolio, gross_w = 0.1),
    `p_ew` = purrr::map(`p_weights_ew`, addAdjPrices, prices_df = Prices_SPX_raw),
    `p_ew_ret` = purrr::accumulate(
      `p_ew`, 
      convertWeightstoPortfolio, 
      cash_return = cash_return,
      init_capital = initial_capital),
    # Accumulate is annoying in that it doesn't do a great job for the first value
    `p_ew_ret` = purrr::modify_in(
      `p_ew_ret`,
      1, 
      calcReturn,
      cash_return = cash_return, 
      capital = initial_capital)) %>%
  dplyr::pull(`p_ew_ret`)

PriceToEarnings_ZWLS_Metrics <- getMetrics(PriceToEarnings_ZWLS)
cat(PriceToEarnings_ZWLS_Metrics$summary)

## Total Profit/Loss:   $87,089.75
## Return on Capital:   8.7%
## Excess Return to Cash:   0.82%
## Ann. Mean Returns:   1.1%
## Ann. Return Vol: 0.715%
## Sharpe Ratio:        0.165
## Sortino Ratio:       0.288
## Skewness:        0.43
## Excess Kurtosis      13.8
## Max Drawdown:        -1.05%
## # of Rebalances: 90
## % of Trades Profitable:  73.3%
## Best Trade Return:   0.774%
## Worst Trade Return:  -0.688%

The chart below shows the cumulative return on capital for the Z-Score weighted vs the top-bottom quantile equal weighted schemes.

bind_rows(
  "Top - Bottom Decile EW" = PriceToEarnings_DecileLS_Metrics$pnl_data,
  "ZScore Long - Short" = PriceToEarnings_ZWLS_Metrics$pnl_data,
  .id = "Portfolio Construction") %>%
  dplyr::mutate(`date` = as.Date(`date`)) %>%
  ggplot() +
  aes(x = date, y = cum_pnl_roc, colour = `Portfolio Construction`) +
  geom_line() +
  scale_color_hue(direction = 1) +
  scale_y_continuous(labels = scales::percent_format()) + 
  labs(
    title = "Cumulative Return on Capital
Price_To_Earnings
Equal Weighted Top - Bottom Decile vs Z-Score Weighted Return",
    subtitle = 
      paste("Month Start Rebalance from 1/1/2016 through 6/30/2023",
            "Gross Traded 10% of Capital at Rebalance",
            "Cash Rate 1%, Short Rebate Rate 0%",
            sep = "\n"),
    x = "Date",
    y = "Return on Capital") +
  theme_minimal()

Analysis - Leverage_And_ROI

The final analysis will be on the Leverage_And_ROI metric. This is the metric I calculated by multiplying the Z-Score of Debt_To_Mktcap by the Z-Score of Return_On_Inv. To start I looked at the performance of each decile as a long-only portfolio investing 100% of the $1,000,000 capital each period. The chart below shows the performance of these decile portfolios. Like the performance of the Debt_To_Mktcap deciles, Leverage_And_ROI’s top and bottom decile are the top 2 performing deciles over the analysis period.

# Start by selecting the Leverage_And_ROI metrics and removing unnecessary columns.
# Split securities by declie
# Calculate the weights based on buying 1/n of each security within each declie (Equal Weighted Long Only)
# Add the daily adjPclose price data to the portfolio weights
# Calculate the portfolio values based on the capital from the previous trade being passed down
# Calculate the P&L for each quantile portfolio
LeverageAndROI_Decile <-
  Metrics_Decile %>%
  dplyr::arrange(`date`) %>%
  dplyr::filter(`metric` == "Leverage_And_ROI") %>%
  dplyr::select(-c(`metric`, `zacks_sector_code`)) %>%
  tidyr::nest(.by = c("value_q")) %>%
  dplyr::mutate(
    `data_l` = purrr::map(
      `data`, 
      \(x) x %>%
        tidyr::nest(.by = c("date", "date_next")) %>%
        dplyr::mutate(
          `p_weights_ew` = purrr::pmap(list(`date`, `date_next`, `data`), createEWQLOPortfolio),
          `p_ew` = purrr::map(`p_weights_ew`, addAdjPrices, prices_df = Prices_SPX_raw),
          `p_ew_ret` = purrr::accumulate(
            `p_ew`, 
            convertWeightstoPortfolio, 
            cash_return = cash_return,
            init_capital = initial_capital),
          `p_ew_ret` = purrr::modify_in(
            `p_ew_ret`, 1, calcReturn, cash_return = cash_return, capital = initial_capital)) %>%
        dplyr::pull(`p_ew_ret`))) %>%
  dplyr::mutate(`metrics` = purrr::map(`data_l`, getMetrics)) %>%
  dplyr::mutate(`pnl` = purrr::map(`metrics`, \(x) x$pnl_data)) %>%
  dplyr::select(`value_q`, `pnl`) %>%
  tidyr::unnest(cols=c(`pnl`))

LeverageAndROI_Decile %>%
  dplyr::mutate(`date` = as.Date(`date`)) %>%
  ggplot() +
  aes(x = date, y = cum_pnl_roc, colour = value_q) +
  geom_line() +
  scale_color_hue(direction = 1) +
  scale_y_continuous(labels = scales::percent_format()) + 
  labs(
    title = "Leverage_And_ROI - Equal Weighted Decile Total Return",
    subtitle = "Month Start Rebalance from 1/1/2016 through 6/30/2023",
    x = "Date",
    y = "Quantile Total Return",
    color = "Quantile") +
  theme_minimal()

Next I generated returns on a long-short portfolio where the strategy went long the top decile of Leverage_And_ROI and short the bottom decile. In each period gross notional equity exposure was limited to 10% of the initial capital at the rebalance. The uninvested cash earned an annual return of 1%.

The results below show that strategy did not outperform cash, generating a -1.6% to cash.

# Start by selecting the Leverage_And_ROI metrics and removing unnecessary columns.
# Calculate the weights based on buying 1/n % in the top decile and shorting 1/n % in the bottom decile.
# Add the daily adj_close price data to the portfolio weights.
# Calculate portfolio values based on the capital from the previous trade being passed down.
LeverageAndROI_DecileLS <- 
  Metrics_Decile %>%
  dplyr::filter(`metric` == "Leverage_And_ROI") %>%
  dplyr::select(-c(`metric`, `zacks_sector_code`)) %>%
  tidyr::nest(.by = c("date", "date_next")) %>%
  dplyr::mutate(
    `p_weights_ew` = purrr::pmap(list(`date`, `date_next`, `data`), createEWQLSPortfolio, gross_w = 0.1),
    `p_ew` = purrr::map(`p_weights_ew`, addAdjPrices, prices_df = Prices_SPX_raw),
    `p_ew_ret` = purrr::accumulate(
      `p_ew`, 
      convertWeightstoPortfolio, 
      cash_return = cash_return,
      init_capital = initial_capital),
    # Accumulate is annoying in that it doesn't do a great job for the first value
    `p_ew_ret` = purrr::modify_in(
      `p_ew_ret`,
      1, 
      calcReturn,
      cash_return = cash_return, 
      capital = initial_capital)) %>%
  dplyr::pull(`p_ew_ret`)

LeverageAndROI_DecileLS_Metrics <- getMetrics(LeverageAndROI_DecileLS)
cat(LeverageAndROI_DecileLS_Metrics$summary)

## Total Profit/Loss:   $62,473.82
## Return on Capital:   6.2%
## Excess Return to Cash:   -1.6%
## Ann. Mean Returns:   0.81%
## Ann. Return Vol: 0.573%
## Sharpe Ratio:        -0.329
## Sortino Ratio:       -0.554
## Skewness:        -0.545
## Excess Kurtosis      9.49
## Max Drawdown:        -0.749%
## # of Rebalances: 90
## % of Trades Profitable:  75.6%
## Best Trade Return:   0.501%
## Worst Trade Return:  -0.621%

The chart below shows the return on capital for strategy.

LeverageAndROI_DecileLS_Metrics$pnl_data %>%
  dplyr::mutate(`date` = as.Date(`date`)) %>%
  ggplot() +
  aes(x = date, y = cum_pnl_roc) +
  geom_line(colour = "#112446") +
  scale_y_continuous(labels = scales::percent_format()) + 
  labs(
    title = "Cumulative Return on Capital
Leverage_And_ROI - Equal Weighted Top - Bottom Decile Return",
    subtitle = 
      paste("Month Start Rebalance from 1/1/2016 through 6/30/2023",
            "Gross Traded 10% of Capital at Rebalance",
            "Cash Rate 1%, Short Rebate Rate 0%",
            sep = "\n"),
    x = "Date",
    y = "Return on Capital") +
  theme_minimal()

I then generated a long short portfolio using the Z-Scores of the Leverage_And_ROI ratios, using the same process as done with the other metrics

The summary results below show that Z-Score weighted portfolio generates slightly better results than the top-bottom decile scheme, with lower vol. However it still underperforms cash. The skewness of the portfolio is much more negative (-1.3 vs -0.55) and higher excess kurtosis (20.4 vs 9.5)

# Start by selecting the Leverage_And_ROI metrics and removing unnecessary columns.
# Calculate the weights based on weighted z-score
# Add the daily adj_close price data to the portfolio weights.
# Calculate portfolio values based on the capital from the previous trade being passed down.
LeverageAndROI_ZWLS <- 
  Metrics_Decile %>%
  dplyr::filter(`metric` == "Leverage_And_ROI") %>%
  dplyr::select(-c(`metric`, `zacks_sector_code`)) %>%
  tidyr::nest(.by = c("date", "date_next")) %>%
  dplyr::mutate(
    `p_weights_ew` = purrr::pmap(list(`date`, `date_next`, `data`), createZWPortfolio, gross_w = 0.1),
    `p_ew` = purrr::map(`p_weights_ew`, addAdjPrices, prices_df = Prices_SPX_raw),
    `p_ew_ret` = purrr::accumulate(
      `p_ew`, 
      convertWeightstoPortfolio, 
      cash_return = cash_return,
      init_capital = initial_capital),
    # Accumulate is annoying in that it doesn't do a great job for the first value
    `p_ew_ret` = purrr::modify_in(
      `p_ew_ret`,
      1, 
      calcReturn,
      cash_return = cash_return, 
      capital = initial_capital)) %>%
  dplyr::pull(`p_ew_ret`)

LeverageAndROI_ZWLS_Metrics <- getMetrics(LeverageAndROI_ZWLS)
cat(LeverageAndROI_ZWLS_Metrics$summary)

## Total Profit/Loss:   $68,199.09
## Return on Capital:   6.8%
## Excess Return to Cash:   -1.1%
## Ann. Mean Returns:   0.88%
## Ann. Return Vol: 0.441%
## Sharpe Ratio:        -0.267
## Sortino Ratio:       -0.437
## Skewness:        -1.29
## Excess Kurtosis      20.4
## Max Drawdown:        -0.651%
## # of Rebalances: 90
## % of Trades Profitable:  82.2%
## Best Trade Return:   0.348%
## Worst Trade Return:  -0.53%

The chart below shows the cumulative return on capital for the Z-Score weighted vs the top-bottom quantile equal weighted schemes.

bind_rows(
  "Top - Bottom Decile EW" = LeverageAndROI_DecileLS_Metrics$pnl_data,
  "ZScore Long - Short" = LeverageAndROI_ZWLS_Metrics$pnl_data,
  .id = "Portfolio Construction") %>%
  dplyr::mutate(`date` = as.Date(`date`)) %>%
  ggplot() +
  aes(x = date, y = cum_pnl_roc, colour = `Portfolio Construction`) +
  geom_line() +
  scale_color_hue(direction = 1) +
  scale_y_continuous(labels = scales::percent_format()) + 
  labs(
    title = "Cumulative Return on Capital
Leverage_And_ROI
Equal Weighted Top - Bottom Decile vs Z-Score Weighted Return",
    subtitle = 
      paste("Month Start Rebalance from 1/1/2016 through 6/30/2023",
            "Gross Traded 10% of Capital at Rebalance",
            "Cash Rate 1%, Short Rebate Rate 0%",
            sep = "\n"),
    x = "Date",
    y = "Return on Capital") +
  theme_minimal()

Sunmary

In the analysis above I combined multiple tables from Zacks and QuoteMedia to generate daily financial ratio metrics for a subset of the S&P 500 constituents. The data is a mixture of quarterly and annual financial data and daiy price data. I limited look-ahead bias by using financial data 1 day after the filing date. Using the financial data and price data I created 3 metrics, Debt_To_Mktcap, Return_On_Inv, and Price_To_Earnings. A fourth metric, Leverage_And_ROI, was created by multiplying the Z-Score of Debt_To_Mktcap and the Z-Score of Return_On_Inv. I then deciled the metrics, and looked at the performance of each decile over the analysis period. I then created a long-short portfolio by buying the top decile companies with equal-weights and shorting the bottom decile companies with equal weights. I also created a long-short portfolio using a proportional Z-Score weighting scheme. In most cases, except Price_To_Earnings, the Z-Score weighting scheme provided higher returns with lower volatility. Price_To_Earnings was the highest performing metric, and the only one to generate a higher return than cash.

Homework 3: Financial Ratio Quantile Strategies

Taylor Wood

2024-01-27

Introduction

Assumptions

Function and Classes for Analysis

Data

Analysis - Debt_To_Mktcap

Analysis - Return_On_Inv

Analysis - Price_To_Earnings

Analysis - Leverage_And_ROI

Sunmary