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_quarter
Q: 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:
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.
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.
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.
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.
# 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 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 = Return / Std_dev
The returns and standard deviation below have been computed as annualized return in weighted basis points of R2.
r kable(sharpe_by_owner)
r kable(sharpe_by_strategy)
# 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)")
# 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) })
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"))
# 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)) })
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.