Au cours des discussions, une «petite» tâche s'est imposée: construire la dynamique de la structure du portefeuille de prêts (dynamique d'une carte de crédit, par exemple). Il y a une spécificité importante - il est nécessaire d'appliquer la méthode FIFO pour rembourser les prêts. Ceux. lors du remboursement, les premiers prêts doivent être remboursés en premier. Cela impose certaines exigences sur le calcul du statut de chaque prêt individuel et la détermination de sa date d'échéance.

Considérez cela comme un problème olympique. Pas de « prix d'énergie sanglante » et de pédalage de code, l'approche est exclusivement « penser d'abord ». Pas plus d'un écran de code par prototype et pas de boucles (intégré pour les performances et la lisibilité). Vous trouverez ci-dessous le code R avec une approche prototype.

C'est la continuation d'une série de publications précédentes .

Décomposition

Puisque nous faisons tout à partir de zéro, nous divisons la tâche en trois étapes:

1. Formation des données de test.
2. Calcul de la date d'échéance de chaque prêt.
3. Calcul et visualisation de la dynamique pour une fenêtre temporelle donnée.

Hypothèses et dispositions pour le prototype:

1. Granularité à jour. Une seule transaction à une date. S'il y a plusieurs transactions en une journée, alors leur ordre devra être établi (pour se conformer au principe FIFO). Vous pouvez utiliser add. index, vous pouvez utiliser unixtimestamp, vous pouvez trouver autre chose. Cela n'a pas d'importance pour le prototype.
2. Il for
   
   
   
   ne devrait pas y avoir de boucles explicites . Il ne devrait y avoir aucune copie inutile. Concentrez-vous sur une consommation de mémoire minimale et des performances maximales.
3. Nous considérerons les groupes de retards suivants: "<0", "0-30", "31-60", "61-90", "90+".

Étape 1. Génération de l'ensemble de données

Juste un jeu de données de test, toutes les correspondances sont aléatoires. Pour chaque utilisateur, nous générerons ~ 10 enregistrements. Pour les calculs, nous supposons que le prêt est une valeur positive, le remboursement est négatif. Et le cycle de vie complet de chaque utilisateur doit commencer par un prêt.

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"))
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
    

Étape 2. Calculez la date d'échéance de chaque prêt

data.table



vous permet de changer les objets par référence même à l'intérieur des fonctions, nous l'utiliserons activement.

#  
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)]
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
    

Étape 3. Calcul de la dynamique de la structure pour la période

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()
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
    

Nous pouvons obtenir quelque chose comme ça.

Un écran de code, au besoin.

Article précédent - "Storytelling R Report vs BI, A Pragmatic Approach . "