Crédito Imobiliário - Métricas de Perda

1 Contexto

Esta documentação detalha a discussão realizada em junho de 2022 a respeito de métricas para estimação de perdas por inadimplência de uma carteira imobiliária. Na ocasião, analistas da XP investimentos desejavam avaliar o risco da carteira de Pró - Soluto da Direcional cedida em março de 2022 por métricas diferentes daquelas reportadas no relatório elaborado pré-operação.

2 Perda Líquida por Safra

Avalia o montante de perda em relação ao total de crédito originado em uma determinada safra (S):

\[PerdaLiquida_{S,c,t} = \dfrac{\sum_{n=t}^{T} VlrParcelaEmAberto(S_c)_n}{\sum_{n=1}^{T} VlrParcela(S)_n} \]

onde \(0 < t < T\) e \(T\) é o número máximo de parcelas da safra \(S\) e \(\sum_{n=t}^{T} VlrParcelaEmAberto(S_c)_n\) envolvem parcelas vencidas não pagas e vincendas (devido ao efeito vagão) em valor nominal, \(c\) é um critério específico de avaliação/seleção do conjunto \(S\) e \(\sum_{n=1}^{T} VlrParcela(S)_n\) signfica o valor nominal das parcelas originadas na data de referência da safra em questão. Caso o denominador não seja fixo no valor de originação da safra, a perda líquida tenderá a 1 quando \(t\) se aproxima de \(T\).

Os critérios \(c\) podem ser:

• Over 30: clientes que estão inadimplentes a mais de 30 dias na data \(t\);
• Over 60: clientes que estão inadimplentes a mais de 60 dias na data \(t\);
• Over 90: clientes que estão inadimplentes a mais de 90 dias na data \(t\);
• Ever 90: clientes que até a data \(t\) já ficaram pelo menos uma vez inadimplentes por 90 dias ou mais;
• Ever 180: clientes que até a data \(t\) já ficaram pelo menos uma vez inadimplentes por 180 dias ou mais;

Nos conceitos “Ever”, uma vez que o devedor entrou na lista, ele não é mais retirado, mesmo que tenha voltado a ficar adimplente.

Como mencionado, esses conceitos foram pensados para avaliar a carteria de março de 2022. Para cálculo do indicador, portanto, usamos a carteira enviada pela cia. antes da operação para calcularmos o valor de originação de cada safra presente na carteira.

library(arrow)
library(data.table)
library(glue)
library(magrittr)
library(zoo)
library(stringr)
library(lubridate)

# Leitura do arquivo -----------------------------------------------------------
dir_etl1 <- "./dat/etl1"
file_name <- "carteira-direcional-21-mar-2022-completa.parquet"

cart <-
  read_parquet(glue("../.{dir_etl1}/{file_name}")) %>%
  setDT %>%
  .[,`:=`(safra = as.yearqtr(data_venda) %>% as.character,
          cpf_cnpj = str_pad(cpf_cnpj,11,"left","0"))]

Error:
! IOError: Failed to open local file '../../dat/etl1/carteira-direcional-21-mar-2022-completa.parquet'. Detail: [errno 2] No such file or directory

# Originação -------------------------------------------------------------------
## Cria vetor de datas de referência -------------------------------------------
datas_ref <-
  data.table(
    datas =
      cart[,data_vencimento] %>%
      (function(x) c(min(x),max(x))) %>%
      (function(dates) seq.Date(from = dates[1],
                                to = dates[2],
                                by = "month")) %>%
      ceiling_date("month")-1) %>%
  .[datas < cart[,max(data_recebimento, na.rm = T)]] %>%
  .[,datas]

Error:
! object 'cart' not found

print(datas_ref)

Error:
! object 'datas_ref' not found

O vetor acima contém o último dia de cada mês em que a carteira cedida tem parcelas a vencer. Mais tarde, usaremos este vetor para montarmos a série temporal que forma o denominador do indicador mencionado acima.

Abaixo, construimos um objeto do tipo lista, em que cada elemento corresponde a uma safra e contém uma tabela com o valor de originação de cada contrato daquela safra:

library(purrr)
library(dplyr)

originacao <-
  cart[data_venda <= max(datas_ref) & codigo_da_empresa != "690",
       .(vlr_parcelas = sum(valor_nominal_das_parcelas),
         cpf_cnpj = unique(cpf_cnpj),
         data_referencia = unique(data_venda),
         safra = unique(safra)),
       by = id_venda] %>%
  .[,data_referencia := ceiling_date(data_referencia,"month")-1] %>%
  group_split(safra) %>%
  map(setDT)

Error:
! object 'cart' not found

# Para facilitar a leitura, mostraremos apenas a estrutura de 3 elementos da lista
str(originacao[1:3])

Error:
! object 'originacao' not found

Mais tarde, realizaremos transformações nesse objeto a fim de criar a estrutura de dados que precisamos, mas por enquanto, vamos criar um objeto temporário para conferir se o comportamento da série de originação é aquele que esperávamos

plot_originacao <-
  originacao %>%
  map(function(x) {x[,.(safra = unique(safra),
                        vlr_parcelas = sum(vlr_parcelas)),
                     by = data_referencia] %>%
      .[order(data_referencia)] %>%
      .[,vlr_parcelas := cumsum(vlr_parcelas)]}) %>%
  map(function(x) {
    x %>%
      rbind(
        data.table(
          data_referencia = datas_ref[datas_ref >= x[,max(data_referencia)]],
          safra = x[,safra] %>% unique,
          vlr_parcelas = x[,vlr_parcelas] %>% max)
      )
  }) %>%
  bind_rows() %>%
  setDT() %>%
  mutate(ano = substr(safra,1,4))

Error:
! object 'originacao' not found

# Carrega função gráfica da Hence e cria função que cria paleta de cores
library(hence.plots)
library(plotly)
colors <- c("#300030","#e28743")
color_function <- colorRampPalette(colors)


hence_line_chart(
  p_dados = plot_originacao,
  p_x = data_referencia,
  p_y = vlr_parcelas,
  p_group = safra,
  p_color = ano,
  p_colors_values = color_function(length(plot_originacao$ano %>% unique)),
  p_xlab = "Mês",
  p_ylab = "Valor acumulado de originação",
  p_title = "Originação por safra") %>%
  ggplotly()

Error:
! object 'plot_originacao' not found

Cada linha representa uma safra, que foi agregada por trimestre, e cada cor representa um ano. Como esperávamos, o valor acumulado de originação é crescente ao longo dos meses que compõem o trimestre e a partir de então, o valor fica travado no valor total de originação da safra.

Agora vamos nos preocupar com o numerador, isto é, com o saldo em aberto de cada safra em cada data de referência segundo cada critério especificado acima. Nesse caso, não usaremos o mesmo arquivo para cálculo do numerador, e sim uma lista de arquivos em que cada arquivo corresponde a um mês e contém todas as parcelas em aberto ao final daquele mês. A opção pelo uso desse arquivo se deu pelo fato de que distorções podem aparecer quando usamos uma base que retrata a situação atual do contas a receber da companhia para estimar a o saldo em aberto em cada mês anterior àquele de extração da base. A existência de renegociações tende a subestimar o saldo em aberto quanto mais distante está a data de referência da data de extração da base. Sendo assim, distorções aparecem tanto no valor absoluto do indicador quanto na sua variação. Recebemos, portanto, 41 arquivos com as parcelas em aberto em cada mês de janeiro de 2019 a maio de 2022.

library(janitor)
carts <-
  list.files(glue("../.{dir_etl1}/parquet/"))

date_cols <- c("dt_venda","dt_vencimento")
carts <-
  paste0(glue("../.{dir_etl1}/parquet/"),carts) %>%
  map(read_parquet) %>%
  map(setDT) %>%
  map(clean_names) %>%
  map(select,-vendas,-clientes,-vencidos) %>%
  map(function(x) {x[,(date_cols) :=
                       lapply(.SD,
                              function(y)(as.Date(as.numeric(y),
                                                  origin = "1899-12-30"))),
                     .SDcols = date_cols]})

Error in `map()`:
ℹ In index: 1.
Caused by error:
! IOError: Failed to open local file '../../dat/etl1/parquet/'. Detail: [errno 2] No such file or directory

str(carts[1:3])

 chr [1:3] NA NA NA

Abaixo criamos outro vetor de datas de referência, que contém o último dia de cada mês entre janeiro de 2019 e maio de 2022, período contemplado pela lista de arquivos.

library(tools)

datas_ref2 <-
  list.files(glue("../.{dir_etl1}/parquet/")) %>%
  map_chr(function(x) x %>% str_remove(file_ext(x))) %>%
  str_remove("\\.") %>%
  map_chr(function(x) paste0(substr(x,1,4),"-",substr(x,5,6),"-01")) %>%
  map(as.Date) %>%
  map(ceiling_date,"month") %>%
  map(function(x) x -1) %>%
  unlist %>%
  as.Date

print(datas_ref2)

Date of length 0

Agora, criamos uma lista em que cada elemento é uma tabela com o número de dias em atraso de cada devedor no final do mês em questão e o saldo em aberto de seus contratos.

carts <-
  carts %>%
  set_names(datas_ref2 %>% as.character)

atraso_saldo <-
  carts %>%
  map(mutate,
      mes_venda = ceiling_date(dt_venda,"month") - 1,
      safra = as.yearqtr(dt_venda)) %>%
  map2(.y = datas_ref2,
       function(carteira,data) {
         list(
           atraso =
             carteira[,.(dias_atraso = as.numeric(data-dt_vencimento) %>% max),
                      by = cpf_cliente],
           saldo_aberto =
             carteira[,.(cpf_cliente = unique(cpf_cliente),
                         mes_venda = unique(mes_venda),
                         safra = unique(safra),
                         vlr_parcelas_em_aberto = sum(a_receber)),
                      by = id_venda])
       }) %>%
  map(reduce,merge,by = "cpf_cliente")

atraso_saldo <-
  atraso_saldo %>%
  map(function(x) {
    x[,`:=`(over30 = ifelse(dias_atraso > 30,1,0),
            over60 = ifelse(dias_atraso > 60,1,0),
            over90 = ifelse(dias_atraso > 90,1,0),
            over180 = ifelse(dias_atraso > 180,1,0),
            over360 = ifelse(dias_atraso > 360,1,0))]
  })

print(atraso_saldo %>% pluck(1))

NULL

De posse dessa lista, criaremos agora uma lista em que cada elemento é uma tabela referente a um id_venda. Nessa tabela, temos todos os meses em que aquele id_venda esteve ativo na base. Cada coluna representa uma dummy indicando se aquele id_venda se encaixa ou não no critério a qual ela se refere em cada mês. Esse objeto foi criado pela natureza dos critérios do tipo “ever”: mesmo que o contrato tenha sido recuperado, seu saldo devedor continua a ser contabilizado para provisão.

serie_temporal_id_venda <-
  atraso_saldo %>%
  map2(.y = datas_ref2,~mutate(.x, data_referencia = .y)) %>%
  bind_rows %>%
  setDT %>%
  .[,`:=`(ever90 = 0,
          ever180 = 0,
          ever360 = 0)] %>%
  group_split(id_venda) %>%
  map(setDT) %>%
  map(function(x) {
    x[data_referencia >= x[over90 == 1, data_referencia] %>% min,
      ever90 := 1] %>%
      .[data_referencia >= x[over180 == 1, data_referencia] %>% min,
        ever180 := 1] %>%
      .[data_referencia >= x[over360 == 1, data_referencia] %>% min,
        ever360 := 1]
  })

Error in `group_by()`:
! Must group by variables found in `.data`.
✖ Column `id_venda` is not found.

print(serie_temporal_id_venda %>% pluck(1))

Error:
! object 'serie_temporal_id_venda' not found

print(serie_temporal_id_venda[1:3] %>% str())

Error:
! object 'serie_temporal_id_venda' not found

Construídas as variáveis dummy, voltaremos com nossa estrutura em cada elemento da lista é uma tabela correspondente a um mês. Além disso, filtramos as bases de originacao e de saldo em aberto para que elas tenham apenas os mesmos contratos.

serie_teporal_dt_ref <-
  serie_temporal_id_venda %>%
  bind_rows %>%
  group_split(data_referencia) %>%
  map(setDT) %>%
  set_names(datas_ref2 %>% as.character)

Error:
! object 'serie_temporal_id_venda' not found

ids_considerados <-
  originacao %>%
  bind_rows() %>%
  pull(id_venda) %>%
  unique() %>%
  intersect(
   serie_teporal_dt_ref %>%
     bind_rows() %>%
  pull(id_venda) %>%
  unique()
  )

Error:
! object 'originacao' not found

originacao <-
  originacao %>%
  map(filter, id_venda %in% ids_considerados) %>%
  bind_rows()

Error:
! object 'originacao' not found

serie_teporal_dt_ref <-
  serie_teporal_dt_ref %>%
  map(filter, id_venda %in% ids_considerados)

Error:
! object 'serie_teporal_dt_ref' not found

Agora sim é possível construir os indicadores de perda líquida.

cols <-
  serie_teporal_dt_ref %>%
  map(names) %>%
  unlist() %>%
  unique() %>%
  purrr::keep(str_detect,"over|ever") %>%
  as.list()

Error:
! object 'serie_teporal_dt_ref' not found

serie_teporal_dt_ref <-
  serie_teporal_dt_ref %>%
  map(mutate, safra = as.character(safra))

Error:
! object 'serie_teporal_dt_ref' not found

perdas_criterio <-
  cols %>%
  map(function(col,dados){
    dados %>%
      map(function(x){
        x[eval(parse(text = paste(col,"==1"))),
          .(vlr_parcelas_em_aberto = sum(vlr_parcelas_em_aberto)),
          by = safra]}) %>%
      map2(.y = datas_ref2,
           ~mutate(.x, data_referencia = .y)) %>%
      map(merge, originacao, by = c("safra","data_referencia")) %>%
      map(mutate, perda = vlr_parcelas_em_aberto/vlr_parcelas)
  },
  dados = serie_teporal_dt_ref) %>% 
  set_names(cols %>% as.character()) %>%
  map(set_names,datas_ref2 %>% as.character())

Error:
! object 'cols' not found

Abaixo, está o gráfico de perda líquida segundo o critério over 180.

(perdas_criterio$over30 %>%
    bind_rows %>%
   mutate(ano = substr(safra,1,4)) %>%
   ggplot(
     aes(x = data_referencia,
         y = perda,
         group = safra,
         color = ano)) +
   geom_line()) %>%
  ggplotly()

Error:
! object 'perdas_criterio' not found

3 Perda Bruta

Avalia o montante de perda em relação ao total de crédito originado em uma determinada safra (S):

\[PerdaBruta_{S,c,t} = \dfrac{\sum_{n=t}^{T} VlrParcelaEmAberto(S_c,p)_n}{\sum_{n=1}^{T} VlrParcela(S)_n} \]

onde \(0 < t < T\) e \(T\) é o número máximo de parcelas da safra \(S\) e \(\sum_{n=t}^{T} VlrParcelaEmAberto(S_c,t)_n\) é o valor de todas as parcelas em aberto no período \(p\), em que \(p\) é o tempo em que o contrato se encaixou no critério \(c\) pela primeira vez. Isto é, o valor das parcelas eventualmente recuperadas após o enquadramento de um contrato em um determinado critério seguem sendo contabilizadas no numerodor. Desta forma a \(PerdaBruta_{S,c,t} \geq PerdaLiquida_{S,c,t}\). \(c\) é um critério específico de avaliação/seleção do conjunto \(S\) e \(\sum_{n=1}^{T} VlrParcela(S)_n\) signfica o valor nominal das parcelas originadas na data de referência da safra em questão. Caso o denominador não seja fixo no valor de originação da safra, a perda bruta tenderá a 1 quando \(t\) se aproxima de \(T\).

Para cálculo da perda bruta, a mesma estrutura de dados será utilizada:

cols <-
  serie_temporal_id_venda %>%
  map(names) %>%
  unlist() %>%
  unique() %>%
  purrr::keep(str_detect,"over|ever") %>%
  as.list()

Error:
! object 'serie_temporal_id_venda' not found

serie_temporal_id_venda_pb <-
  cols %>%
  map(function(col,dados){
    texto <- paste0(col,":=",col,"*vlr_parcelas_em_aberto")
    dados %>%
      map(function(x) {x %>%
    .[,eval(parse(text = texto))]})
  }, dados = serie_temporal_id_venda)

Error:
! object 'cols' not found

serie_temporal_id_venda_pb <-
  serie_temporal_id_venda_pb %>%
  pluck(1)

Error:
! object 'serie_temporal_id_venda_pb' not found

cols <- cols %>% unlist

Error:
! object 'cols' not found

texto <-
  paste0(cols,":=ifelse(",
         cols,
         "==0,0,max(",cols,"))")

Error:
! object 'cols' not found

serie_temporal_id_venda_pb <-
  serie_temporal_id_venda_pb %>%
  map(function(dt){
    texto %>%
      map(function(txt)dt[,eval(parse(text = txt))])
  })

Error:
! object 'serie_temporal_id_venda_pb' not found

serie_temporal_dt_ref_pb <-
  serie_temporal_id_venda_pb %>%
  map(pluck,1) %>%
  bind_rows() %>%
  group_split(data_referencia) %>%
  map(setDT) %>%
  map(filter, id_venda %in% ids_considerados)

Error:
! object 'serie_temporal_id_venda_pb' not found

serie_temporal_dt_ref_pb <-
  serie_temporal_dt_ref_pb %>%
  map(function(x) x[,safra := safra %>% as.character])

Error:
! object 'serie_temporal_dt_ref_pb' not found

cols <- cols %>% as.list

Error:
! object 'cols' not found

perda_bruta <-
  cols %>%
  map(function(col,dados){
    texto <- paste0(col," = sum(",col,",na.rm = T)")
    dados %>%
      map(function(x){
        x[,.(eval(parse(text = texto))),by = safra] %>%
          cbind(x[,.(data_referencia)] %>% unique)}) %>%
      map(merge,originacao,by = c("safra","data_referencia")) %>%
      map(mutate,perda_bruta = V1/vlr_parcelas)
  },
  dados = serie_temporal_dt_ref_pb) %>%
  set_names(cols %>% as.character()) %>%
  map(map,setnames,old = "V1",new = "vlr_parcelas_em_aberto") %>%
  map(set_names,datas_ref2 %>% as.character)

Error:
! object 'cols' not found

Abaixo, está o gráfico de perda bruta segundo o critério over 30.

(perda_bruta$over30 %>%
    bind_rows %>%
    ggplot(aes(x = data_referencia,
               y = perda_bruta,
               group = safra,
               color = substr(safra,1,4))) +
    geom_line()) %>%
  ggplotly()

Error:
! object 'perda_bruta' not found

4 Perda Esperada

Seja \(X_{i,p,t}\) uma variável aleatória que assume valor 1, caso o cliente i esteja inadimplente por um perı́odo p num determinado tempo t e 0, caso contrário.

A Perda Esperada é dada por:

\[EP_t = \dfrac{\sum_{i=1}^{T} P(X_{i,180,t} = 1 | X_{i,p\in A,t} = 1) \times (\sum_{i=t}^{T} VlrParcelaEmAberto_{i,n})}{\sum_{n=1}^{T} VlrParcelaEmAberto_i}\]

onde \(A = {x \in \mathbb{N} | x < 180}\) são os horizontes de tempo avaliados e a probabilidade condicional no numerador é definida como

\[ P(X_{i,180,t} =1 \vert X_{i,p \in A,t}=1)=\frac{\widehat{S(180)}}{\widehat{S(p)}}\]

sendo \(\widehat{S(180)}\) o estimador de Kaplan Meier da função de sobrevivência \(S(p) = P (T_i ≥ p)\), onde \(T_i\) é o tempo máximo de atraso de uma parcela do contrato i.

A elucidação teórica das probabilidades condicionais se encontram no relatório de análise de sobrevivência. Os cálculos, por sua vez, se encontram abaixo.

##### Probabilidade de Recuperação #####
library(survival)
library(survminer)
library(ggfortify)
library(condSURV)
library(tidyr)

retorna_dias_atraso <- function(x){
  dias_atraso <-
    x %>%
    mutate(start_inad = ifelse(
      index == 1, data_vencimento,
      ifelse(data_vencimento < lag(data_recebimento), NA, data_vencimento))
    ) %>%
    fill(start_inad, .direction = "down") %>%
    mutate(start_inad = as_date(start_inad, origin = lubridate::origin)) %>%
    mutate(end_inad = ifelse(is.na(data_recebimento) & index == nrow(.),
                             data_ref,
                             ifelse(data_recebimento < lead(data_vencimento) &
                                      !is.na(data_recebimento),
                                    data_recebimento, NA))) %>%
    mutate(end_inad = (as_date(end_inad, origin = lubridate::origin))) %>%
    select(start_inad,end_inad) %>%
    drop_na(.) %>%
    mutate(dias_inad = as.numeric(end_inad-start_inad)) %>%
    mutate(censura = ifelse(end_inad == data_ref, 0, 1))
  return(dias_atraso)
}

data_ref <- max(cart[,data_recebimento], na.rm = TRUE)

Error:
! object 'cart' not found

cart_inad <-
  cart %>%
  mutate(data_ref = max(data_recebimento, na.rm = TRUE)) %>%
  filter(data_recebimento > data_vencimento |
           (data_vencimento < data_ref & is.na(data_recebimento))) %>%
  select(id_venda,cpf_cnpj,
         uf_empreendimento,categoria_produto,
         valor_venda, data_vencimento,
         data_recebimento, valor_nominal_das_parcelas) %>%
  mutate(dias_atraso =
           ifelse(!is.na(data_recebimento),
                  data_recebimento - data_vencimento,
                  data_ref - data_vencimento)) %>%
  select(id_venda,data_vencimento,data_recebimento,dias_atraso) %>%
  group_by(id_venda) %>%
  arrange(data_vencimento, .by_group = T) %>%
  mutate(index = row_number(id_venda)) %>%
  group_modify(~retorna_dias_atraso(.x))

Error:
! object 'cart' not found

surv_object <- survival::Surv(time = cart_inad$dias_inad,
                              event = cart_inad$censura)

Error:
! object 'cart_inad' not found

f1 <- survival::survfit(surv_object ~ 1,
                        data = cart_inad,
                        type="kaplan-meier")

Error:
! object 'cart_inad' not found

prob_cond <-
  map_dbl(1:179,function(x) f1$surv[180]/f1$surv[x])

Error in `map_dbl()`:
ℹ In index: 1.
Caused by error in `.f()`:
! object 'f1' not found

autoplot(as.ts(prob_cond))

Error:
! object 'prob_cond' not found

tabela_cond_prob <-
  data.table(`dias_atraso` = 1:179,
             `p_condicional` = prob_cond)

Error:
! object 'prob_cond' not found

# datas_ref2 <-
#   list.files("./dat/raw/parquet/") %>%
#   map_chr(function(x) x %>% str_remove(file_ext(x))) %>%
#   str_remove("\\.") %>%
#   map_chr(function(x) paste0(substr(x,1,4),"-",substr(x,5,6),"-01")) %>%
#   map(as.Date) %>%
#   map(ceiling_date,"month") %>%
#   map(function(x) x -1) %>%
#   unlist %>%
#   as.Date
# 
data_ref2 <- datas_ref2 %>% max

valor_atrasado <-
  cart %>%
  mutate(dias_atraso = as.numeric(data_ref2-data_vencimento)) %>%
  filter(dias_atraso %>% between(0,360)) %>%
  merge(tabela_cond_prob, by = "dias_atraso") %>%
  .[,p_condicional := 1-p_condicional] %>%
  .[,.(vlr_parcelas_em_aberto = sum(valor_nominal_das_parcelas),
       p_condicional = 1-prod(p_condicional)),
    by = id_venda]

Error:
! object 'cart' not found

estimativa_perda <-
  sum(valor_atrasado[,vlr_parcelas_em_aberto*p_condicional])/
  sum(cart[id_venda %in% ids_considerados,valor_nominal_das_parcelas])

Error:
! object 'valor_atrasado' not found

print(estimativa_perda)

Error:
! object 'estimativa_perda' not found