Как стать автором
Обновить

Оценка структуры кредитного портфеля с помощью R

Время на прочтение4 мин
Количество просмотров2.4K

В ходе обсуждений возникла «маленькая» задачка — построить динамику структуры кредитного портфеля (динамика кредитной карты, например). Есть важная специфика — необходимо применять метод FIFO для погашения займов. Т.е. при погашении первыми должны гаситься самые ранние займы. Это накладывает определенные требования на расчет статуса каждого отдельного займа и определения его даты погашения. Задачу решаем честно.


Рассматриваем как олимпиадную задачу. Никаких «кровавых энерпрайзов с корпоративными архитекторами» и педалинга кода, подход исключительно «сначала подумать». Не более одного экрана кода на прототип и никаких циклов (закладные для производительности и читаемости). Ниже приведен код на R с прототипом подхода.


Является продолжением серии предыдущих публикаций.


Декомпозиция


Поскольку мы делаем все с чистого листа, то задачу разбиваем на три шага:


  1. Формирование тестовых данных.
  2. Расчет даты погашения каждого займа.
  3. Расчет и визуализация динамики для заданного временнОго окна.

Допущения и положения для прототипа:


  1. Гранулярность до даты. В одну дату — только одна транзакция. Если в один день будет несколько транзакций, то надо будет их порядок устанавливать (для соблюдения принципа FIFO). Можно использовать доп. индексы, можно использовать unixtimestamp, можно еще что-либо придумывать. Хотя по бизнес-процессам может быть допустима агрегация суточных займов и погашений. В любом случае, для прототипа это вообще несущественно, а конечная логика определяется на этапе внедрения.
  2. Явных циклов for быть не должно. Лишних копирований быть не должно. Фокус на минимальное потребление памяти и максимальную производительность.
  3. Будем рассматривать следующие группы задержек: «< 0», «0-30», «31-60», «61-90», «90+».

Шаг 1. Генерация датасета


Просто тестовый датасет, все совпадения случайны. Для каждого пользователя сформируем ~ по 10 записей. Для расчетов полагаем, что займ — положительное значение, погашение — отрицательное. И весь жизненный цикл для каждого пользователя должен начинаться с займа.


Генерация датасета
library(tidyverse)
library(lubridate)
library(magrittr)
library(tictoc)
library(data.table)

total_users <- 100

events_dt <- tibble(
  date = sample(
    seq.Date(as.Date("2021-01-01"), as.Date("2021-04-30"), by = "1 day"),
    total_users * 10,
    replace = TRUE)
  ) %>%
  # сделаем суммы кратными 50 р.
  mutate(amount = (runif(n(), -2000, 1000)) %/% 50 * 50) %>%
  # нашпигуем идентификаторами пользователей
  mutate(user_id = sample(!!total_users, n(), replace = TRUE)) %>%
  setDT(key = "date") %>%
  # первая запись должна быть займом
  .[.[, .I[1L], by = user_id]$V1, amount := abs(amount)] %>%
  # для простоты оставим только одну операцию в день, 
  # иначе нельзя порядок определить и гранулярность до секунд надо спускать
  # либо вводить порядковый номер займа и погашения
  unique(by = c("user_id", "date"))

Шаг 2. Расчет даты погашения каждого займа


Здесь код самого вычислителя. Никаких SQL, микросервисов, шин, классов и пр. ~6 значимых строк кода, один сервер, несколько секунд вычислений.


N.B. data.table позволяет изменять объекты по ссылке даже внутри функций, будем этим активно пользоваться.


Расчет даты погашения
# инициализируем аккумулятор
accu_dt <- events_dt[amount < 0, .(accu = cumsum(amount), date), by = user_id]

ff <- function(dt){
  # на вход получаем матрицу пользователей и их платежей на заданную дату
  # затягиваем суммы займов
  accu_dt[dt, amount := i.amount, on = "user_id"]
  accu_dt[is.na(amount) == FALSE, accu := accu + amount][accu > 0, accu := NA, by = user_id]
  calc_dt <- accu_dt[!is.na(accu), head(date, 1), by = user_id]

  # нанизываем обратно на входной data.frame, сохраняя порядок следования
  calc_dt[dt, on = "user_id"]$V1
}

repay_dt <- events_dt[amount > 0] %>%
  .[, repayment_date := ff(.SD), by = date] %>%
  .[order(user_id, date)]

Шаг 3. Расчет динамики структуры за период


~8 значимых строк кода вычислителя, один сервер, несколько секунд вычислений.


Расчет динамики
calcDebt <- function(report_date){
  as_tibble(repay_dt) %>%
    # выкидываем все, что уже погашено на дату отчета
    filter(is.na(repayment_date) | repayment_date > !! report_date) %>%
    mutate(delay = as.numeric(!!report_date - date)) %>%
    # размечаем просрочки
    mutate(tag = santoku::chop(delay, breaks = c(0, 31, 61, 90),
                               labels = c("< 0", "0-30", "31-60", "61-90", "90+"),
                               extend = TRUE, drop = FALSE)) %>%
    # делаем сводку
    group_by(tag) %>%
    summarise(amount = sum(amount)) %>%
    mutate_at("tag", as.character)
}

# Устанавливаем окно наблюдения
df <- seq.Date(as.Date("2021-04-01"), as.Date("2021-04-30"), by = "1 day") %>%
  tibble(date = ., tbl = purrr::map(., calcDebt)) %>%
  unnest(tbl)

# строим график
ggplot(df, aes(date, amount, colour = tag)) +
  geom_point(alpha = 0.5, size = 3) +
  geom_line() +
  ggthemes::scale_colour_tableau("Tableau 10") +
  theme_minimal()

Можем получить примерно такую картинку.


Интегрально один экран кода, как и требовалось.


Предыдущая публикация — «Storytelling R отчет против BI, прагматичный подход».

Теги:
Хабы:
+1
Комментарии0

Публикации

Изменить настройки темы

Истории

Работа

Python разработчик
132 вакансии
Data Scientist
60 вакансий

Ближайшие события

Weekend Offer в AliExpress
Дата20 – 21 апреля
Время10:00 – 20:00
Место
Онлайн
Конференция «Я.Железо»
Дата18 мая
Время14:00 – 23:59
Место
МоскваОнлайн