1.1 Load Portfolio Data

We load a first example of our portfolio, containing the basic information we need to properly account for cashflows.

portfolio_cols <- cols(
  issuer        = col_character(),
  currency      = col_character(),
  coupon        = col_number(),
  issued_date   = col_date(format = "%Y-%m-%d"),
  maturity_date = col_date(format = "%Y-%m-%d"),
  price         = col_number(),
  position      = col_integer()
  )

bond_portfolio_tbl <- read_csv(
    file      = "data/sample_bond_portfolio.csv",
    na        = c("N/A"),
    col_types = portfolio_cols
    ) %>%
  mutate(
    ticker_symbol = str_replace(issuer, "^(\\S+) .*", "\\1"),
    mkt_value     = position * price * 0.01 * 1000
    )

bond_portfolio_tbl %>% glimpse()

## Rows: 250
## Columns: 9
## $ issuer        <chr> "ECOM 5.875 10/14/2022", "PSBQ 6.5 06/25/2020", "ALYA 9.…
## $ currency      <chr> "USD", "USD", "CAD", "USD", "USD", "USD", "USD", "USD", …
## $ position      <int> 172, 234, 164, 207, 308, 201, 138, 215, 236, 155, 223, 1…
## $ price         <dbl> 91.73, 96.57, 97.75, 106.31, 104.39, 99.59, 93.93, 101.2…
## $ coupon        <dbl> 5.875, 6.500, 9.625, 7.000, 9.125, 9.000, 5.625, 5.125, …
## $ issued_date   <date> 2017-10-13, 2016-06-24, 2017-12-27, 2017-05-17, 2015-04…
## $ maturity_date <date> 2022-10-14, 2020-06-25, 2021-12-28, 2023-05-18, 2023-04…
## $ ticker_symbol <chr> "ECOM", "PSBQ", "ALYA", "BSRSF", "MTX", "LOGM", "DLR", "…
## $ mkt_value     <dbl> 157775.6, 225973.8, 160310.0, 220061.7, 321521.2, 200175…

1.2 Load Market Capitalisation Data

We will want to segment our bond portfolio by market capitalisation and so we load up the market cap data. It is provided by SEC CIK number, so we will need to link by this.

mktcap_cols <- cols(
  cik_number = col_character(),
  year       = col_number(),
  mktcap     = col_double()
  )

mktcap_tbl <- read_csv(
  file = "data/company_mktcap.csv",
  col_types = mktcap_cols
  )

mktcap_tbl %>% glimpse()

## Rows: 5,802
## Columns: 3
## $ year       <dbl> 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018, 2018,…
## $ cik_number <chr> "0000878334", "0001081862", "0000868822", "0000749098", "00…
## $ mktcap     <dbl> 3162687931, 16810662751, 8001655, 15196648088, 35505321530,…

1.3 Load Company Information

We now load the various data we have on each individual company to help with the analysis of the portfolio.

company_cols <- cols(
  cik_number    = col_character(),
  company_name  = col_character(),
  main_exchange = col_character(),
  country_code  = col_character(),
  ticker_symbol = col_character(),
  gics_code     = col_character()
  )

company_info_tbl <- read_csv(
  file      = "data/company_information.csv",
  na        = c("N/A"),
  col_types = company_cols
  )

company_info_tbl %>% glimpse()

## Rows: 262
## Columns: 6
## $ cik_number    <chr> "0001018724", "0000732712", "0000051143", "0000858877", …
## $ company_name  <chr> "AMAZON.COM, INC.", "VERIZON COMMUNICATIONS INC", "INTER…
## $ main_exchange <chr> "NASDAQ National Market", "New York Stock Exchange (NYSE…
## $ country_code  <chr> "US", "US", "US", "US", "US", "US", "US", "US", "US", "U…
## $ ticker_symbol <chr> "AMZN", "VZ", "IBM", "CSCO", "QCOM", "TJX", "PM", "HPE",…
## $ gics_code     <chr> "25502020", "50101020", "45102010", "45201020", "4530102…

The sector information is provided in this data via the GICS code, so we need to load the GICS information which is availabe via the GICS package.

data(standards)

gics_tbl <- standards %>%
  as_tibble() %>%
  transmute(
    gics_code                  = `subindustry id`,
    gics_sector_code           = `sector id`,
    gics_sector_name           = `sector name`,
    gics_industrygroup_code    = `industry group id`,
    gics_industrygroup_name    = `industry group name`,
    gics_industry_code         = `industry id`,
    gics_industry_name         = `industry name`,
    gics_subindustrygroup_code = `subindustry id`,
    gics_subindustrygroup_name = `subindustry name`
    ) %>%
  mutate(
    across(everything(), as.character)
    )

gics_tbl %>% glimpse()

## Rows: 157
## Columns: 9
## $ gics_code                  <chr> "10101010", "10101020", "10102010", "101020…
## $ gics_sector_code           <chr> "10", "10", "10", "10", "10", "10", "10", "…
## $ gics_sector_name           <chr> "Energy", "Energy", "Energy", "Energy", "En…
## $ gics_industrygroup_code    <chr> "1010", "1010", "1010", "1010", "1010", "10…
## $ gics_industrygroup_name    <chr> "Energy", "Energy", "Energy", "Energy", "En…
## $ gics_industry_code         <chr> "101010", "101010", "101020", "101020", "10…
## $ gics_industry_name         <chr> "Energy Equipment & Services", "Energy Equi…
## $ gics_subindustrygroup_code <chr> "10101010", "10101020", "10102010", "101020…
## $ gics_subindustrygroup_name <chr> "Oil & Gas Drilling", "Oil & Gas Equipment …

1.4 Retrieve Frech-Fama Breakpoints

if(file_exists("data/ME_Breakpoints_CSV.zip")) {
  me_breakpoint_url <- "http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/ME_Breakpoints_CSV.zip"
  
  curl_download(me_breakpoint_url, destfile = "data/ME_Breakpoints_CSV.zip")
}

We now need to process this breakpoint data.

read_lines("data/ME_Breakpoints_CSV.zip") %>%
  enframe(name = "id", value = "line_str") %>%
  mutate(char_count = map_int(line_str, nchar), .after = id) %>%
  filter(char_count == 232) %>%
  pull(line_str) %>%
  write_lines("data/breakpoints_parsed.csv")

csv_colnames <- c(
  "datestr", "data_count",
  "ME00", "ME05", "ME10", "ME15", "ME20",
  "ME25", "ME30", "ME35", "ME40", "ME45",
  "ME50", "ME55", "ME60", "ME65", "ME70",
  "ME75", "ME80", "ME85", "ME90", "ME95"
  )

csv_cols <- cols(
  datestr    = col_character(),
  data_count = col_integer()
  )


me_breakpoint_tbl <- read_csv(
  file      = "data/breakpoints_parsed.csv",
  col_names = csv_colnames,
  col_types = csv_cols
  )

me_breakpoint_tbl %>% glimpse()

## Rows: 1,153
## Columns: 22
## $ datestr    <chr> "192512", "192601", "192602", "192603", "192604", "192605",…
## $ data_count <int> 487, 491, 499, 503, 505, 509, 510, 506, 517, 514, 521, 520,…
## $ ME00       <dbl> 1.40, 1.38, 1.29, 1.12, 1.31, 1.14, 1.08, 1.08, 1.07, 1.06,…
## $ ME05       <dbl> 2.38, 2.54, 2.34, 2.05, 2.35, 2.25, 2.20, 2.04, 2.35, 2.29,…
## $ ME10       <dbl> 3.37, 3.76, 3.57, 3.08, 3.32, 3.15, 3.44, 3.15, 3.34, 3.12,…
## $ ME15       <dbl> 4.95, 4.84, 4.69, 4.15, 4.37, 4.20, 4.33, 4.25, 4.27, 4.23,…
## $ ME20       <dbl> 5.95, 5.94, 5.61, 5.01, 5.03, 5.10, 5.20, 5.28, 5.38, 5.18,…
## $ ME25       <dbl> 7.40, 7.47, 7.15, 6.01, 6.63, 6.56, 6.87, 6.90, 6.81, 6.64,…
## $ ME30       <dbl> 8.89, 9.28, 8.45, 7.39, 8.13, 7.96, 8.25, 8.52, 8.78, 8.75,…
## $ ME35       <dbl> 10.81, 10.94, 10.53, 9.00, 9.60, 9.68, 9.79, 10.07, 10.31, …
## $ ME40       <dbl> 13.01, 12.71, 12.15, 10.68, 11.66, 11.55, 12.00, 12.04, 12.…
## $ ME45       <dbl> 15.61, 15.90, 14.62, 13.20, 13.75, 13.27, 13.60, 13.80, 14.…
## $ ME50       <dbl> 18.55, 17.75, 17.03, 15.65, 15.81, 15.62, 15.50, 16.12, 16.…
## $ ME55       <dbl> 22.88, 23.45, 21.18, 19.04, 19.17, 18.87, 19.50, 19.67, 20.…
## $ ME60       <dbl> 29.92, 30.40, 27.62, 24.80, 25.60, 25.65, 26.52, 27.10, 26.…
## $ ME65       <dbl> 38.41, 39.00, 36.55, 31.90, 33.10, 33.77, 34.67, 34.88, 34.…
## $ ME70       <dbl> 49.93, 50.85, 46.49, 44.40, 45.00, 45.60, 47.32, 49.09, 47.…
## $ ME75       <dbl> 65.75, 66.82, 61.43, 58.24, 57.73, 57.81, 59.40, 65.49, 60.…
## $ ME80       <dbl> 92.72, 94.69, 87.51, 81.92, 83.63, 85.27, 84.30, 88.43, 87.…
## $ ME85       <dbl> 142.48, 139.18, 138.04, 130.12, 133.50, 125.90, 135.34, 136…
## $ ME90       <dbl> 238.78, 235.20, 223.02, 205.20, 211.20, 209.25, 219.45, 225…
## $ ME95       <dbl> 1319.00, 1331.71, 1366.39, 1322.46, 1350.21, 1382.58, 1510.…

1.5 Futures Expiration Dates

We also want to load the expiration dates for futures to assist the hedging of currency risks.

expiration_date_tbl <- read_csv(
  file      = "data/expiration_date.csv",
  col_types = cols(expiration_date = col_date())
  )

expiration_date_tbl %>% glimpse()

## Rows: 23
## Columns: 1
## $ expiration_date <date> 2019-01-18, 2019-02-15, 2019-03-15, 2019-04-19, 2019-…

1.6 Process Bond and Company Data

We start by using the French and Fama breakpoints to categorise the size of the companies we have data for into distinct groupings.

mktcap_breaks_tbl <- me_breakpoint_tbl %>%
  filter(datestr == "201812") %>%
  select(datestr, ME20, ME40, ME60, ME80) %>%
  pivot_longer(
    !datestr,
    names_to  = "label",
    values_to = "breakpoint"
    )

mktcap_lookup_tbl <- mktcap_tbl %>%
  transmute(
    cik_number, mktcap,
    mktcap_qn = cut(
      mktcap,
      breaks = c(0, mktcap_breaks_tbl$breakpoint * 1e6, Inf),
      labels = c("QN1", "QN2", "QN3", "QN4", "QN5")
      )
    )

mktcap_lookup_tbl %>% glimpse()

## Rows: 5,802
## Columns: 3
## $ cik_number <chr> "0000878334", "0001081862", "0000868822", "0000749098", "00…
## $ mktcap     <dbl> 3162687931, 16810662751, 8001655, 15196648088, 35505321530,…
## $ mktcap_qn  <fct> QN3, QN5, QN1, QN4, QN5, QN4, QN5, QN4, QN2, QN3, QN1, QN4,…

We then construct a lookup table with all the company information we need to segment our bond portfolio. The data comes in a number of pieces and we join the data together by whatever common keys we have.

company_lookup_tbl <- company_info_tbl %>%
  left_join(gics_tbl, by = "gics_code") %>%
  left_join(mktcap_lookup_tbl, by = "cik_number") %>%
  transmute(
    ticker_symbol, company_name, main_exchange, country_code,
    currency = str_c(country_code, "D"),
    cik_number, gics_sector_name, gics_industrygroup_name, mktcap, mktcap_qn
    )

company_lookup_tbl %>% glimpse()

## Rows: 262
## Columns: 10
## $ ticker_symbol           <chr> "AMZN", "VZ", "IBM", "CSCO", "QCOM", "TJX", "P…
## $ company_name            <chr> "AMAZON.COM, INC.", "VERIZON COMMUNICATIONS IN…
## $ main_exchange           <chr> "NASDAQ National Market", "New York Stock Exch…
## $ country_code            <chr> "US", "US", "US", "US", "US", "US", "US", "US"…
## $ currency                <chr> "USD", "USD", "USD", "USD", "USD", "USD", "USD…
## $ cik_number              <chr> "0001018724", "0000732712", "0000051143", "000…
## $ gics_sector_name        <chr> "Consumer Discretionary", "Telecommunication S…
## $ gics_industrygroup_name <chr> "Retailing", "Telecommunication Services", "So…
## $ mktcap                  <dbl> 734416195872, 232301894022, 103302587000, 1988…
## $ mktcap_qn               <fct> QN5, QN5, QN5, QN5, QN5, QN5, QN5, QN5, QN5, Q…

3.1 Create Helper Functions

To start, we need a function that determines each of the coupon dates for a bond - which is just a sequence of dates six months apart from the date of issue of a bond till the bond matures and pas back the par value of the bond.

create_coupon_payment_dates <- function(init_date, final_date) {
  max_year <- difftime(final_date, init_date, units = "days") %>%
    as.numeric() %>%
    divide_by(183) %>%
    ceiling()

  coupon_date_tbl <- (init_date %m+% months(6 * 1:max_year)) %>%
    enframe(name = NULL, value = "cashflow_date") %>%
    filter(cashflow_date <= final_date)
  
  return(coupon_date_tbl)
}

We also need a function that uses the above function to create the coupon dates for the bond and then calculates the coupon payment based on the number of owned bonds, the coupon rate and the contract size (typically $1,000 of the currency).

calculate_cashflow_data <- function(init_date, final_date, position, coupon,
                                    contract_size = 1000) {
  
  par_value      <- position  * contract_size
  coupon_payment <- par_value * coupon * 0.01 * 0.5
  
  coupon_data_tbl <- create_coupon_payment_dates(init_date, final_date) %>%
    mutate(
      cashflow_amt = coupon_payment
      )
  
  final_tbl <- tibble(
    cashflow_date = final_date,
    cashflow_amt  = par_value
    )
  
  cashflow_tbl <- list(coupon_data_tbl, final_tbl) %>%
    bind_rows()
  
  return(cashflow_tbl)
}

We now combine all the above functions that we can use along with a table of the bond positions that comprise the portfolio and produce cashflows.

We then rearrange the cashflows by date and we now have a function that takes a portfolio table as an input, along with a ‘start date’, and it produces a sequence of cashflows from that portfolio.

calculate_portfolio_cashflow_data <- function(portfolio_tbl, current_date,
                                              id_cols = c("issuer")) {
  cashflow_tbl <- portfolio_tbl %>%
    mutate(
      cash_data = pmap(
        list(
          init_date  = issued_date,
          final_date = maturity_date,
          position   = position,
          coupon     = coupon
          ),
        calculate_cashflow_data,
        contract_size = 1000
        )
      ) %>%
    select(any_of(id_cols), cash_data) %>%
    unnest(cash_data) %>%
    filter(cashflow_date >= current_date) %>%
    arrange(cashflow_date)
  
  return(cashflow_tbl)
}

3.2 Calculate and Aggregate Cashflows

We now use this function to produce the cashflows based on our portfolio.

bond_cashflow_tbl <- bond_portfolio_tbl %>%
  calculate_portfolio_cashflow_data(
    current_date = as.Date("2019-01-01"),
    id_cols = c("issuer", "ticker_symbol", "currency", "mkt_value")
    )

bond_cashflow_tbl %>% glimpse()

## Rows: 1,848
## Columns: 6
## $ issuer        <chr> "GIL 7 01/02/2023", "SMD 9.375 07/04/2020", "PCM 6.125 0…
## $ ticker_symbol <chr> "GIL", "SMD", "PCM", "PM", "GENC", "HYSR", "SLGD", "TRKK…
## $ currency      <chr> "CAD", "CAD", "USD", "USD", "USD", "USD", "USD", "USD", …
## $ mkt_value     <dbl> 241566.3, 185307.5, 217705.8, 165780.0, 248928.9, 207359…
## $ cashflow_date <date> 2019-01-01, 2019-01-03, 2019-01-04, 2019-01-09, 2019-01…
## $ cashflow_amt  <dbl> 8505.000, 8203.125, 6921.250, 9000.000, 8133.750, 8883.7…

As before, we append this portfolio data to the cashflow data.

cashflow_full_tbl <- bond_cashflow_tbl %>%
  left_join(company_lookup_tbl, by = c("ticker_symbol", "currency"))

cashflow_full_tbl %>% filter(are_na(gics_sector_name))

## # A tibble: 0 × 14
## # … with 14 variables: issuer <chr>, ticker_symbol <chr>, currency <chr>,
## #   mkt_value <dbl>, cashflow_date <date>, cashflow_amt <dbl>,
## #   company_name <chr>, main_exchange <chr>, country_code <chr>,
## #   cik_number <chr>, gics_sector_name <chr>, gics_industrygroup_name <chr>,
## #   mktcap <dbl>, mktcap_qn <fct>

cashflow_full_tbl %>% glimpse()

## Rows: 1,848
## Columns: 14
## $ issuer                  <chr> "GIL 7 01/02/2023", "SMD 9.375 07/04/2020", "P…
## $ ticker_symbol           <chr> "GIL", "SMD", "PCM", "PM", "GENC", "HYSR", "SL…
## $ currency                <chr> "CAD", "CAD", "USD", "USD", "USD", "USD", "USD…
## $ mkt_value               <dbl> 241566.3, 185307.5, 217705.8, 165780.0, 248928…
## $ cashflow_date           <date> 2019-01-01, 2019-01-03, 2019-01-04, 2019-01-0…
## $ cashflow_amt            <dbl> 8505.000, 8203.125, 6921.250, 9000.000, 8133.7…
## $ company_name            <chr> "GILDAN ACTIVEWEAR INC", "STRATEGIC METALS LTD…
## $ main_exchange           <chr> "Toronto Stock Exchange", "TSX Venture Exchang…
## $ country_code            <chr> "CA", "CA", "US", "US", "US", "US", "US", "US"…
## $ cik_number              <chr> "0001061894", "0001267561", "0000908187", "000…
## $ gics_sector_name        <chr> "Consumer Discretionary", "Materials", "Financ…
## $ gics_industrygroup_name <chr> "Consumer Durables & Apparel", "Materials", "D…
## $ mktcap                  <dbl> 6280267712, 21305750, 132524794, 103780019000,…
## $ mktcap_qn               <fct> QN4, QN1, QN1, QN5, QN1, QN1, QN1, QN1, QN1, Q…

We can now use this data to calculate cashflow-based measures.

We now want to aggregate all these cashflows on a weekly basis to help assess the FX risk due to holding bonds in both currencies.

friday_dates <- seq(as.Date("2019-01-01"), as.Date("2022-01-01"), by = "day") %>%
  enframe(name = NULL, value = "date") %>%
  mutate(
    day_of_week = format(date, "%a")
    ) %>%
  filter(day_of_week == "Fri") %>%
  pull(date)


aggregate_cashflows_tbl <- bond_cashflow_tbl %>%
  mutate(
    agg_date = map(cashflow_date, ~ friday_dates[friday_dates >= .x][1]) %>% reduce(c)) %>%
  group_by(currency, agg_date) %>%
  summarise(
    .groups = "drop",
    
    agg_cashflow = sum(cashflow_amt)
    ) %>%
  arrange(agg_date, currency)

aggregate_cashflows_tbl %>% glimpse()

## Rows: 256
## Columns: 3
## $ currency     <chr> "CAD", "USD", "USD", "CAD", "USD", "CAD", "USD", "CAD", "…
## $ agg_date     <date> 2019-01-04, 2019-01-04, 2019-01-11, 2019-01-18, 2019-01-…
## $ agg_cashflow <dbl> 16708.125, 6921.250, 43522.500, 9628.125, 47450.625, 1496…

3.3 Visualise Monthly Cashflow Data

An important part of this work is to construct helpful visualisations of the data to help check for mistakes.

We aggregate our data by currency and month and then plot them.

plot_tbl <- bond_cashflow_tbl %>%
  mutate(
    cashflow_month = zoo::as.yearmon(cashflow_date)
    ) %>%
  count(currency, cashflow_month, wt = cashflow_amt, name = "cashflow_total")

ggplot(plot_tbl) +
  geom_line(aes(x = cashflow_month, y = cashflow_total)) +
  expand_limits(y = 0) +
  facet_wrap(vars(currency), nrow = 2, scales = "free_y") +
  scale_y_continuous(labels = label_comma()) +
  labs(
    x = "Cashflow Month",
    y = "Cashflow Amount",
    title = "Lineplot of Monthly Cashflows"
    )

3.4 Calculate Futures Delivery Expirations

We now want to repeat this exercise, aggregating by FX futures delivery dates to allow the asset manager to reduce the cost of hedging the FX risk by using futures rather than dealing with forwards.

expry_dates <- expiration_date_tbl %>% pull(expiration_date)

futures_exposures_tbl <- bond_cashflow_tbl %>%
  count(currency, cashflow_date, wt = cashflow_amt, name = "date_total") %>%
  mutate(
    exposure_date = map(cashflow_date, ~ expry_dates[expry_dates >= .x][1]) %>% reduce(c)
    ) %>%
  group_by(currency, exposure_date) %>%
  mutate(
    total_exposure = cumsum(date_total) %>% round(2)
    ) %>%
  ungroup()

futures_exposures_tbl %>% glimpse()

## Rows: 1,229
## Columns: 5
## $ currency       <chr> "CAD", "CAD", "CAD", "CAD", "CAD", "CAD", "CAD", "CAD",…
## $ cashflow_date  <date> 2019-01-01, 2019-01-03, 2019-01-16, 2019-01-18, 2019-0…
## $ date_total     <dbl> 8505.000, 8203.125, 4753.125, 4875.000, 5865.000, 9100.…
## $ exposure_date  <date> 2019-01-18, 2019-01-18, 2019-01-18, 2019-01-18, 2019-0…
## $ total_exposure <dbl> 8505.00, 16708.12, 21461.25, 26336.25, 5865.00, 14965.0…

We now show this table using the DT package

futures_exposures_tbl %>%
  pivot_wider(
    id_cols     = c(currency, cashflow_date, exposure_date),
    names_from  = currency,
    values_from = total_exposure,
    values_fill = 0
    ) %>%
  datatable()

We also want to plot the cumulative currency exposures by delivery date and we represent the delivery dates by a vertical line.

ggplot(futures_exposures_tbl) +
  geom_line(aes(x = cashflow_date, y = total_exposure)) +
  geom_vline(aes(xintercept = exposure_date), colour = "red") +
  facet_wrap(vars(currency), nrow = 2, scales = "free_y") +
  scale_y_continuous(labels = label_comma(scale = 1e-6)) +
  labs(
    x = "Date",
    y = "Total Exposure (millions)",
    title = "Visualisation of FX Exposure Aggregated to Delivery Date"
    )

The above exposure is a bit messy and so we take an alternative approach to this where we display the delivery dates as points rather than vertical lines.

exposure_data_tbl <- futures_exposures_tbl %>%
  group_by(currency, exposure_date) %>%
  summarise(
    .groups = "drop",
    
    max_exposure = max(total_exposure)
  )

ggplot() +
  geom_line(aes(x = cashflow_date, y = total_exposure), 
            data = futures_exposures_tbl) +
  geom_point(aes(x = exposure_date, y = max_exposure),
             data = exposure_data_tbl, colour = "red") +
  facet_wrap(vars(currency), nrow = 2, scales = "free_y") +
  scale_y_continuous(labels = label_comma(scale = 1e-6)) +
  labs(
    x = "Date",
    y = "Total Exposure (millions)",
    title = "Visualisation of FX Exposure Aggregated to Delivery Date"
    )

3.5 Calculate Portfolio Duration

We want to calculate a quantity known as the Macauley Duration - a way to estimate the interest rate risk in the portfolio. This duration is a commonly calculated quantity, and is useful for risk management of the portfolio.

calculate_cashflow_duration <- function(data_tbl, duration_date) {
  cashflow_duration <- data_tbl %>%
    filter(cashflow_date > duration_date) %>%
    mutate(
      time_diff = difftime(cashflow_date, duration_date, units = "days") %>%
        divide_by(365.25) %>%
        as.numeric()
      ) %>%
    summarise(
      .groups = "drop",
      
      cashflow_duration = sum(time_diff * cashflow_amt) / sum(cashflow_amt)
      ) %>%
    pull(cashflow_duration)

  return(cashflow_duration)
}

We start by calculating the overall duration of the portfolio, split by currency.

bond_cashflow_tbl %>%
  group_nest(currency) %>%
  mutate(
    segment_duration = map_dbl(
      data, calculate_cashflow_duration,
      duration_date = as.Date("2019-01-01")
      )
    ) %>%
  transmute(currency, duration = round(segment_duration, 3)) %>%
  datatable()

cashflow_full_tbl %>%
  group_nest(currency, gics_sector_name) %>%
  mutate(
    segment_duration = map_dbl(
      data, calculate_cashflow_duration,
      duration_date = as.Date("2019-01-01")
      )
    ) %>%
  transmute(gics_sector_name, currency, duration = round(segment_duration, 3)) %>%
  pivot_wider(
    id_cols     = c(gics_sector_name),
    names_from  = currency,
    values_from = duration,
    values_fill = 0
    ) %>%
  arrange(gics_sector_name) %>%
  datatable()

cashflow_full_tbl %>%
  group_nest(currency, mktcap_qn) %>%
  mutate(
    segment_duration = map_dbl(
      data, calculate_cashflow_duration,
      duration_date = as.Date("2019-01-01")
      )
    ) %>%
  transmute(mktcap_qn, currency, duration = round(segment_duration, 3)) %>%
  pivot_wider(
    id_cols     = c(mktcap_qn),
    names_from  = currency,
    values_from = duration,
    values_fill = 0
    ) %>%
  arrange(mktcap_qn) %>%
  datatable()

3.6 Calculate Yield to Maturity

We can take a similar approach to calculating yield-to-maturity, the discount rate at which the net present value of the cashflows is zero.

This quantity is usually available for each bond in the portfolio as part of the pricing, but we can also calculate it for any subset of our portfolio.

calculate_cashflow_yield_maturity <- function(cashflow_tbl, curr_cost,
                                              curr_date) {

  discount_tbl <- cashflow_tbl %>%
    mutate(
      tdiff = difftime(cashflow_date, curr_date, units = "days") %>%
        as.numeric() %>%
        divide_by(365.25)
      )

  calculate_npv <- function(int_rate) {
    npv <- discount_tbl %>%
      mutate(
        discounted = cashflow_amt * exp(-int_rate * tdiff)
      ) %>%
      summarise(
        disc_cashflow = sum(discounted)
      ) %>%
      pull(disc_cashflow) %>%
      subtract(curr_cost)

    return(npv)
  }


  optim_val <- optimise(function(x) abs(calculate_npv(x)), interval = c(0, 1))

  return(optim_val$minimum)
}

We now want to calculate the yield to maturity for each of the bonds.

bond_portfolio_ytm_tbl <- cashflow_full_tbl %>%
  select(
    issuer, ticker_symbol, currency, mkt_value, gics_sector_name, mktcap_qn,
    cashflow_date, cashflow_amt
    ) %>%
  group_nest(
    issuer, ticker_symbol, currency, mkt_value, gics_sector_name, mktcap_qn
    ) %>%
  mutate(
    ytm = map2_dbl(
      data, mkt_value,
      calculate_cashflow_yield_maturity, 
      curr_date = as.Date("2019-01-01")
      )
    ) %>%
  select(
    issuer, ticker_symbol, currency, mkt_value, gics_sector_name, mktcap_qn,
    ytm
    )

bond_portfolio_ytm_tbl %>% glimpse()

## Rows: 250
## Columns: 7
## $ issuer           <chr> "ACAN 8.375 06/07/2021", "ACFN 6.375 12/18/2020", "AC…
## $ ticker_symbol    <chr> "ACAN", "ACFN", "ACIW", "ADC", "ADVM", "AFTM", "AKCA"…
## $ currency         <chr> "USD", "USD", "USD", "USD", "USD", "USD", "USD", "USD…
## $ mkt_value        <dbl> 141312.6, 342931.2, 181945.2, 209013.0, 253520.8, 281…
## $ gics_sector_name <chr> "Health Care", "Information Technology", "Information…
## $ mktcap_qn        <fct> QN1, QN1, QN3, QN2, QN1, QN1, QN3, QN4, QN1, QN1, QN2…
## $ ytm              <dbl> 0.08988547, 0.05467070, 0.08075142, 0.07231494, 0.085…

Now that we have calculated the yield to maturity for each of the bonds in the portfolio we now want to visualise this data so we can get a sense of the dispersion.

ggplot(bond_portfolio_ytm_tbl) +
  geom_point(aes(x = gics_sector_name, y = ytm)) +
  expand_limits(y = 0) +
  labs(
    x = "GICS Sector",
    y = "Yield to Maturity",
    title = "Yield to Maturity by Sector"
    ) +
  theme(axis.text.x = element_text(angle = 20, vjust = 0.5))

We now want to calculate the segment yield to maturity on the book.

sector_ytm_tbl <- cashflow_full_tbl %>%
  nest(data = c(cashflow_date, cashflow_amt)) %>%
  group_by(currency, gics_sector_name) %>%
  mutate(segment_value = sum(mkt_value)) %>%
  ungroup() %>%
  unnest(data) %>%
  group_nest(currency, gics_sector_name, segment_value) %>%
  mutate(
    ytm = map2_dbl(
      data, segment_value,
      calculate_cashflow_yield_maturity,
      curr_date = as.Date("2019-01-01")
      )
    )

sector_ytm_tbl %>%
  mutate(ytm = round(ytm, 4)) %>%
  pivot_wider(
    id_cols     = gics_sector_name,
    names_from  = currency,
    values_from = ytm,
    values_fill = 0
    ) %>%
  datatable()

Finally, we repeat the process with the market cap quintiles.

mktcap_ytm_tbl <- cashflow_full_tbl %>%
  nest(data = c(cashflow_date, cashflow_amt)) %>%
  group_by(currency, mktcap_qn) %>%
  mutate(segment_value = sum(mkt_value)) %>%
  ungroup() %>%
  unnest(data) %>%
  group_nest(currency, mktcap_qn, segment_value) %>%
  mutate(
    ytm = map2_dbl(
      data, segment_value,
      calculate_cashflow_yield_maturity,
      curr_date = as.Date("2019-01-01")
      )
    )

mktcap_ytm_tbl %>%
  mutate(ytm = round(ytm, 4)) %>%
  pivot_wider(
    id_cols     = mktcap_qn,
    names_from  = currency,
    values_from = ytm,
    values_fill = 0
    ) %>%
  datatable()