In yunching/tidymas: A collection of RMD utilities

knitr::opts_chunk$set(echo = FALSE, warning = FALSE)
library(tidyverse)
library(Rblpapi)
library(lubridate)
library(knitr)
library(tidymas)
library(ggpubr)

blpConnect()

# Get strategies from file and their sizes (mix of month weighted and %)
strategies_list <- build_strategies("../data2/strategies.csv")

# Get required instruments and portfolios (actual vs sim)
instr_df <- strategies_list$summary
portfolios_list <- strategies_list[names(strategies_list) != "summary"]

if (nrow(filter(instr_df, size_type == "months"))) {
  # Get duration from Bloomberg
  dur_df <- get_dur_bbg(instr_df)

  # Calculate all weights in %
  clean_pf_list <- map(portfolios_list, 
                    ~convert_dur_size(., instr_df, dur_df))
} else {
  clean_pf_list <- map(portfolios_list,
                       function(x) mutate(x, size = size / 100))
}

# Get returns of assets from Bloomberg
asset_return <- get_ret_bbg(instr_df)

# Calculate weight return of strategies
wt_return <- map(clean_pf_list, 
                  ~calc_strat_wt_return(., asset_return))

# Calculate weight of strategies
strat_headline_size <- map(clean_pf_list, 
                           ~calc_strat_headline_size(.))

# Calculate unweighted return of strategies
unwt_return <- calc_strat_unwt_return(wt_return$sim, strat_headline_size$sim)

# Set dates for analysis
curr_date <- today()
prev_date <- curr_date - months(3)

# Create scenarios for analysis
scenarios_input <- read.table(
  text = "period,       start_date, end_date
          TaperTantrum, 2013-05-31, 2013-12-31
          GFCStress,    2007-10-31, 2009-02-27", 
  sep = ",", header = TRUE, strip.white = TRUE, colClasses = c("character", "Date", "Date")) 

# Add series of most recent quarter
scenarios <- rbind(scenarios_input, 
      data.frame(period = c("Last3M"), start_date = c(curr_date - months(3)), end_date = c(curr_date))) 

rownames(scenarios) <- scenarios$period 

# Order by last 3M, then based on start dates (for plotting purposes)
ordered_periods <- c("Last3M", scenarios$period[order(scenarios$start_date)][!scenarios$period[order(scenarios$start_date)] %in% c("Last3M")])

# Get current strategies
curr_strat <- get_strat_size(strat_headline_size$actual, curr_date)
prev_strat <- get_strat_size(strat_headline_size$actual, prev_date)

# Calculate active risk of previous quarters strategies 
active_risk_prev <- tryCatch({
  calc_active_risk(unwt_return, 
                   prev_strat,
                   start_date = prev_date - months(3), end_date = prev_date)
}, error = function(x) {data.frame(active_risk = 0)})

# Calculate active risk of current strategies
active_risk_curr <- apply(scenarios, 1, 
                     function(x) {
                       calc_active_risk(unwt_return, 
                                        curr_strat,
                                        start_date = x['start_date'], end_date = x['end_date'])
                     })

# calculate historical return based on scenario dates with current strategy
scenario_return <- apply(scenarios, 1, 
                           function(x) {
                             simulate_history(unwt_return, 
                                      curr_strat, 
                                      x['start_date'], x['end_date'])
                           })

tryCatch({
ret_by_owner <- wt_return$actual %>%
  custom_grouping(instr_df, "owner")
actual_corr <- calc_cor(ret_by_owner %>% spread(owner, wt_return),
                        start_date = curr_date - months(3),
                        end_date = curr_date)

exp_return <- simulate_history(unwt_return, 
                               curr_strat, 
                               curr_date - months(3), curr_date)

exp_ret_by_owner <- exp_return %>%
  custom_grouping(instr_df, "owner")

exp_corr <- calc_cor(exp_ret_by_owner %>% spread(owner, wt_return),
                        start_date = curr_date - months(3),
                        end_date = curr_date)
}, error = function(e) "No team correlations")

###################################################
# Start generation of report, starting with writeup
###################################################

# Parameters to be displayed in later section
current_quarter <- ceiling(month(curr_date) / 3)
prev_quarter <- (current_quarter + 2) %% 4 + 1
current_abs_active_risk <- active_risk_curr$Last3M$active_risk %>% abs %>% sum * 10000
prev_abs_active_risk <- active_risk_prev$active_risk %>% abs %>% sum * 10000
info_ratio <- 0.3
gfc_abs_active_risk <- active_risk_curr$GFCStress$active_risk %>% abs %>% sum * 10000
taper_abs_active_risk <- active_risk_curr$TaperTantrum$active_risk %>% abs %>% sum * 10000

# Format active risk table (by strategies)
strat_active_risk <- active_risk_curr$Last3M %>%  
  left_join(unique(select(instr_df, strategy, owner, type)), by = "strategy") %>%
  mutate(risk_percent = active_risk / sum(active_risk) * 100, 
         active_risk = active_risk * 10000,
         owner = toupper(owner),
         name = str_extract(strategy, "^.*(?=:::)")) %>%
  arrange(desc(risk_percent))

# Find highest active risk strategy
top_strategy <- strat_active_risk %>% head(1)

# Find most diversifying strategy
most_diverse <- strat_active_risk %>% tail(1)

# Calculate active risk by division
div_risk <- strat_active_risk %>%
  group_by(owner) %>%
  summarise(abs_active_risk = sum(abs(active_risk))) %>%
  ungroup %>%
  mutate(risk_percent = abs_active_risk / sum(abs_active_risk)) %>%
  arrange(desc(risk_percent))

# Calculate active risk ex ED
ex_ed_risk <- strat_active_risk %>% 
  filter(owner != "ed") %>%
  .$active_risk %>%
  sum

ex_ed_risk_prev <- tryCatch({
  active_risk_prev %>%
    mutate(name = str_extract(strategy, "^.*(?=:::)"),
           owner = str_extract(strategy, "(?<=:::).*$")) %>%
    filter(owner != "ed") %>%
    .$active_risk %>%
    sum * 10000
}, error = function(x) data.frame(active_risk = 0))

The absolute active risk utilization for Qr current_quarter is expected to be r sprintf("%.1f", current_abs_active_risk)bps in our baseline scenario, which is r if (current_abs_active_risk > prev_abs_active_risk) "above" else "below" our estimates for the last quarter (r prev_quarterQ: r sprintf("%.1f",prev_abs_active_risk)bps). Assuming an information ratio of r sprintf("%.1f", info_ratio), the expected portfolio excess return will be r sprintf("%.1f", info_ratio * current_abs_active_risk)bps (annualized). Under a stress scenario similar to the GFC and the Taper Tantrum, we expect absolute active risk utilization to increase to r sprintf("%.1f", gfc_abs_active_risk) and r sprintf("%.1f", taper_abs_active_risk)bps respectively

Key observations are:

1. r top_strategy$owner's r top_strategy$type strategy of r top_strategy$name constitutes the highest active risk. The trade has an active risk of r sprintf("%.1f", top_strategy$active_risk)bps, which is r sprintf("%.1f", top_strategy$risk_percent)% of total active risk.

2. The most diversifying strategy in the portfolio is the r most_diverse$name from r most_diverse$owner, with a r sprintf("%.1f", most_diverse$risk)% risk contribution.

3. The risk contribution across the different divisions are shown below. r div_risk$owner[1] accounts for the largest share of total risk at r sprintf("%.1f", div_risk$risk_percent[1] * 100)%, followed by r div_risk$owner[2] and r div_risk$owner[3] at r sprintf("%.1f", div_risk$risk_percent[2] * 100)% and r sprintf("%.1f", div_risk$risk_percent[3] * 100)% respectively.

4. Excluding ED, risk budget utilization is expected to be r sprintf("%.1f", ex_ed_risk)bps, compared to r sprintf("%.1f", ex_ed_risk_prev)bps in the previous quarter.

Current Active Strategies

# Get strategies sizes in %
strat_percent_size <- get_strat_size(strat_headline_size$actual, curr_date) %>%
  rename(size_percent = size)

# Extract necessary portfolio information
pf_overview <- pf_summary(portfolios_list$actual, curr_date) %>%
  select(-date) %>%
  gather(strategy, size) %>%
  left_join(unique(select(instr_df, strategy, size_type, owner, type)), by = "strategy") %>%
  left_join(strat_percent_size, by = "strategy") %>% 
  left_join(select(strat_active_risk, strategy, active_risk, risk_percent), by = "strategy") %>% 
  arrange(desc(active_risk)) 

# Format and print portfolio information
pf_overview %>%
  mutate(size = str_replace(sprintf("%.2f %s", size, size_type)," percent","%") %>% str_replace(" months", "m"),  # Format numbers
         size_percent = scales::percent(size_percent,accuracy = 0.01),
         active_risk = scales::number(active_risk, accuracy = 0.1),
         risk_percent = scales::percent(risk_percent/100, accuracy = 0.1)) %>%
  mutate(strategy = str_extract(strategy, "^.*(?=:::)"),               # Format naming of strategy to remove division, add serial number
         no = 1:nrow(.)) %>%
  select(no, strategy, owner, type, size, size_percent, active_risk, risk_percent) %>%   # Select required fields for display
  rename("active_risk (bps)" = "active_risk",                          # Format headers of the table
         "active_risk (% R2)" = "risk_percent") %>% 
  kable                                                                # Display table

Active Risk

Active risk contribution is the contribution to total standard deviation of the portfolio. Individual trades' active risk is additive to form overall portfolio standard deviation aka active risk of the portfolio

# Find order of strategies by their risk contribution in the last 3m (for plotting purposes)
ordered_strategies <- active_risk_curr$Last3M  %>%
  mutate(strategy = str_extract(strategy, "^.*(?=:::)")) %>%
  group_by(strategy) %>%
  summarise(active_risk = sum(active_risk)) %>%
  ungroup %>%
  mutate(order = order(active_risk)) %>%
  arrange(active_risk) %>%
  .$strategy

active_risk_scenarios <- active_risk_curr %>% reduce(full_join, by = "strategy") %>%
  setNames(c("strategy", names(active_risk_curr)))

# Formating active risk for display and to fit into ggplot
active_risk_gathered <- active_risk_scenarios %>%
  left_join(unique(select(instr_df, strategy, owner, type)), by = "strategy") %>%
  mutate(strategy = str_extract(strategy, "^.*(?=:::)")) %>%
  mutate(strategy = factor(strategy, level = ordered_strategies),
         owner = factor(owner, level = c("us", "cat", "europe", "ed"))) %>%
  gather(period, active_risk, -strategy, -owner, -type) %>%
  mutate(period = factor(period, level = ordered_periods))

# Plot active risk by strategy
ggplot(active_risk_gathered, aes(x = strategy, y = active_risk * 10000, fill = owner)) + 
  geom_col() +
  facet_wrap(~period, ncol = 3) +
  labs(y = "active risk (bp)", title = "Active Risk by Strategy") +
  coord_flip() 

# Plot active risk by asset strategies
active_risk_gathered %>% 
  group_by(period, type) %>%
  summarise(active_risk = sum(abs(active_risk))) %>%
  sort_gg("type", "active_risk") %>%
  ggplot(aes(x = type, y = active_risk * 10000)) + 
  geom_col() +
  facet_wrap(~period, ncol = 3) +
  labs(y = "active risk (bp)", title = "Active Risk by Strategy Types") +
  coord_flip() 

# Plot active risk by asset class
asset_types <- data.frame(type = c("Curve", "Inflation", "Duration", "Spread", "FX", "Equity"), 
                          asset_class = c("Fixed Income", "Fixed Income", "Fixed Income", "Fixed Income", "FX", "Equity"), 
                          stringsAsFactors = FALSE) 

active_risk_gathered %>% 
  left_join(asset_types, by = "type") %>%
  mutate(asset_class = ifelse(is.na(asset_class), "Others", asset_class)) %>%
  group_by(period, asset_class) %>%
  summarise(active_risk = sum(abs(active_risk))) %>%
  sort_gg("asset_class", "active_risk") %>%
  ggplot(aes(x = asset_class, y = active_risk * 10000)) + 
  geom_col() +
  facet_wrap(~period, ncol = 3) +
  labs(y = "active risk (bp)", title = "Absolute Active Risk by Asset Class") +
  coord_flip() 

# Plot active risk by division
active_risk_gathered %>% 
  group_by(period, owner) %>%
  summarise(active_risk = sum(abs(active_risk))) %>%
  sort_gg("owner", "active_risk") %>%
  ggplot(aes(x = owner, y = active_risk * 10000)) + 
  geom_col() +
  facet_wrap(~period, ncol = 3) +
  labs(y = "active risk (bp)", title = "Absolute Active Risk by Division") +
  coord_flip() 

# Find unique_strategies
unique_strategies <- instr_df %>%
  select(strategy, owner, type) %>%
  unique

# Start date for calculation of returns
end_date_return <- curr_date
start_date_return <- end_date_return - months(12)


# Extract return data based on start_date
actual_ret_filtered <- wt_return$actual %>% 
  filter(date >= start_date_return & date <= end_date_return) %>%
  left_join(unique_strategies, by="strategy") %>%
  rename(pnl = .data$wt_return)

# Calculate sharpe grouped by owner, in annualized bps of R2
sharpe_by_owner <- actual_ret_filtered %>% 
  group_by(owner) %>%
  summarise(return = mean(pnl, na.rm = T) * 250 * 10000, 
            std_dev = sd(pnl, na.rm = T) * sqrt(250) * 10000) %>%
  mutate(sharpe = round(return / std_dev ,2),
         return = round(return, 2),
         std_dev  = round(std_dev , 2)) 

# Calculate sharpe grouped by strategy, in annualized bps of R2
sharpe_by_strategy <- actual_ret_filtered %>%
  group_by(type) %>%
  summarise(return = mean(pnl, na.rm = T) * 250 * 10000, 
            std_dev  = sd(pnl, na.rm = T) * sqrt(250) * 10000) %>%
  mutate(sharpe = round(return / std_dev , 2),
         return = round(return, 2),
         std_dev  = round(std_dev , 2))

Sharpe Ratio

Sharpe Ratio = Return / Std_dev

The returns and standard deviation below have been computed as annualized return in weighted basis points of R2.

Trailing 12 months results

By division

r kable(sharpe_by_owner)

By strategy types

r kable(sharpe_by_strategy)

Sharpe ratio breakdown by division

# Breakdown components of sharpe (return and standard dev)
sharpe_breakdown <- actual_ret_filtered %>%
  group_by(owner, strategy, type) %>%
  summarise(std_dev = sd(pnl, na.rm = T) * sqrt(250) * 10000,
            return = mean(pnl, na.rm = T) * 250 * 10000) %>%
  ungroup %>%
  mutate(strategy = str_extract(strategy, "^.*(?=:::)")) %>%
  arrange(owner, return) %>%
  mutate(strategy = factor(strategy, levels = unique(strategy)))

# Plot breakdown of returns
sharpe_breakdown %>% 
  ggplot(aes(x = strategy, y = return)) + 
  geom_col() + 
  facet_wrap(~owner, ncol = 2, scales = "free_y") + 
  coord_flip() +
  labs(title = "Return contribution of trades (bps of R2, annualized)")

# Sort by standard deviation
sharpe_breakdown2 <- sharpe_breakdown %>%
  arrange(owner, std_dev) %>%
  mutate(strategy = factor(strategy, levels = unique(strategy))) 

# Plot breakdown of standard deviation
sharpe_breakdown2 %>% ggplot(aes(x = strategy, y = std_dev)) + 
  geom_col() + 
  facet_wrap(~owner, ncol = 2, scales = "free_y") + 
  coord_flip() +
  labs(title = "Std dev of trades (bps of R2, annualized)")

Performance of strategies

Actual returns (Cumulative)

# Calculate start of last quarter's date
prev_3m_date <- today() - months(4)
day(prev_3m_date) <- days_in_month(prev_3m_date)

# Calculate prev quarter returns
prev_3m_ret <- wt_return$actual %>%
  filter(date > prev_3m_date) %>%
  replace_na(list(wt_return = 0)) %>%
  group_by(strategy) %>%
  mutate(cum_pnl = cumsum(wt_return)) %>%
  ungroup %>%
  mutate(owner = str_extract(strategy, "(?<=:::).*$"),
         strategy = str_extract(strategy, "^.*(?=:::)"),
         cum_pnl = cum_pnl * 10000)

# Plot actual returns, starting from start_date_return, defined when calculating sharpe ratio
actual_ret_cum <- wt_return$actual %>%
  filter(date > start_date_return) %>%
  replace_na(list(wt_return = 0)) %>%
  group_by(strategy) %>%
  mutate(cum_pnl = cumsum(wt_return)) %>%
  ungroup %>%
  mutate(owner = str_extract(strategy, "(?<=:::).*$"),
         strategy = str_extract(strategy, "^.*(?=:::)"),
         cum_pnl = cum_pnl * 10000) 

# Plot cumulative return, one chart for each owner
results <- lapply(unique(actual_ret_cum$owner), function(i) {
  g1 <- actual_ret_cum %>% 
    filter(owner == i) %>%                                  # Filter returns from current owner
    ggplot(aes(x = date, y = cum_pnl)) +       
    geom_area(aes(fill = strategy)) +                       # Plot area chart
    stat_summary(fun.y = sum, geom = "line", size = 1) +    # Plot total line 
    labs(y = "Cumulative Pnl (R2 wt bps)", title = paste0(toupper(i), ": Last 12m")) +
    theme(axis.title.x = element_blank(), legend.position = "bottom")

  g2 <- prev_3m_ret %>%
        filter(owner == i) %>%                                  # Filter returns from current owner
    ggplot(aes(x = date, y = cum_pnl)) +       
    geom_area(aes(fill = strategy)) +                       # Plot area chart
    stat_summary(fun.y = sum, geom = "line", size = 1) +    # Plot total line 
    labs(title = "Prev quarter") +
    theme(axis.title.y = element_blank(), axis.title.x = element_blank(), legend.position = "bottom") 

  min_y <- min(layer_scales(g1)$y$range$range[1], layer_scales(g2)$y$range$range[1])
  max_y <- max(layer_scales(g1)$y$range$range[2], layer_scales(g2)$y$range$range[2])


  p <- ggarrange(g1 + ylim(c(min_y, max_y)), g2 + ylim(c(min_y, max_y)), ncol=2, widths = c(2, 1), common.legend = TRUE, legend="bottom")

  print(p)
})

Correlations

Team Correlations

tryCatch({
# Plot correlation of returns between teams
actual_corr %>%
  plot_cor(title = "Last Quarter Realised Correlations")

exp_corr %>%
  plot_cor(title = "Correlation based on current strategies")
}, error = function(e) print("No team correlations available"))

Strategy Correlations

# Plot correlation of returns between strategies

# #Find strategies ordered by owner name (for plotting purposes)
# ordered_strategies <- instr_df %>% select(strategy, owner) %>%
#   mutate(strategy = str_extract(strategy, "^.*(?=:::)")) %>%
#   arrange(owner, strategy) %>%
#   .$strategy %>%
#   unique

# Extract unweighted return of all strategies still open
uniq_unwt_ret <- unwt_return %>%
  filter(strategy %in% curr_strat$strategy) %>%
  mutate(strategy = str_extract(strategy, "^.*(?=:::)")) %>%
  group_by(date, strategy) %>%
  summarise(return = mean(return, na.rm = TRUE)) %>%
  ungroup 

# Calculate correlation between all open trades across all scenarios
strat_cor_all <- 
  apply(scenarios, 1,  # "Loop" through all scenarios
        function(x)
          # Calculate correlation for each  scenario
          calc_cor(uniq_unwt_ret %>% spread(strategy, return), start_date = x['start_date'], end_date = x['end_date'], period_name = x['period']))# %>%
  # mutate(strat1 = factor(strat1, levels = ordered_strategies),   # Order strategies for plotting
  #        strat2 = factor(strat2, levels = ordered_strategies))

# Plot all correlation matrices
temp <- map(rev(names(strat_cor_all)), function(i) {
  cor_df <- strat_cor_all[[i]]
  plot_cor(cor_df,  paste("Correlation during", i))
})

yunching/tidymas documentation built on Feb. 5, 2023, 1:42 p.m.