We continue on our IFRS9 disclosures quest!
Part 2 had us doing some heavy data munging, followed by modeling to estimate an ECL balance.
In this post we will massage the dataset from part 2 and prepare the report we specified in the first post. This report sets out an opening to closing balance of the loan and expected credit loss balances, and also details transfers between risk stages. The report will prepared in Tableau. There remains a significant amount of transformation required before the data can be ingested by Tableau however.
Recall the loan data for our purposes is the debt of the top 1,000 US companies by market capitalisation. All is explained in the first post of this series.
As usual we start loading the required packages.
library("tidyverse")
library("DescTools")
library("lubridate")
library("tibbletime")
library("DT")
library("widgetframe")
library("htmltools")
library("googledrive")
library("googlesheets4")Grabbing the data prepared in part 2.
This data was saved as both a feather and rds file. These are online in the blogs repo here. I’m going to load the local copy for now.
ifrs9_part2 <- readRDS(file = "ifrs9_part2.Rds")Initial transformations
Below I transform attribute names to a format based on a separate implementation of this dataflow. To take advantage of this work I also need to create some additional attributes:
1. ccy, the currency of the loan. Our original data is denominated in USD. This data has been mocked up to show how foreign currency balances can be modeled
2. type, this assigns a stock (a customer of our bank) as either revolving or term. A revolving exposure can be repaid and subsequently drawn upon again in contrast to term loans which are drawn down once. This data has been mocked up and is included as the opening to closing reconciliation is prepared differently for these categories
3. poci, “Purchased or originated financial asset(s) that are credit-impaired on initial recognition”. I won’t go into that mouthful here. Just know that it is a specific classification that needs to be disclosed
4. bal, the ledger balance of the loan. This will differ to the gross carrying amount if fees paid or received on orgination have been deferred
5. wof, write-offs
6. pryr, prior year balance for stage 1 loans assuming no model input changes
7. prlt, prior year balance for stage 2 and 3 loans assuming no model input changes
The last two attributes relate to the requirement to disclose the change in an expected credit loss as a result of changes in model inputs or model structure.
ifrs9_part3 <- ifrs9_part2 %>%
rename(
cust = Ticker,
unit = clust.name,
stage = RiskStage,
gca = TotalDebt,
ecl = ECL
) %>%
mutate(
date = me.date,
# Assign missing attributes
ccy = if_else(str_detect(cust, "^G"), "GBP", "USD"),
type = if_else(str_detect(cust, "^R"), "rvlv", "term"),
poci = if_else(str_detect(cust, "^P") & stage == 3, "Y", "N"),
bal = gca,
ecl = round(-ecl, 1),
wof = 0,
pryr = 0,
prlt = 0
) %>%
select(-me.date)
# Sample output
head(ifrs9_part3, 50) %>% datatable()Long to wide format
This next section of code accomplishes a number of transforms:
1. Assigning the disclosure category (the risk stages),
2. Creating lagged values of the loan and ECL balances,and
3. Calculating a cumulative movement on a year to date basis
ifrs9_wide1 <- ifrs9_part3 %>%
# Assign disclosure stage (1 / 2 / 3 / 4=POCI_NCI / 5=POCICI)
mutate(ctgy = case_when(
wof != 0 & poci == "N" ~ 3,
wof != 0 & poci == "Y" ~ 5,
wof != 0 & is.na(poci) ~ 3,
stage == 1 & poci == "N" ~ 1,
stage == 2 & poci == "N" ~ 2,
stage == 3 & poci == "N" ~ 3,
is.na(stage) & poci == "N" ~ 1,
stage == 1 & poci == "Y" ~ 4,
stage == 2 & poci == "Y" ~ 4,
stage == 3 & poci == "Y" ~ 5,
is.na(stage) & poci == "Y" ~ 4,
stage == 1 & is.na(poci) ~ 1,
stage == 2 & is.na(poci) ~ 2,
stage == 3 & is.na(poci) ~ 3)
) %>%
# Fill stage with preceding value (ignores initial na's) & default
# remaining na's to stage 1
group_by(cust) %>% fill(ctgy) %>% replace_na(list(ctgy = 1)) %>%
# Create lagged values of balances and prior period balance
mutate(gca.op = lag(gca),
bal.op = lag(bal),
bal.pr = if_else(date == which.min(date), bal, 0),
ecl.op = lag(ecl),
ctgy.op = lag(ctgy)) %>%
fill(bal.pr) %>%
# Rename closing balance attributes
rename(gca.cl = gca,
bal.cl = bal,
ecl.cl = ecl,
ctgy.cl = ctgy,
wof.cl = wof
) %>%
# Add cumulative movement
mutate(bal.y = bal.cl - bal.pr + cumsum(wof.cl),
bal.y.dd = if_else(bal.y > 0, bal.y, 0),
bal.y.rd = if_else(bal.y < 0, bal.y, 0)) %>%
ungroup()Below we add attributes to our now “wide” data frame. These attributes account for the movements in balances from one month to the next.
For example if a loans balance has decreased, this movement goes into a “repayment” column. Likewise, on the ECL side, a reduction in the ECL balance is inferred from this loan movement based on the ratio of ECL to the loan balance.
This logic treats revolving and non-revolving loans differently.
#=========================================================================================
#== Create movement attributes ==
#=========================================================================================
ifrs9_wide2 <- ifrs9_wide1 %>% group_by(cust) %>%
mutate(cover.cl = -ecl.cl / bal.cl,
cover.op = -ecl.op / bal.op,
cover = Winsorize(round(if_else(is.nan(cover.op),cover.cl, cover.op), 5),
minval = 0, maxval = 1),
incr.decr = case_when(bal.cl > bal.op ~ 'incr',
bal.cl < bal.op ~ 'decr',
TRUE ~ 'unch'),
ctgy.dir = case_when(ctgy.cl > ctgy.op ~ 'D',
ctgy.cl < ctgy.op ~ 'I',
TRUE ~ 'U'),
pre.post = case_when(ctgy.dir == 'I' & incr.decr == 'decr' ~ 'pre',
ctgy.dir == 'D' & incr.decr == 'incr' ~ 'pre',
TRUE ~ 'post'),
pre.stage = if_else(pre.post == 'pre', ctgy.op, ctgy.cl),
gca.m.dd.r = if_else(type == 'rvlv', bal.y.dd - lag(bal.y.dd), 0),
gca.m.dd.t = if_else(type == 'term' & incr.decr == 'incr',
bal.cl - bal.op + wof.cl, 0),
gca.m.rd.t.f = if_else(type == 'term' & incr.decr == 'decr' & bal.cl == 0,
bal.cl - bal.op + wof.cl, 0),
gca.m.rd.t = if_else(type == 'term' & incr.decr == 'decr' & bal.cl != 0,
bal.cl - bal.op + wof.cl, 0),
gca.m.rd.r = if_else(type == 'rvlv', bal.y.rd - lag(bal.y.rd), 0),
gca.m.oth = (gca.cl - bal.cl) - (gca.op - bal.op),
g.tfr.pre = gca.op + gca.m.dd.r + gca.m.dd.t + gca.m.rd.t.f +
gca.m.rd.t + gca.m.rd.r,
gca.m.wof = -wof.cl,
gca.m.tfr.o = -case_when(ctgy.dir != 'U' & pre.post == 'pre' ~ g.tfr.pre,
ctgy.dir != 'U' & pre.post == 'post' ~ gca.op,
TRUE ~ 0),
gca.m.tfr.i = -gca.m.tfr.o,
ecl.m.dd.r = -cover * gca.m.dd.r,
ecl.m.dd.t = -cover * gca.m.dd.t,
ecl.m.rd.t.f = -cover * gca.m.rd.t.f,
ecl.m.rd.t = -cover * gca.m.rd.t,
ecl.m.rd.r = -cover * gca.m.rd.r,
ecl.m.wof = wof.cl,
ecl.m.prm = case_when(ctgy.cl == 1 & pryr != 0 ~ ecl.cl + pryr,
ctgy.cl != 1 & prlt != 0 ~ ecl.cl + prlt,
TRUE ~ 0),
ecl.m.rem.mig= if_else(ctgy.dir != 'U', ecl.cl - ecl.op - ecl.m.dd.r -
ecl.m.dd.t - ecl.m.rd.t.f -
ecl.m.rd.t - ecl.m.rd.r -
ecl.m.wof - ecl.m.prm, 0),
ecl.m.rem = if_else(ctgy.dir == 'U', ecl.cl - ecl.op - ecl.m.dd.r -
ecl.m.dd.t - ecl.m.rd.t.f -
ecl.m.rd.t - ecl.m.rd.r -
ecl.m.wof - ecl.m.prm, 0),
ecl.tfr.pre = ecl.op + ecl.m.dd.r + ecl.m.dd.t +
ecl.m.rd.t.f + ecl.m.rd.t + ecl.m.rd.r,
ecl.m.tfr.o = -case_when(ctgy.dir != 'U' & pre.post == 'pre' ~ ecl.tfr.pre,
ctgy.dir != 'U' & pre.post == 'post' ~ ecl.op,
TRUE ~ 0),
ecl.m.tfr.i = -ecl.m.tfr.o) %>% ungroup() %>%
select(-g.tfr.pre, -ecl.tfr.pre) %>%
# Replace NA's with zero
mutate_at(vars(starts_with("g.")), list(~replace_na(., 0))) %>%
mutate_at(vars(starts_with("i.")), list(~replace_na(., 0))) %>%
# Create balance checks
mutate(gca.ch = gca.op + rowSums(select(., contains("gca."))) - gca.cl,
ecl.ch = ecl.op + rowSums(select(., contains("ecl."))) - ecl.cl)Next, we select the columns required and gather (or should I say unpivot) from a wide to long format.
#=========================================================================================
#== Gather to long table & apply pre / post rules ==
#=========================================================================================
ifrs9_long1 <- ifrs9_wide2 %>%
# Select the columns we are interested in
select(date, cust, ctgy.cl, ctgy.op, pre.post, gca.cl,
ecl.cl, gca.op, ecl.op, gca.m.dd.r:ecl.m.tfr.i) %>%
# Unpivot
gather(key = "m.ment", value = "tran_ccy", gca.cl:ecl.m.tfr.i) %>%
# Arrange and remove nil values
arrange(cust, m.ment, date) %>% filter(tran_ccy != 0) %>%
# Extract the balance type (gca / ecl) from movement type
mutate(bal.type = str_sub(m.ment, 0, 3),
m.type = str_sub(m.ment, 5)) %>%
mutate(ctgy = case_when(m.type == "op" |
m.type == "m.tfr.o" |
m.type == "m.dd.r" & pre.post == "pre" |
m.type == "m.dd.t" & pre.post == "pre" |
m.type == "m.rd.t.f" & pre.post == "pre" |
m.type == "m.rd.t" & pre.post == "pre" |
m.type == "m.rd.r" & pre.post == "pre" ~
ctgy.op,
TRUE ~ ctgy.cl),
m.type = if_else(str_detect(m.type, "tfr"),
paste("tfr", ctgy.op, ctgy.cl, sep = "."),
m.type),
year = year(date),
month = month(date)) %>%
select(date, year, month, cust, ctgy.op, ctgy.cl, ctgy, bal.type, m.type, tran_ccy) %>%
arrange(cust, date, bal.type)
# Save as csv
write.csv(ifrs9_long1, file = "ifrs9_long1.csv")Transformed data
We will present this data in a Tableau public visualisation. In order to do that, I will save the data to google drive. Tableau will then fetch this data for display.
drive_upload(
media = "C:/Users/brent/Documents/R/hugo_website/content/post/ifrs9_long1.csv",
path = p,
name = "ifrs9_long1.csv",
type = "spreadsheet",
overwrite = TRUE
)And here is a link to the end result.