Introduction

In this bonus practical we investigate whether active managers have taken full advantage of their active opportunities.

library(tidyverse);library(lubridate);library(tbl2xts)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.1     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.1
## ✔ 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
J200 <- fmxdat::J200

# Index Returns
Indexes <- fmxdat::LCL_Index_Returns %>% filter(Tickers == "J200")

Active_Funds <- fmxdat::ASISA %>% filter(!is.na(Returns))

Let’s calculate rolling dispersion of J200 stock index (let’s assume this is sufficient as a measure of active opportunity sets for active managers). Let’s create a function that gives us a rolling N-day measure to calculate dispersion (weighted and unweighted).

  • let the function winsorize extreme returns (+/- 50%) and also cap axes at +/- XX%.
df_stocks <- J200
BM <- Indexes %>% filter(Tickers %in% "J200") %>% arrange(date) %>% select(date, BM = Returns)
BMSel = "J200"

Dispersion_Prep <- function(df_used, BMUse, BMSel = "J200", NSel = 60, CapDisp = 0.45){

  # Let's first winsorize returns, for if there are significant outliers:
  
    df_use <-
        df_used %>% select(date, Tickers, Return, Wt = all_of(BMSel)) %>% filter(date > ymd(20050101)) %>% filter(!is.na(Wt)) %>%
        mutate(Return = ifelse(Return > 0.5, 0.5,
                               ifelse(Return < -0.5, -0.5, Return))) %>% filter(!is.na(Return))

    Roll_M_disp <-
        df_use %>% group_by(Tickers) %>% mutate(roll_Rt = RcppRoll::roll_prod(1+Return, n = NSel, fill = NA, align = "right")-1,
                                                roll_wt = RcppRoll::roll_mean(Wt, n = NSel, fill = NA, align = "right")) %>%
        left_join(., BMUse %>% mutate(roll_BM = RcppRoll::roll_prod(1+BM, n = NSel, fill = NA, align = "right")-1) %>% select(date, roll_BM) %>% unique, by = "date") %>%
        filter(!is.na(roll_wt)) %>%
      filter(!is.na(roll_BM)) %>% 
        group_by(date) %>%
        mutate(Idx_U = sum(roll_Rt / 1/n(), na.rm=T)) %>%
        summarise(Dispersion_U = sqrt( sum ( (1/n())*(roll_Rt - Idx_U)^2, na.rm = TRUE) ),
                  Dispersion_W = sqrt( sum ( (roll_wt)*(roll_Rt - roll_BM)^2, na.rm = TRUE) ))

    Roll_M_disp %>% mutate(type = BMSel, N = NSel) %>% mutate(across(starts_with("Disp"), ~ifelse(. > CapDisp, CapDisp, .)))

}

# Dispersion calc using daily frequency:
ann_disp <- Dispersion_Prep(df_used = df_stocks, BMUse = BM, BMSel = "J200", NSel = 250)
m3_disp <- Dispersion_Prep(df_used = df_stocks, BMUse = BM, BMSel = "J200",NSel = 60)

# Dispersion calc using weekly frequency (less noisy):
df_stocks_weekly <- 
  df_stocks %>% arrange(date) %>% group_by(Tickers) %>% mutate(cp = cumprod(1+Return)) %>% 
  mutate(week = format(date, "%Y%W")) %>% group_by(week) %>% filter(date == last(date)) %>% 
  group_by(Tickers) %>% mutate(Return = ifelse(date - lag(date) < 10, cp / lag(cp)-1, NA)) %>% ungroup() %>% 
  filter(!is.na(Return))

BM_weekly <- 
  BM %>% arrange(date) %>% mutate(cp = cumprod(1+BM)) %>% filter(date %in% unique(df_stocks_weekly$date)) %>% mutate(Return = cp / lag(cp)-1) %>% select(date, BM = Return)

ann_disp_weekly <- Dispersion_Prep(df_used = df_stocks_weekly, BMUse = BM_weekly, BMSel = "J200", NSel = 52)
m3_disp_weekly <- Dispersion_Prep(df_used = df_stocks_weekly, BMUse = BM_weekly, BMSel = "J200",NSel = 12)

gdisp <- 
ann_disp %>% gather(Type, Value, starts_with("Dispersion")) %>% 
  ggplot() + geom_line(aes(date, Value, color = Type)) + 
  fmxdat::theme_fmx() + 
  fmxdat::fmx_cols() + 
  labs(x = "", y = "Rolling 12 month returns dispersion")

gdisp_weekly <- 

  ann_disp_weekly %>% gather(Type, Value, starts_with("Dispersion")) %>% 
  
  group_by(Type) %>% mutate(Rolling_mean = RcppRoll::roll_mean(Value, fill = NA, align = "right", n = 12)) %>% 
  
  ggplot() + 
  geom_line(aes(date, Value, color = Type), alpha = 0.55) + 
  # Check this trick.... fill!
  geom_line(aes(date, Rolling_mean, color = Type), linewidth = 1.4) + 
  
  fmxdat::theme_fmx() + 
  fmxdat::fmx_cols() + 
  labs(x = "", y = "Rolling 12 month returns dispersion")

fmxdat::finplot(gdisp, y.pct = T)

fmxdat::finplot(gdisp_weekly, y.pct = T, x.date.dist = "1 year", x.date.type = "%Y", x.vert = T)
## Warning: Removed 22 rows containing missing values or values outside the scale range
## (`geom_line()`).

Step 2

Now we calculate rolling active manager returns vs the index

BMUse <- 
  Indexes %>% filter(Tickers %in% BMSel) %>% mutate(cp = cumprod(1+Returns)) %>% 
  fmxdat::YM() %>% group_by(YM) %>% filter(date == last(date)) %>% ungroup() %>% arrange(date) %>% mutate(BM = cp / lag(cp)-1)

# Reason for yourself why I am doing the below?
# Tip: what would happen if BM had a month ending on 28 Feb, and Active_Funds ended on 29 Feb, and I joined by date?
active_df <- 
left_join(
  Active_Funds %>% fmxdat::YM(),
  BMUse  %>% select(YM, BM),
  by = "YM"
)

# Now we calculate the rolling 12 month relative performance of each manager...
df_comp <- 
active_df %>% group_by(Funds) %>% 
  mutate(RollRet = RcppRoll::roll_prod(1+Returns, n = 12, fill = NA, align = "right"),
         RollBM = RcppRoll::roll_prod(1+BM, n = 12, fill = NA, align = "right")) %>% 
  ungroup() %>% 
  filter(!is.na(RollRet)) %>% mutate(XS = RollRet - RollBM) %>% 
  group_by(date) %>% 
  # Did you know you can do conditional sums in mutate?
  summarise(Proportion = sum(XS>0)/n())

Now let’s combine it…

You can use graphs too (be creative) - and you can stratify as per below.

Create some nice comparison figures:

df_comp_plot <- 
left_join(
df_comp %>% RA::YM(),
ann_disp_weekly %>% fmxdat::YM() %>% group_by(YM) %>% filter(date == last(date)) %>% select(YM, Disp = Dispersion_W),
by = "YM"
)

df_comp_plot %>% filter(!is.na(Disp)) %>% 
  mutate( hidisp = quantile(Disp, 0.85),
          lodisp = quantile(Disp, 0.25)) %>% 
  mutate(Enviro = ifelse(Disp > hidisp, "Hi",
                         ifelse(Disp < lodisp, "low",
                                "Other"))) %>% 
  group_by(Enviro) %>% summarise(prop = mean(Proportion))
## # A tibble: 3 × 2
##   Enviro  prop
##   <chr>  <dbl>
## 1 Hi     0.389
## 2 Other  0.318
## 3 low    0.412