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)
library(readxl)
library(data.table)
## 
## Attaching package: 'data.table'
## 
## The following object is masked from 'package:DescTools':
## 
##     %like%
## 
## The following objects are masked from 'package:xts':
## 
##     first, last
## 
## The following objects are masked from 'package:lubridate':
## 
##     hour, isoweek, mday, minute, month, quarter, second, wday, week,
##     yday, year
## 
## The following objects are masked from 'package:dplyr':
## 
##     between, first, last
## 
## The following object is masked from 'package:purrr':
## 
##     transpose
Quandl.api_key("EsFRJz6Xd3CxmytxKgCB")

Introduction

The purpose of this study is to examine the returns of carry trades involving foreign emerging market debt. The parameters of the strategy are to invest $2mm USD in capital, borrowing $8mm worth of USD in GBP at the shortest tenor OIS rate + 50bps (1 Month), and investing in the 5 Year foreign bond. The strategy will make a new trade every week, and start with $2mm USD every week. The strategies will buy Egyptian, Hungarian, Costa Rican, and Romanian bonds. The study will look at the return distribution of each strategy, and investigate return metrics. I assume that the funding rate is the same every day within that week.

Carry premium is the return generated for “carrying” risk. In this case we are carrying FX risk, in both the difference in the strategy to lending currency and strategy to funding currency, yield curve risk, in which we are borrowing at short term rates and lending at long term rates, as well as the credit risk, in which we are borrowing at a lower credit risk and lending at a higher credit risk. In the case that the FX rates do not change, the yield curves do not change, and the credit spreads do not change, we should earn a premium from the credit and the yield curve differences.

However, uncovered interest rate parity theory says that the difference in the nominal interest rates between our borrowing rate and our lending rate is equal to the expected change in the currencies. If we were to try to hedge the FX risk between our borrowing and lending currencies, we should expect that for the same tenor, the hedge would cost the difference. This however is not always seen in practice. In fact, the returns are on average positive for most of the carry trade strategies, especially prior to the rising rate period following COVID-19. In that case, our duration risk stymied returns.

The analysis below shows that the carry trades exhibit a lot of the typical signs of carry trades, with negative skews, high excess kurtosis, hit rates above 50%, high correlation to equity returns, and negative correlations to VIX.

Functions

The following function are used in the analysis to interpolate yields, compute zero coupon bond curves, calculate the bond prices, calculate returns of the strategy, download Fama-French factor data, and download VIX data.

interpolate_yield <- function(rates, tenors){
  yield_curve <- rates
  names(yield_curve) <- tenors
  
  if(length(which(!is.na(yield_curve)))<2){
    return(yield_curve)
  }else{
    y <- approx(
      x = as.numeric(names(yield_curve)), 
      y = yield_curve, 
      xout = as.numeric(names(yield_curve)),
      rule = 2)
    return(y$y)
  }
}

compute_zcb_curve <- function(rates, tenors){
  
  if(length(rates) == 0 | length(tenors) == 0){
    return(NULL)
  }
  
  spot_rates_curve <- rates
  names(spot_rates_curve) <- tenors
  zcb_rates <- spot_rates_curve
  
  for(i in 1:length(spot_rates_curve)){
    tenor <- as.numeric(names(spot_rates_curve)[i])
    spot_rate <- spot_rates_curve[i]
    
    if(tenor <= 0.001){next}
    
    times <- seq(0, (tenor-0.5), 0.5)[-1]
    coupon_half_yr = 0.5 * spot_rate
    z = approx(x = as.numeric(names(zcb_rates)), y = zcb_rates, xout = times)$y
    preceding_coupons_val = sum((coupon_half_yr * exp(-z * times)))
    
    zcb <- -log((1 - preceding_coupons_val) / (1 + coupon_half_yr))/ tenor
    zcb_rates[i] <- zcb
    }
  return(zcb_rates)
}

calc_bond_price <- function(zcb_rates, zcb_tenors, tenor, coupon_rate){
  
  if(length(zcb_rates)==0 | length(zcb_tenors)==0){
    return(NA)}
  
  times <- seq(tenor, 0, by = -0.5)
  
  if(times[length(times)] == 0){
    times <- times[1:(length(times)-1)]}

  if(length(times) == 0){
    p = 1
  }else{
    r = approx(x = as.numeric(zcb_tenors), y = zcb_rates, xout = times, rule = 2)$y
    p = exp(-tenor*r[1]) + 0.5 * coupon_rate * sum(exp(-r*times))
  }
  return(p)
}


calc_carry_return <- function(
    dates, strat2fundFX, strat2lendFX, borrowrate, borrow5Y, 
    lendtenors, lendspotcurve, leverage = 5){
  # Calculate the  return to a carry trade
  # Function uses the lending spot curve to calculate the zero coupon curve
  # The zero coupon curve is then used to calc the bond price in the lending FX
  # The change in the strategy to lending FX is then applied to the change in the bond price
  # And added to the borrow rate, which is adjusted by the change in the strategy to borrow FX
  # Because we are using leverage, if cumulative return moves below -100%, returns are capped to -100%
  #
  # Args:
  #   dates: An n length array of dates
  #   strat2fundFX: An n length numerical array of FX rates from strategy to funding currency
  #   strat2lenfFX: An n length numerical array of FX rates from strategy to lending currency
  #   borrowrate: The borrowing rate in borrow currency
  #   borrow5Y: The 5 year spot rate of borrow currency
  #   lendtenors: An n length list of tenors for borrow spot rates
  #   lendspotcurve: An n length list of spot rates for borrow currency
  #   leverage: A numerical representing the X:1 leverage applied to strategy
  #
  # Returns:
  #   An n lenght array of percentage returns in strategy currency
  
  # Pull tenor as list of numeric array
  lendtenors <- map(lendtenors, \(x) x$tenor)
  
  # Find initial coupon (assumed to be yield) of 5 Year Swap rate
  init_coupon <- lendspotcurve[[1]] %>%
    dplyr::slice(which(lendtenors[[1]] == 5)) %>%
    dplyr::pull()
  
  # If lending rate is less than 50bps higher than funding rate
  # No trade, returns are zero
  if((borrow5Y[[1]] + .01) > init_coupon){
    return(rep(0, length(dates)))}
  
  # Calculate the change in 5 Year tenor
  tenor_decay <- as.numeric((dates[[1]] - dates) / 364 + 5)
  
  # Calculate the zero coupon bond curve
  zcbcurve <- purrr::map2(lendspotcurve, lendtenors, ~compute_zcb_curve(.x$yield, .y))
  
  # Calculate the bond price for each day using the 
  # zero coupon curve, the initial coupon rate, and tenors less passing of time
  bondprices_lendfx <- 
    purrr::pmap_dbl(
      list(zcbcurve, lendtenors, tenor_decay, init_coupon), 
      calc_bond_price) %>%
    data.table::nafill("locf")
  
  # Calculate the cumulative change in strategy to lending FX
  strat2lendFX_cumchg <- strat2lendFX / strat2lendFX[1] - 1
  
  # Calculate the cumulative change in strategy to borrow FX
  strat2fundFX_cumchg <- strat2fundFX / strat2fundFX[1] - 1
  
  # Calculate the cumulative change in the bond prices in lending FX
  bondprices_lendfx_cumchg <- bondprices_lendfx / bondprices_lendfx[1] - 1
  
  # Calculate the cumulative change in the bond prices in strategy FX
  bondprices_stratfx_cumchg <- (
    (1 + bondprices_lendfx_cumchg) / 
    (1 + strat2lendFX_cumchg) -1) * 
    leverage
  
  # Calculate Daily funding cost
  dailyfundcost <- (borrowrate[[1]] + 0.005) /360
  
  # Calculate the daily funding cost in strategy FX
  fundingcost_stratFX <- c(0, dailyfundcost / (1+strat2fundFX_cumchg[-1]) * -(leverage - 1))
  fundingcost_stratFX_cum <- cumsum(fundingcost_stratFX)
  
  # Calculate the cumulative return 
  cumreturn <- bondprices_stratfx_cumchg + fundingcost_stratFX_cum
  
  # IF cumulative return moves below -100% (possible with leverage)
  # Set all remaining cumulative return to -100%
  if(length(which(cumreturn < -1) >0)){
    broke <- min(which(cumreturn < -1))
    cumreturn[broke:length(cumreturn)] <- -1
  }
  
  # Calculate the daily return
  periodreturn <- (1+ cumreturn) / (1+lag(cumreturn, n = 1, default = 0)) -1
  periodreturn <- replace_na(periodreturn, 0)
  
  return(periodreturn)
}

FFGetDatasetNames <- function(
  url = "https://mba.tuck.dartmouth.edu/pages/faculty/ken.french/data_library.html"){
  # Extract DataSet Names and URLs from Ken French Website
  #
  # Args:
  #   url: Ken French Website
  #
  # Returns:
  #   List containing
  #   Description: Description of dataset
  #   Data: List of data sets with descriptions from file
  url %>%
  rvest::read_html() %>%
  rvest::html_nodes("b") %>%
  as.character() %>%
  tibble::as_tibble(column_name = "value") %>%
  dplyr::mutate(`lead2` = lead(`value`, 2)) %>%
  dplyr::filter(str_detect(`lead2`, "CSV.zip")) %>%
  dplyr::transmute(
    `Name` = stringr::str_extract(`value`, "(?<=\\<b\\>).*(?=\\</b\\>)"),
    `Link` = stringr::str_extract(`lead2`, "ftp.+zip"))
}


FFExtract <- function(df){
  # Extracts description and data for a dataset from Ken French's website.
  #
  # Args:
  #   df: Dataframe containing name/description of data followed by data set
  #       with labels in first rows.
  #
  # Returns:
  #   List containing
  #   Description (char) - the description of the data
  #   Data (numeric dataframe) - the data
  
  # Location of data description
  name.location <- stringr::str_which(df$V1, "[A-z]+") 
  
  # If no description give NA otherwise combine multiple rows
  if(length(name.location) == 0){
    name <- NA
  }else{
    name <- stringr::str_c(
      stringr::str_trim(df[name.location,1][[1]]),
      collapse = " ")}
  
  # Location of data
  data.location <- stringr::str_which(df$V1, "^\\s*[0-9]{4,}")  
  
  data <- df[data.location,] %>%  # Clean data frame
    `colnames<-`(df[min(data.location)-1,]) %>%  # Assign first row as col names
    janitor::clean_names() %>%  # Make col names clean
    dplyr::rename(`Date` = 1) %>%  # First col name will be blank so give "Date"
    dplyr::mutate_all(as.numeric)  # Since df had chars for description convert to num
  return(list("Description" = name, "Data" = data))
}

FFDataDownload <- function(dataset = "Fama/French 3 Factor"){
  # Downloads CSV Data for Data  Ken French's website.
  #
  # Args:
  #   dataset:  Name of Fama French Data Set
  #
  # Returns:
  #   List containing
  #   Description: Description of dataset
  #   Data: List of data sets with descriptions from file
  
  childurls <- FFGetDatasetNames()
  child <- childurls$Link[which(childurls$Name %in% dataset)]
  
  # Create working URL of child
  file.name <- 
    child %>% 
    stringr::str_extract("(?<=/).+(?=\\_CSV\\.zip)") %>%
    stringr::str_c(".CSV")
  
  # Create temporary file for downloading data
  temp <- tempfile()
  
  # Download zip file from Ken French website
  download.file(
    url = 
      stringr::str_c(
        "https://mba.tuck.dartmouth.edu/pages/faculty/ken.french/",
        child),
    destfile = temp)
  
  unzip(temp) # Unzip data file
  
  # Read in CSV file
  raw.data <- read.csv(  
    file.name,
    header = FALSE,
    sep = ",",
    col.names = paste0("V",seq_len(200)),
    fill = T,
    blank.lines.skip = F)
  
  # Remove Leading rows
  file.desc <- 
    raw.data[1:(min(stringr::str_which(raw.data$V1, "^[0-9]{4,}"))-2),1]
  raw.data <- 
    raw.data[(min(stringr::str_which(raw.data$V1, "^[0-9]{4,}"))-2):nrow(raw.data),]
  
  # Split data into different data chunks
  data.chunks <- raw.data %>%
    dplyr::filter(!stringr::str_detect(.[[1]], "Copyright")) %>%
    dplyr::select_if(~!all(is.na(.))) %>%
    dplyr::select_if(~!all(. == "")) %>%
    dplyr::mutate(
      `istext` = ifelse(stringr::str_detect(.[[1]], "[a-z]+"),1,0),
      `change` = ifelse(`istext` == 1 & lag(`istext`,1, default = 0) == 0 , 1, 0),
      `group` = cumsum(`change`)) %>%
    dplyr::select(-c(`istext`, `change`)) %>%
    dplyr::group_split(`group`, .keep = F)
  
  # Extract desc/data from chunks
  extracted.list <- 
    lapply(data.chunks, FFExtract)
  
  return(list(
    "Description" = file.desc,
    "Data" = extracted.list))
}


VIXDownload <- function(){

  vix<- 
    readr::read_csv(
      "https://cdn.cboe.com/api/global/us_indices/daily_prices/VIX_History.csv", 
      col_types = cols(DATE = col_date(format = "%m/%d/%Y"))) %>%
    dplyr::rename(
      `date` = `DATE`,
      `open` = `OPEN`,
      `close` = `CLOSE`,
      `low` = `LOW`,
      `high` = `HIGH`)
  
  return(vix)}

.get_daily_returns <- function(data_all, rebalday = "Wednesday"){
  # Find first data location for lending curve, borrow rate, and borrow 5yr
  firstCurveLoc <- min(which(!unlist(map(data_all$lendspotcurve, is.null))))
  firstborrowrate <- min(which(!unlist(map(data_all$borrowrate, is.na))))
  firstborrow5Y <- min(which(!unlist(map(data_all$borrow5Y, is.na))))
  firstloc <- max(firstCurveLoc, firstborrowrate, firstborrow5Y)
  
  # Find last data location for lending curve
  lastCurveLoc <- max(which(!unlist(map(data_all$lendspotcurve, is.null))))
  lastloc <- min(lastCurveLoc)
  
  # Subset data to where we have data
  data <- data_all %>%
    dplyr::slice(firstCurveLoc:lastCurveLoc) %>%
    tidyr::fill(everything(), .direction = "down")
  
  # Find all locations where day of week is the rebalance day
  rebal_loc <- which(weekdays(data$date)==rebalday)
  
  # Check to see if missing rebalance date
  if(max((rebal_loc - lag(rebal_loc, 1))[-1]) > 7){
    stop("Missing a Rebalance Day in Data")
  }
  
  # Create a list of data
  # This is necessary because end of trade period overlaps with start of next
  data_list <- list()
  for(i in 1:(length(rebal_loc)-1)){
    subdata <- slice(data, rebal_loc[i]:rebal_loc[i+1])
    data_list[[i]] <- subdata
  }
  
  # Apply calc_carry_return function to all data list items
  list_dailyreturns <- lapply(
    data_list,
    \(x) 
    dplyr::mutate(
      x,
      `carry_return` = calc_carry_return(
        dates = `date`,
        strat2fundFX = `strat2fundFX`,
        strat2lendFX = `strat2lendFX`,
        borrowrate = `borrowrate`,
        borrow5Y = `borrow5Y`,
        lendtenors = `lendtenors`,
        lendspotcurve = `lendspotcurve`,
        leverage = 5)) %>%
      dplyr::select(`date`, `carry_return`))
  
  # Combine daily returns and return as data frame
  dailyreturns <- list_dailyreturns %>%
    dplyr::bind_rows() %>%
    dplyr::summarise(`carry_return` = sum(`carry_return`), .by = `date`)
  return(dailyreturns)
}

Download Data

For the study, the following data sets are downloaded 1) OIS data from the Bank of England (must be downloaded previously) 2) FX rates for all currencies used in the study 3) Inferred yield curve data from the class website 4) Fama-French 5 Factor EM and EM Momentum returns 6) SPY prices 5) VIX levels

# Download the UK overnight index swaps data from https://www.bankofengland.co.uk/-/media/boe/files/statistics/yield-curves/oisddata.zip
# Once downloaded, read in both files and bind rows
OISfileDir <-""

OIS_daily_data_2009_to_2015 <- 
  readxl::read_excel(
    paste0(OISfileDir, "OIS_daily_data_2009_to_2015.xlsx"), 
    sheet = "2. spot curve", 
    col_names = TRUE,
    skip = 2) %>%
  slice(-c(1,2)) %>%
  dplyr::rename(`date` = `months:`) %>%
  dplyr::rename_with(
    \(x) as.character(round(as.numeric(x))), 
    .cols = c(everything(), -`date`)) %>%
  dplyr::mutate(`date` = as.Date(as.numeric(`date`), origin = as.Date("1899-12-30"))) %>%
  dplyr::mutate(across(c(everything(), -`date`), as.numeric))

OIS_daily_data_2016_to_present <- 
  readxl::read_excel(
    paste0(OISfileDir, "OIS_daily_data_2016_to_present.xlsx"), 
    sheet = "3. spot, short end", 
    col_names = TRUE,
    skip = 2) %>%
  slice(-c(1,2)) %>%
  dplyr::rename(`date` = `months:`) %>%
  dplyr::rename_with(
    \(x) as.character(round(as.numeric(x))), 
    .cols = c(everything(), -`date`)) %>%
  dplyr::mutate(`date` = as.Date(as.numeric(`date`), origin = as.Date("1899-12-30"))) %>%
  dplyr::mutate(across(c(everything(), -`date`), as.numeric))

OIS_UK <-bind_rows(OIS_daily_data_2009_to_2015, OIS_daily_data_2016_to_present) %>%
  dplyr::select(`date`, `1`, `60`) %>%
  dplyr::rename(
    `UK_OIS_1M` = `1`,
    `UK_OIS_5Y` = `60`) %>%
  dplyr::mutate(
    `UK_OIS_1M` = `UK_OIS_1M` / 100,
    `UK_OIS_5Y` = `UK_OIS_5Y` /100)

# Download spot FX USD-GBP
USDGBP <- Quandl.datatable('EDI/CUR', code='GBP') %>%
  dplyr::rename(`USDGBP` = `rate`) %>%
  dplyr::select(-`code`)

# Download spot FX USD-EGP (Egyptian Pound)
USDEGP <- Quandl.datatable('EDI/CUR', code='EGP') %>%
  dplyr::rename(`USDEGP` = `rate`) %>%
  dplyr::select(-`code`)

# Download spot FX USD-HUF (Hungarian Forint)
USDHUF <- Quandl.datatable('EDI/CUR', code='HUF') %>%
  dplyr::rename(`USDHUF` = `rate`) %>%
  dplyr::select(-`code`)

# Download spot FX USD-CRC (Costa Rican Colon)
USDCRC <- Quandl.datatable('EDI/CUR', code='CRC') %>%
  dplyr::rename(`USDCRC` = `rate`) %>%
  dplyr::select(-`code`)

# Download spot FX USD-RON (Romanian Leu)
USDRON <- Quandl.datatable('EDI/CUR', code='RON') %>%
  dplyr::rename(`USDRON` = `rate`) %>%
  dplyr::select(-`code`)

# Combine FX rates
FXRates_USD <-
  USDGBP %>%
  dplyr::full_join(USDEGP, by = "date") %>%
  dplyr::full_join(USDHUF, by = "date") %>%
  dplyr::full_join(USDCRC, by = "date") %>%
  dplyr::full_join(USDRON, by = "date") %>%
  tidyr::fill(c(everything(), -`date`), .direction = "down")

# Convert to GBP
FXRates_GBP <-
  FXRates_USD %>%
  dplyr::mutate(
    `GBPUSD` = 1/`USDGBP`,
    `GBPEGP` = `USDEGP` / `USDGBP`,
    `GBPHUF` = `USDHUF` / `USDGBP`,
    `GBPCRC` = `USDCRC` / `USDGBP`,
    `GBPRON` = `USDRON` / `USDGBP`,
    .keep = "unused")

# Obtain swap yield curves and FX rates of Egyptian Pound, Hungarian Forint, Costa Rican Colon and Romanian Leu from the earliest possible date through now.
InferredYieldCurves_2024 <- 
  read_delim(
    "InferredYieldCurves_2024.tab", 
    delim = "\t",
    escape_double = FALSE, 
    col_types = cols(...1 = col_skip(), date = col_date(format = "%Y-%m-%d")), 
    trim_ws = TRUE)
## New names:
## • `` -> `...1`
# Download Fama French Emerging Market 5 Factor Model
FF5EM <- 
  FFDataDownload("Fama/French Emerging 5 Factors") %>%
  purrr::pluck("Data") %>%
  purrr::pluck(1) %>%
  purrr::pluck("Data") %>%
  dplyr::mutate(across(everything(), \(x) ifelse(x==-99.99, NA, x)))

# Download Fama French Emerging Market Momentum
FFMOEM <-
  FFDataDownload("Emerging Momentum Factor (Mom)") %>%
  purrr::pluck("Data") %>%
  purrr::pluck(1) %>%
  purrr::pluck("Data") %>%
  dplyr::mutate(across(everything(), \(x) ifelse(x==-99.99, NA, x)))

# Combine Fama French Emerging Market 5 Factor with Momentum
FF6EM <- full_join(FF5EM, FFMOEM, by = "Date") %>%
  dplyr::mutate(`date` = lubridate::ceiling_date(
      as.Date(paste0(`Date`,"01"), format = "%Y%m%d"), unit = "month")-1) %>%
  dplyr::select(-`Date`) %>%
  dplyr::select(`date`, everything()) %>%
  dplyr::mutate(across(c(everything(),-`date`), \(x) x/100))

# Download SPY returns
SPY <- 
  Quandl.datatable('QUOTEMEDIA/PRICES', ticker = "SPY") %>%
  dplyr::arrange(`date`) %>%
  dplyr::select(`date`, `adj_close`) %>%
  dplyr::rename(`SPY` = `adj_close`)

# Download SVOL returns
VIX <- 
  VIXDownload() %>%
  dplyr::arrange(`date`) %>%
  dplyr::rename(`VIX` = `close`) %>%
  dplyr::select(`date`, `VIX`)

Examing EM Debt Yields

The chart below shows the 5 Year spot rates for the EM debt studies in this analysis. As shown in the chart, yields for the four countries rose in 2022 as part of the near synchronous tightening policies by central banks globally, following decades of falling rates. With the exception of Costa Rica, this change was of great magnitude, and happened abruptly. As the strategies are levered, the change in bond yields will have a major effect in the returns to the capital of the strategy.

# For the analysis we look at the yields from the following countries
analysis_fx <- c("Arab Rep Egypt", "Hungary", "Rep Costa Rica", "Romania")

# Expand the spot yield curve to include all the country/tenor/date mixes
# Filter for the currencies in analysis
# Create a numeric representation of tenors in years
# Interpolate missing tenors at each date. If smallest/largest tenor is missing, used min/max value
# Fill remaining missing values with previous values
# Remove Missing values (only first rows now)
# Calculate the Zero Coupon Bond Yield
YieldCurves <-
  InferredYieldCurves_2024 %>%
  dplyr::full_join(
    InferredYieldCurves_2024 %>%
      tidyr::expand(tidyr::nesting(`shortname`, `date`), `tenor`),
    by = c("shortname", "tenor", "date")) %>%
  dplyr::filter(`shortname` %in% analysis_fx) %>%
  dplyr::mutate(
    tenor = case_when(
      str_ends(`tenor`, "Y") ~ as.numeric(str_remove(`tenor`, "Y")),
      str_ends(`tenor`, "M") ~ as.numeric(str_remove(`tenor`, "M"))/12,
      .default = as.numeric(`tenor`))) %>%
  dplyr::arrange(`date`) %>%
  tidyr::nest(
    `tenor` = `tenor`,
    `yield` = `yield`,
    .by = c(`shortname`, `date`)) %>%
  dplyr::mutate(
    `yield` = map2(
      `yield`, 
      `tenor`, 
      ~interpolate_yield(.x$yield, .y$tenor))) %>%
  tidyr::unnest(cols = everything()) %>%
  dplyr::group_by(`shortname`, `tenor`) %>%
  tidyr::fill(`yield`, .direction = "down") %>%
  dplyr::filter(!is.na(`yield`)) %>%
  dplyr::ungroup() %>%
  tidyr::nest(
    `tenor` = `tenor`,
    `yield` = `yield`,
    .by = c(`shortname`, `date`))
## Warning: There were 3 warnings in `dplyr::mutate()`.
## The first warning was:
## ℹ In argument: `tenor = case_when(...)`.
## Caused by warning:
## ! NAs introduced by coercion
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 2 remaining warnings.
# Plot the 5 Year Yield
plot_5YrYield <- YieldCurves %>%
  tidyr::unnest(cols = everything()) %>%
  dplyr::filter(`tenor` == 5) %>%
  ggplot() +
  aes(x = date, y = yield) +
  geom_line(colour = "#112446") +
  labs(
    x = "Date",
    y = "5 Year Swap Yield",
    title = "5 Year Swap Yields for Analysis"
  ) +
  theme_minimal() +
  facet_wrap(vars(shortname), scales = "free_y")

plot_5YrYield

Calculating Strategy Returns

The stategy is to go long the equivalent of $10mm USD in a foreign 5 Year bond every week. To do so, we use $2mm USD in capital directly invested in the foreign bond, and another $8mm USD equivalent that is borrowed in GBP at the 1 month OIS rate + 50bps. If the 5Yr British rate is not 100ps lower than the foreign lending rate, we do not make the trade, since we are assuming FX risk and need to be compensated for such. To calculate the return for the strategy, the foreign spot curve is converted to the zro coupon curve, which is then used to calculate the bond price. The change in bond price is then compounded by the change in the USD to lending rate and multiplied by 5, to get the return on capital from the investment in the foreign bond. We then subtract the interest payments made in GBP, adjusted by the change in the USD to GBP, and multiply that by 4 since we are borrowing 4 times the amount of capital. As noted above, the change in yields for some of the currencies in 2022 where quite drastic, and with leverage, caused the return on capital to drop below 0. In those cases, the return is limited to -100%, indicating that the entirety of the capital has been wiped out. The next week, we assume the capital is replenished to $2mm USD. Returns are calculated on a daily basis, with trades occurring on Wednesdays. The investment in each currency is considered its own strategy return.

# Arab Rep Egypt - EGP
EgyptData <- 
  dplyr::full_join(FXRates_USD, FXRates_GBP, by = "date") %>%
  dplyr::select(`date`, `USDGBP`, `USDEGP`) %>%
  dplyr::full_join(
    dplyr:::filter(YieldCurves, `shortname` == "Arab Rep Egypt"),
    by = "date") %>%
  dplyr::full_join(OIS_UK, by = "date") %>%
  dplyr::arrange(`date`) %>%
  dplyr::rename(
    `strat2fundFX` = `USDGBP`,
    `strat2lendFX` = `USDEGP`,
    `borrowrate` = `UK_OIS_1M`,
    `borrow5Y` = `UK_OIS_5Y`,
    `lendtenors` = `tenor`,
    `lendspotcurve` = `yield`) %>%
  tidyr::fill(borrowrate, .direction = "down") %>%
  tidyr::fill(borrow5Y, .direction = "down")

dailyReturnsEgypt <- .get_daily_returns(EgyptData)

# Hungary - HUF
HungaryData <- 
  dplyr::full_join(FXRates_USD, FXRates_GBP, by = "date") %>%
  dplyr::select(`date`, `USDGBP`, `USDHUF`) %>%
  dplyr::full_join(
    dplyr:::filter(YieldCurves, `shortname` == "Hungary"),
    by = "date") %>%
  dplyr::full_join(OIS_UK, by = "date") %>%
  dplyr::arrange(`date`) %>%
  dplyr::rename(
    `strat2fundFX` = `USDGBP`,
    `strat2lendFX` = `USDHUF`,
    `borrowrate` = `UK_OIS_1M`,
    `borrow5Y` = `UK_OIS_5Y`,
    `lendtenors` = `tenor`,
    `lendspotcurve` = `yield`) %>%
  tidyr::fill(borrowrate, .direction = "down") %>%
  tidyr::fill(borrow5Y, .direction = "down")

dailyReturnsHungary <- .get_daily_returns(HungaryData)

# Rep Costa Rica - CRC
CostaRicaData <- 
  dplyr::full_join(FXRates_USD, FXRates_GBP, by = "date") %>%
  dplyr::select(`date`, `USDGBP`, `USDCRC`) %>%
  dplyr::full_join(
    dplyr:::filter(YieldCurves, `shortname` == "Rep Costa Rica"),
    by = "date") %>%
  dplyr::full_join(OIS_UK, by = "date") %>%
  dplyr::arrange(`date`) %>%
  dplyr::rename(
    `strat2fundFX` = `USDGBP`,
    `strat2lendFX` = `USDCRC`,
    `borrowrate` = `UK_OIS_1M`,
    `borrow5Y` = `UK_OIS_5Y`,
    `lendtenors` = `tenor`,
    `lendspotcurve` = `yield`) %>%
  tidyr::fill(borrowrate, .direction = "down") %>%
  tidyr::fill(borrow5Y, .direction = "down")

dailyReturnsCostaRica <- .get_daily_returns(CostaRicaData)

# Romania - RON
RomaniaData <- 
  dplyr::full_join(FXRates_USD, FXRates_GBP, by = "date") %>%
  dplyr::select(`date`, `USDGBP`, `USDRON`) %>%
  dplyr::full_join(
    dplyr:::filter(YieldCurves, `shortname` == "Romania"),
    by = "date") %>%
  dplyr::full_join(OIS_UK, by = "date") %>%
  dplyr::arrange(`date`) %>%
  dplyr::rename(
    `strat2fundFX` = `USDGBP`,
    `strat2lendFX` = `USDRON`,
    `borrowrate` = `UK_OIS_1M`,
    `borrow5Y` = `UK_OIS_5Y`,
    `lendtenors` = `tenor`,
    `lendspotcurve` = `yield`) %>%
  tidyr::fill(borrowrate, .direction = "down") %>%
  tidyr::fill(borrow5Y, .direction = "down")

dailyReturnsRomania <- .get_daily_returns(RomaniaData)

# Combine Daily Returns
dailyReturns <-
  bind_rows(
    "Arab Rep Egypt" = dailyReturnsEgypt,
    "Hungary" = dailyReturnsHungary,
    "Rep Costa Rica" = dailyReturnsCostaRica,
    "Romania" = dailyReturnsRomania,
    .id = "shortname")

Analysis

The plot below shows the histogram for each carry strategy. The histograms show the typical return distribution for a carry trade with negative skew, and high excess kurtosis. The facets in each plot have independent x and y scales, but it is obvious that the Egyptian carry trade had very large losses in some weeks. In fact, in some weeks the total losses on capital exceeded 100%, but my backtest capped each week at -100%.

weeklyReturns <-
  dailyReturns %>%
  dplyr::group_by(`shortname`) %>%
  dplyr::mutate(
    `tradedate` = dplyr::lag(`date`, 1, default = min(`date`)),
    `weekday` = weekdays(`tradedate`),
    `rebal` = ifelse(`weekday` == "Wednesday", 1, 0),
    `trade` = cumsum(`rebal`)) %>%
  dplyr::ungroup() %>%
  dplyr::summarise(
    `date` = max(`date`),
    `carry_return` = prod(1+ `carry_return`) - 1,
    .by = c(`shortname`, `trade`)) %>%
  dplyr::group_by(`shortname`) %>%
  dplyr::slice(-1)

plot_histogram_weeklyReturns <-
  weeklyReturns %>%
  ggplot() +
  aes(x = carry_return) +
  geom_histogram(bins = 20L, fill = "#112446") +
  labs(
    x = "Weekly Strategy Return",
    y = "Number of Bin Observations",
    title = "Histogram of Weekly Carry Returns",
    subtitle = "Faceted by Lending FX & Rate"
  ) +
  theme_minimal() +
  facet_wrap(vars(shortname), scales = "free")


plot_histogram_weeklyReturns

The metrics below show a variety of return profiles for the carry trade strategies. The Egyptian carry trade had an average negative return, dispite having the highest weekly hit rate. This is due to the negative skew and very high excess kurtosis, indicating very large left tail events. The Hungarian and Costa Rican carry trades performed the best, with high positive annualized excess returns, but with high volatility as well. The Costa Rican carry trade had the best performance, and a Sharpe Ratio of 0.6. Furthermore, its Sortino Ratio is close to 1. The Costa Rican carry trade however has a much higher excess kurtosis than the Hungarian. The Romanian carry trade had a positive average annualized return, but had a low Sharpe Ratio of 0.2, and positive skew, unlike the other carry trade strategies. For the most part though, the return metrics show the typical summary for a carry trade: negative skew, high hit rates, and large excess kurtosis.

weeklyReturns %>%
  group_by(`shortname`) %>%
  summarise(
    `n` = n(),
    `mean` = mean(`carry_return`) * 52,
    `vol` = sd(`carry_return`) * sqrt(52),
    `dvol` = sd(ifelse(`carry_return` <0, `carry_return`, 0)) * sqrt(52),
    `skew` = Skew(`carry_return`),
    `kurt` = Kurt(`carry_return`),
    `hr` = sum(ifelse(`carry_return` > 0, 1, 0)) / n()) %>%
  mutate(
    `Number of Weekly Returns` = formatC(`n`),
    `Annualized Average Return` = paste0(formatC(`mean` * 100, digits = 3),"%"),
    `Annualized Return Std Dev` = paste0(formatC(`vol` * 100, digits =3),"%"),
    `Sharpe Ratio` = formatC(`mean` / `vol`, digits = 2),
    `Sortino Ratio` = formatC(`mean` /`dvol`, digits = 2),
    `Skewness` = formatC(`skew`, digits = 3),
    `Excess Kurtosis` = formatC(`kurt`, digits = 3),
    `Weekly Hit Rate` = paste0(formatC(`hr` * 100, digits = 3), "%"),
    .keep = "unused") %>%
  pivot_longer(
    cols = c(everything(), - `shortname`),
    names_to = "metric",
    values_to = "value") %>%
  pivot_wider(
    names_from = `shortname`,
    values_from = `value`)
## # A tibble: 8 × 5
##   metric                    `Arab Rep Egypt` Hungary `Rep Costa Rica` Romania
##   <chr>                     <chr>            <chr>   <chr>            <chr>  
## 1 Number of Weekly Returns  "734"            630     734              734    
## 2 Annualized Average Return "-9.87%"         26.2%   34.5%            12.9%  
## 3 Annualized Return Std Dev "98.1%"          72.5%   57.2%            64.3%  
## 4 Sharpe Ratio              "-0.1"           0.36    0.6              0.2    
## 5 Sortino Ratio             "-0.13"          0.59    0.96             0.34   
## 6 Skewness                  "-1.68"          -0.168  -0.601           0.0783 
## 7 Excess Kurtosis           "  16"           2.46    12.1             1.76   
## 8 Weekly Hit Rate           "57.9%"          52.9%   54.4%            51.4%

The correlation plot below shows that the Romanian and Hungarian carry trades have the highest correlation to the market excess return. The strategies are slightly negative to most other factor returns, with the exception of the Costa Rican carry trade, which has very low correlations to all. All carry trades are also negatively correlated to the VIX. The high correlation to the market return and negative correlation to the VIX is typical for a carry trade strategy, since they “carry risk” and therefore should perform better when the market is rewarding risk (equities going up) and fear is low (VIX is low).

monthlyReturns <-
  dailyReturns %>%
  dplyr::mutate(
    `year` = year(`date`),
    `month` = month(`date`)) %>%
  dplyr::summarise(
    `date` = max(`date`),
    `carry_return` = prod(1+ `carry_return`) - 1,
    .by = c(`shortname`, `year`, `month`)) %>%
  dplyr::select(-c(`year`, `month`)) %>%
  dplyr::mutate(`date` = lubridate::ceiling_date(`date`, unit = "month")-1)

monthlyVIX <- 
  VIX %>%
  dplyr::mutate(
    `year` = year(`date`),
    `month` = month(`date`)) %>%
  dplyr::group_by(`year`, `month`) %>%
  dplyr::mutate(`last_date` = max(`date`)) %>%
  dplyr::ungroup() %>%
  dplyr::filter(`date` == `last_date`) %>%
  dplyr::mutate(`date` = lubridate::ceiling_date(`date`, unit = "month")-1) %>%
  dplyr::select(`date`, `VIX`)
    
  

monthlyReturns_wide <-
  monthlyReturns %>%
  pivot_wider(values_from = `carry_return`, names_from = `shortname`)

.pivotcorr <- function(data){
  data %>%
    cor(use="pairwise.complete.obs") %>%
    as.data.frame() %>%
    tibble::rownames_to_column("x") %>%
    tidyr::pivot_longer(cols = c(everything(), -`x`), names_to = "y", values_to = "correlation")}

StratCorr <- 
  dplyr::left_join(monthlyReturns_wide, FF6EM, by = "date") %>%
  dplyr::left_join(`monthlyVIX`, by = "date") %>%
  dplyr::select(-`date`) %>%
  tidyr::nest(
    `Arab Rep Egypt` = c(`Arab Rep Egypt`, `mkt_rf`, `smb`, `hml`,`rmw`,`cma`,`rf`,`wml`, `VIX`),
    `Hungary` = c(`Hungary`, `mkt_rf`, `smb`, `hml`,`rmw`,`cma`,`rf`,`wml`, `VIX`),
    `Rep Costa Rica` = c(`Rep Costa Rica`, `mkt_rf`, `smb`, `hml`,`rmw`,`cma`,`rf`,`wml`, `VIX`),
    `Romania` = c(`Romania`, `mkt_rf`, `smb`, `hml`,`rmw`,`cma`,`rf`,`wml`, `VIX`)) %>%
  dplyr::mutate(
    `Arab Rep Egypt` = purrr::map(`Arab Rep Egypt`, .pivotcorr),
    `Hungary` =  purrr::map(`Hungary`, .pivotcorr),
    `Rep Costa Rica` =  purrr::map(`Rep Costa Rica`, .pivotcorr),
    `Romania` = purrr::map(`Romania`, .pivotcorr))

plot_StratCorr <-
  dplyr::bind_rows(
    `Arab Rep Egypt` = StratCorr$`Arab Rep Egypt`[[1]],
    `Hungary` = StratCorr$Hungary[[1]],
    `Rep Costa Rica`= StratCorr$`Rep Costa Rica`[[1]],
    `Romania` = StratCorr$`Romania`[[1]],
    .id = "Strategy") %>%
  dplyr::filter(`x` %in% analysis_fx) %>%
  dplyr::filter(!(`y` %in% analysis_fx)) %>%
  ggplot() +
  aes(x = y, y = x, fill = correlation) +
  geom_tile() +
  scale_fill_gradient2(low = "blue", mid = "white", high ="orange", midpoint =0)+
  labs(
    y = "Strategy Lending FX",
    x = "Fama French Factors & VIX",
    title = "Correlation of Strategy Monthly Returns to 
Fama French EM 5 Factor and Momentum Returns and VIX",
    fill = "Correlation"
  ) + 
  theme_minimal()
  
plot_StratCorr

The chart below shows the rolling 52 week (1 Year). 104 week (2 Year) and 260 week (5 Year) beta of the carry trades to SPY. The Hungarian and Romanian carry strategies had very high beta to the market at the beginning, but drifted lower into 2018, before rising again. The Costa Rican carry strategy retained a low beta to SPY over the entire time horizon.

# Calculate Weekly SPY returns on same rebalance day of Wednesday
weeklySPYReturns <-
  SPY %>%
  dplyr::mutate(`weekday` = weekdays(`date`)) %>%
  dplyr::filter(`weekday` == "Wednesday") %>%
  dplyr::mutate(`SPY_return` = `SPY` / lag(`SPY`, 1) -1) %>%
  dplyr::select(`date`, `SPY_return`)

# helper function to get beta
.calcbeta <- function(x,y,n){
  
  nans <- rep(NA, (n-1))
  betas <- NULL
  
  for(i in n:length(x)){
    
    subx <- x[(i-n+1):i]
    suby <- y[(i-n+1):i]
    ols <- lm(suby ~ subx)
    beta <- as.numeric(ols$coefficients[2])
    betas <- append(betas, beta)
  }
  
  return(c(nans, betas))}
  
betaSPY <-
  dplyr::left_join(weeklyReturns, weeklySPYReturns, by = "date") %>%
  dplyr::group_by(`shortname`) %>%
  dplyr::mutate(
    `52W` = .calcbeta(`SPY_return`, `carry_return`, 52),
    `104W` = .calcbeta(`SPY_return`, `carry_return`, 104),
    `260W` = .calcbeta(`SPY_return`, `carry_return`, 260)) %>%
  dplyr::select(`shortname`, `date`, `52W`, `104W`, `260W`) %>%
  tidyr::pivot_longer(
    cols = c(`52W`, `104W`, `260W`),
    names_to = "Beta Horizon",
    values_to = "Beta")



ggplot(betaSPY) +
  aes(x = date, y = Beta, colour = `Beta Horizon`) +
  geom_line() +
  scale_color_hue(direction = 1) +
  labs(
    x = "Date",
    y = "Beta",
    title = "Rolling Beta of Carry Trades to SPY",
    subtitle = "Beta of Weekly Returns",
    color = "Rolling Period"
  ) +
  theme_minimal() +
  facet_wrap(vars(shortname))
## Warning: Removed 413 rows containing missing values (`geom_line()`).

Comparing the 104 week (2 year) beta and downside beta of the carry trade strategies in the plot below, we can see some interesting results. The Egyptian carry strategy had a much higher downside beta in the 2 years following the start of the pandemic, but since 2022 has been falling, while beta has been rising. For Hungary and Romania, the rolling downside beta was lowe than beta until 2020. And for Costa Rica the downside beta nd beta are close to each other.

# helper function to get beta
.calcdownbeta <- function(x,y,n){
  
  nans <- rep(NA, (n-1))
  betas <- NULL
  
  for(i in n:length(x)){
    
    subx <- x[(i-n+1):i]
    suby <- y[(i-n+1):i]
    
    downx <- subx[which(subx<0)]
    downy <- suby[which(subx<0)]
    
    ols <- lm(downy ~ downx)
    beta <- as.numeric(ols$coefficients[2])
    betas <- append(betas, beta)
  }
  
  return(c(nans, betas))}

downsidebetaSPY <-
  dplyr::left_join(weeklyReturns, weeklySPYReturns, by = "date") %>%
  dplyr::group_by(`shortname`) %>%
  dplyr::mutate(
    `beta` = .calcbeta(`SPY_return`, `carry_return`, 104),
    `downside beta` = .calcdownbeta(`SPY_return`, `carry_return`, 104)) %>%
  dplyr::select(`shortname`, `date`, `beta`, `downside beta`) %>%
  tidyr::pivot_longer(
    cols = c(`beta`, `downside beta`),
    names_to = "Beta Metric",
    values_to = "Beta")

ggplot(downsidebetaSPY) +
  aes(x = date, y = Beta, colour = `Beta Metric`) +
  geom_line() +
  scale_color_hue(direction = 1) +
  labs(
    x = "Date",
    y = "Beta",
    title = "Rolling 104 Week Beta and Downside Beta to SPU",
    subtitle = "Beta of Weekly Returns",
    color = "Metric"
  ) +
  theme_minimal() +
  facet_wrap(vars(shortname))
## Warning: Removed 206 rows containing missing values (`geom_line()`).