Purpose

In this bonus practical, I want to show you how to create a periodic weight capping function.

Suppose you are confronted with the following problem set:

  • I want to rebalance my portfolio every quarter (on the 1st Wednesday of the month of January, April, July, October)

  • At rebalancing, give me the top 30 stocks, reweighted, and then cap the weights to 10%

  • Weights should be proportionally reallocated to the other stocks in the index.

Application

Right, let’s do this on some real data: the German exchange (DAX)

pacman::p_load(tidyverse)
pacman::p_load(tbl2xts)
DAX <- fmxdat::DAX

# Let's first determine when we need to rebalance (go
# through my code here at least 5 times to understand all
# the nuances, especially the grouping logic):
Rebalance_Days <- DAX %>%
    mutate(Year = format(date, "%Y"), Month = format(date, "%b"),
        Day = format(date, "%a")) %>%
    filter(Month %in% c("Jan", "Apr", "Jul", "Oct")) %>%
    select(date, Year, Month, Day) %>%
    unique() %>%
    group_by(Month) %>%
    filter(Day == "Wed") %>%
    group_by(Year, Month) %>%
    filter(date == first(date)) %>%
    pull(date)

Rights, so with our data and rebalancing dates in place, let’s create a capped weights dataframe to use for rebalancing purposes:

rebalance_col <- DAX %>%
    filter(date %in% Rebalance_Days) %>%
    # Now we have to distinguish rebalances - to create
    # something to group by:
mutate(RebalanceTime = format(date, "%Y%B")) %>%
    # Now we can group...
group_by(RebalanceTime) %>%
    # Now trim down to 30 stocks and reweight so sum(w)=1
arrange(desc(weight)) %>%
    top_n(30, weight) %>%
    mutate(weight = weight/sum(weight)) %>%
    ungroup() %>%
    arrange(date) %>%
    select(-Sector, -return)

Capping

Now the fun and games start… we now need to cap our weights vector at 8% and proportionally reallocate the weights.

Let’s create a sensible function to do this (note I make this function safe and overengineer for these purposes with the hope of convincing you to always write your functions in a safe and problem anticipatory way).

My function applies the capping a single date at a time, whereafter I will make it loop.

## Uncomment for stepping through function:
# df_Cons <- rebalance_col %>% filter(date == first(date))
# W_Cap = 0.08

Proportional_Cap_Foo <- function(df_Cons, W_Cap = 0.08){
  
  # Let's require a specific form from the user... Alerting when it does not adhere this form
  if( !"weight" %in% names(df_Cons)) stop("... for Calc capping to work, provide weight column called 'weight'")
  
  if( !"date" %in% names(df_Cons)) stop("... for Calc capping to work, provide date column called 'date'")
  
  if( !"Tickers" %in% names(df_Cons)) stop("... for Calc capping to work, provide id column called 'Tickers'")

  # First identify the cap breachers...
  Breachers <- 
    df_Cons %>% filter(weight > W_Cap) %>% pull(Tickers)
  
  # Now keep track of breachers, and add to it to ensure they remain at 10%:
  if(length(Breachers) > 0) {
    
    while( df_Cons %>% filter(weight > W_Cap) %>% nrow() > 0 ) {
      
      
      df_Cons <-
        
        bind_rows(
          
          df_Cons %>% filter(Tickers %in% Breachers) %>% mutate(weight = W_Cap),
          
          df_Cons %>% filter(!Tickers %in% Breachers) %>% 
            mutate(weight = (weight / sum(weight, na.rm=T)) * (1-length(Breachers)*W_Cap) )
          
        )
      
      Breachers <- c(Breachers, df_Cons %>% filter(weight > W_Cap) %>% pull(Tickers))
      
    }

    if( sum(df_Cons$weight, na.rm=T) > 1.001 | sum(df_Cons$weight, na.rm=T) < 0.999 | max(df_Cons$weight, na.rm = T) > W_Cap) {
      
      stop( glue::glue("For the Generic weight trimming function used: the weight trimming causes non unit 
      summation of weights for date: {unique(df_Cons$date)}...\n
      The restriction could be too low or some dates have extreme concentrations...") )
      
    }
    
  } else {
    
  }
  
  df_Cons
  
  }
  

# Now, to map this across all the dates, we can use purrr::map_df as follows:
  Capped_df <- 
    rebalance_col %>% 
    # Split our df into groups (where the groups here are the rebalance dates:
    group_split(RebalanceTime) %>% 
    # Apply the function Proportional_Cap_Foo to each rebalancing date:
    map_df(~Proportional_Cap_Foo(., W_Cap = 0.08) ) %>% select(-RebalanceTime)
  
# Testing this:
Capped_df %>% pull(weight) %>% max(.)
## [1] 0.08
# Check e.g. if we capped weights at 5%:
  Capped_df <- 
  rebalance_col %>% 
    group_split(RebalanceTime) %>% 
    map_df(~Proportional_Cap_Foo(., W_Cap = 0.05) ) %>% 
    select(-RebalanceTime)
# Testing this:
Capped_df %>% pull(weight) %>% max(.)
## [1] 0.05

Now to create the index returns using this capped weight estimator, let’s go ahead and use the trusty tbl2xts framework discussed in practical 1:

wts <- Capped_df %>%
    tbl_xts(cols_to_xts = weight, spread_by = Tickers)

rts <- DAX %>%
    filter(Tickers %in% unique(Capped_df$Tickers)) %>%
    tbl_xts(cols_to_xts = return, spread_by = Tickers)

wts[is.na(wts)] <- 0

rts[is.na(rts)] <- 0

Idx <- rmsfuns::Safe_Return.portfolio(R = rts, weights = wts,
    lag_weights = T) %>%
    # Let's make this a tibble:
xts_tbl() %>%
    rename(capped_Idx = portfolio.returns)

# Let's plot this bugger
Idx %>%
    mutate(Idx = cumprod(1 + capped_Idx)) %>%
    ggplot() + geom_line(aes(date, Idx), color = "steelblue") +
    labs(title = "Capped Index Calculation", subtitle = "Try and wrap me in a single function with various parameters?",
        x = "", y = "") + fmxdat::theme_fmx()

And there you go…

We have successfully capped our index.