Selama diskusi, muncul tugas "kecil" - membangun dinamika struktur portofolio pinjaman (dinamika kartu kredit, misalnya). Ada kekhususan penting - perlu untuk menerapkan metode FIFO untuk membayar kembali pinjaman. Itu. saat membayar, pinjaman paling awal harus dilunasi terlebih dahulu. Ini memberlakukan persyaratan tertentu dalam menghitung status setiap pinjaman individu dan menentukan tanggal jatuh tempo.
Anggap saja sebagai masalah Olimpiade. Tidak ada " hadiah energi berdarah " dan kode mengayuh, pendekatannya secara eksklusif " berpikir dulu ". Tidak lebih dari satu layar kode per prototipe dan tidak ada loop (disematkan untuk kinerja dan keterbacaan). Di bawah ini adalah kode R dengan pendekatan prototipe.
Ini adalah kelanjutan dari serangkaian publikasi sebelumnya .
Penguraian
Karena kami melakukan semuanya dari awal, kami membagi tugas menjadi tiga langkah:
- Pembentukan data uji.
- Perhitungan tanggal jatuh tempo masing-masing pinjaman.
- Perhitungan dan visualisasi dinamika untuk jendela waktu tertentu.
Asumsi dan ketentuan untuk prototipe:
- Perincian terbaru. Hanya satu transaksi dalam satu tanggal. Jika ada beberapa transaksi dalam satu hari, maka pesanannya perlu dibuat (untuk memenuhi prinsip FIFO). Anda dapat menggunakan add. indeks, Anda dapat menggunakan stempel waktu unix, Anda dapat menemukan sesuatu yang lain. Ini tidak relevan untuk prototipe.
for
Seharusnya tidak ada loop eksplisit apa pun. Seharusnya tidak ada salinan yang tidak perlu. Fokus pada konsumsi memori minimum dan kinerja maksimum.- Kami akan mempertimbangkan grup penundaan berikut: "<0", "0-30", "31-60", "61-90", "90+".
Langkah 1. Menghasilkan dataset
Hanya set data percobaan, semua kecocokan bersifat acak. Untuk setiap pengguna, kami akan menghasilkan ~ 10 catatan. Untuk perhitungan, kami asumsikan pinjaman bernilai positif, pembayaran kembali negatif. Dan seluruh siklus hidup untuk setiap pengguna harus dimulai dengan pinjaman.
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"))
Langkah 2. Hitung tanggal jatuh tempo setiap pinjaman
data.table
memungkinkan Anda untuk mengubah objek dengan referensi bahkan di dalam fungsi, kami akan secara aktif menggunakan ini.
#
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)]
Langkah 3. Perhitungan dinamika struktur untuk periode tersebut
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()
Kita bisa mendapatkan sesuatu seperti ini.
Satu layar kode, sesuai kebutuhan.
Posting sebelumnya - "Laporan R Bercerita vs. BI, Pendekatan Pragmatis . "