Celem projektu jest zbudowanie modelu scoringowego, który pozwoli oszacować prawdopodobieństwo, że klient zaakceptuje przedstawioną mu ofertę kredytu samochodowego. Model ten ma wspierać decyzje podejmowane przez bank, wskazując, które oferty mają największą szansę na pozytywną odpowiedź ze strony klientów. Im wyższy wynik wygenerowany przez model, tym większe powinno być prawdopodobieństwo, że klient skorzysta z oferty. Analiza opiera się na danych historycznych udostępnionych w pliku kredyty_auto_Scoring2025s.xlsx.
Zbiór danych zawiera 40 000 obserwacji dotyczących ofert kredytów samochodowych dostępnych na rynku amerykańskim. Dane obejmują 13 zmiennych opisujących m.in. ocenę ryzyka klienta, parametry finansowe oferty oraz informacje o rodzaju pojazdu. Zmienna, którą będziemy modelować, to ‘akceptacja_klienta’ – wskazuje ona, czy klient zaakceptował ofertę (1) czy nie (0). Pozostałe zmienne zostaną poddane analizie, aby sprawdzić ich przydatność w budowie modelu predykcyjnego.
library(readxl)
df <- read_excel("~/Downloads/kredyty_auto_Scoring2025s.xlsx")
View(df)
Poniżej przedstawiono typy danych oraz krótki opis poszczególnych zmiennych:
LP – numer porządkowy (techniczna),
data_akceptacji – data złożenia wniosku (data),
grupa_ryzyka – ocena ryzyka kredytowego klienta,
kod_partnera – identyfikator partnera (np. dealera),
typ_umowy – typ kredytu: nowy (N), używany (U), refinansowanie (R),
scoring_FICO – punktowa ocena kredytowa,
okres_kredytu – długość kredytowania (w miesiącach),
kwota_kredytu – przyznana kwota kredytu (USD),
oproc_refin – oprocentowanie dla refinansowani,
oproc_konkur – oprocentowanie oferty konkurencji,
koszt_pieniadza – koszt pozyskania kapitału (stała wartość),
oproc_propon – oprocentowanie zaproponowane klientowi,
akceptacja_klienta – zmienna celu: 1 – akceptacja, 0 – odrzucenie.
str(df)
## tibble [40,000 × 13] (S3: tbl_df/tbl/data.frame)
## $ LP : num [1:40000] 1 2 3 4 5 6 7 8 9 10 ...
## $ data_akceptacji : POSIXct[1:40000], format: "2005-04-17" "2005-04-17" ...
## $ grupa_ryzyka : num [1:40000] 2 2 1 1 3 1 1 2 1 3 ...
## $ kod_partnera : num [1:40000] 2 2 3 1 1 3 1 2 1 2 ...
## $ typ_umowy : chr [1:40000] "R" "N" "N" "R" ...
## $ scoring_FICO : num [1:40000] 702 719 802 723 690 681 805 726 765 693 ...
## $ okres_kredytu : num [1:40000] 48 72 60 60 72 60 36 60 60 60 ...
## $ kwota_kredytu : num [1:40000] 26500 35000 28000 20751 20000 ...
## $ oproc_refin : num [1:40000] 0.0399 0 0 0.0675 0 0 0 0.0599 0 0 ...
## $ oproc_konkur : num [1:40000] 0.0499 0.0479 0.0399 0.0499 0.0529 0.0399 0.0405 0.0499 0.0399 0.0399 ...
## $ koszt_pieniadza : num [1:40000] 0.011 0.011 0.011 0.011 0.011 0.011 0.011 0.011 0.011 0.011 ...
## $ oproc_propon : num [1:40000] 0.0659 0.0599 0.0355 0.0489 0.0679 0.0385 0.0389 0.0525 0.0385 0.0609 ...
## $ akceptacja_klienta: num [1:40000] 0 0 0 1 0 0 1 0 0 0 ...
Do wstępnej eksploracji danych wykorzystano funkcję skim() z pakietu skimr, która umożliwia szybki przegląd podstawowych statystyk dla każdej zmiennej. Analiza potwierdza, że zbiór danych jest kompletny – brak jest wartości brakujących we wszystkich kolumnach.
Dla zmiennych liczbowych (m.in. ‘scoring_FICO’, ‘okres_kredytu’, ‘kwota_kredytu’, ‘oproc_propon’) obliczono m.in. średnie, odchylenia standardowe i zakresy wartości. Wszystkie zmienne numeryczne zostały poprawnie rozpoznane i mają pełne pokrycie.
Zmienna ‘typ_umowy’ (kategoryczna) zawiera trzy unikalne wartości (N, U, R) i również nie zawiera braków. Data złożenia wniosku ‘data_akceptacji’ zawiera poprawne znaczniki czasu i obejmuje zakres od 2005-03-2 do 2005-11-12.
#install.packages("skimr")
library(skimr)
skim(df)
| Name | df |
| Number of rows | 40000 |
| Number of columns | 13 |
| _______________________ | |
| Column type frequency: | |
| character | 1 |
| numeric | 11 |
| POSIXct | 1 |
| ________________________ | |
| Group variables | None |
Variable type: character
| skim_variable | n_missing | complete_rate | min | max | empty | n_unique | whitespace |
|---|---|---|---|---|---|---|---|
| typ_umowy | 0 | 1 | 1 | 1 | 0 | 3 | 0 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| LP | 0 | 1 | 20000.50 | 11547.15 | 1.00 | 10000.75 | 20000.50 | 30000.25 | 4.00e+04 | ▇▇▇▇▇ |
| grupa_ryzyka | 0 | 1 | 2.05 | 1.09 | 1.00 | 1.00 | 2.00 | 3.00 | 4.00e+00 | ▇▃▁▅▂ |
| kod_partnera | 0 | 1 | 2.10 | 0.91 | 1.00 | 1.00 | 2.00 | 3.00 | 3.00e+00 | ▆▁▂▁▇ |
| scoring_FICO | 0 | 1 | 720.73 | 46.58 | 601.00 | 684.00 | 717.00 | 755.00 | 8.51e+02 | ▁▇▇▅▁ |
| okres_kredytu | 0 | 1 | 57.19 | 11.39 | 36.00 | 48.00 | 60.00 | 60.00 | 7.20e+01 | ▂▂▁▇▃ |
| kwota_kredytu | 0 | 1 | 24211.65 | 11211.39 | 4526.62 | 15703.59 | 23000.00 | 30906.82 | 1.00e+05 | ▇▆▁▁▁ |
| oproc_refin | 0 | 1 | 0.02 | 0.04 | 0.00 | 0.00 | 0.00 | 0.06 | 2.40e-01 | ▇▂▁▁▁ |
| oproc_konkur | 0 | 1 | 0.05 | 0.01 | 0.03 | 0.04 | 0.05 | 0.05 | 6.00e-02 | ▁▂▇▇▂ |
| koszt_pieniadza | 0 | 1 | 0.01 | 0.00 | 0.01 | 0.01 | 0.01 | 0.02 | 2.00e-02 | ▇▅▅▃▁ |
| oproc_propon | 0 | 1 | 0.07 | 0.02 | 0.03 | 0.05 | 0.06 | 0.08 | 1.10e-01 | ▂▇▆▃▂ |
| akceptacja_klienta | 0 | 1 | 0.26 | 0.44 | 0.00 | 0.00 | 0.00 | 1.00 | 1.00e+00 | ▇▁▁▁▃ |
Variable type: POSIXct
| skim_variable | n_missing | complete_rate | min | max | median | n_unique |
|---|---|---|---|---|---|---|
| data_akceptacji | 0 | 1 | 2005-03-25 | 2005-11-12 | 2005-07-12 | 168 |
Dla wybranych zmiennych liczbowych: ‘scoring_FICO’, ‘kwota_kredytu’ i ‘okres_kredytu’ obliczono podstawowe statystyki opisowe.
‘scoring_FICO’ - wartości mieszczą się w przedziale od 601 do 851 punktów. Mediana wynosi 717, a średnia 720,7 – wskazuje to na względnie symetryczny rozkład.
‘kwota_kredytu’ - przyznane kwoty wahają się od 4 527 do 100 000 USD. Mediana to 23 000 USD, co sugeruje, że połowa kredytów mieści się w zakresie umiarkowanej wartości.
‘okres_kredytu’ - długość finansowania wynosi od 36 do 72 miesięcy. Mediana to równo 60 miesięcy, co może świadczyć o preferencji dla pięcioletnich planów spłaty.
summary(df[, c("scoring_FICO", "kwota_kredytu", "okres_kredytu")])
## scoring_FICO kwota_kredytu okres_kredytu
## Min. :601.0 Min. : 4527 Min. :36.00
## 1st Qu.:684.0 1st Qu.: 15704 1st Qu.:48.00
## Median :717.0 Median : 23000 Median :60.00
## Mean :720.7 Mean : 24212 Mean :57.19
## 3rd Qu.:755.0 3rd Qu.: 30907 3rd Qu.:60.00
## Max. :851.0 Max. :100000 Max. :72.00
Zmienna ‘grupa_ryzyka’, klasyfikująca klientów według poziomu ryzyka kredytowego, przyjmuje cztery różne wartości. Poniżej przedstawiono rozkład liczebności i udział procentowy każdej z kategorii.
Największą grupę stanowią klienci z oceną 1 – około 44% wszystkich przypadków.
Grupy 2 i 3 stanowią odpowiednio około 21% i 22% obserwacji.
Najmniej liczna jest grupa 4, obejmująca około 13% klientów.
#install.packages("dplyr")
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
df %>%
count(grupa_ryzyka) %>%
mutate(pct = n / sum(n))
## # A tibble: 4 × 3
## grupa_ryzyka n pct
## <dbl> <int> <dbl>
## 1 1 17448 0.436
## 2 2 8265 0.207
## 3 3 8977 0.224
## 4 4 5310 0.133
Dla pełności analizy dodatkowo sprawdzono występowanie braków danych w każdej ze zmiennych. Wynik potwierdza, że zbiór jest kompletny — żadna kolumna nie zawiera wartości NA.
sapply(df, function(x) sum(is.na(x)) / nrow(df))
## LP data_akceptacji grupa_ryzyka kod_partnera
## 0 0 0 0
## typ_umowy scoring_FICO okres_kredytu kwota_kredytu
## 0 0 0 0
## oproc_refin oproc_konkur koszt_pieniadza oproc_propon
## 0 0 0 0
## akceptacja_klienta
## 0
Na potrzeby dalszej analizy utworzono trzy nowe zmienne pochodne:
‘delta_oproc’ – różnica między oprocentowaniem zaproponowanym klientowi a kosztem pozyskania kapitału, przybliża marżę banku,
‘spread_konku’ – różnica między ofertą banku a oprocentowaniem konkurencji, pozwala ocenić atrakcyjność oferty na tle rynku,
‘log_kwota’ – logarytm naturalny z kwoty kredytu, stabilizuje rozkład tej zmiennej redukując wpływ dużych wartości odstających.
df <- df %>%
mutate(
delta_oproc = oproc_propon - koszt_pieniadza,
spread_konkur = oproc_propon - oproc_konkur,
log_kwota = log(kwota_kredytu)
)
W celu oceny, które zmienne najlepiej różnicują przypadki akceptacji i odrzucenia oferty, obliczono wskaźnik Information Value (IV) względem zmiennej celu ‘akceptacja_klienta’.
Najlepsze wyniki uzyskały:
‘kwota_kredytu’ i ‘log_kwota’ – IV = 1.52, bardzo silne predyktory,
‘delta_oproc’ (0.74) i ‘spread_konkur’ (0.63) – również wysoko informacyjne,
‘scoring_FICO’ (0.14) – zmienna o umiarkowanej sile predykcyjnej.
Część zmiennych, takich jak ‘data_akceptacji’, ‘koszt_pieniadza’ i ‘LP’, osiągnęła bardzo niskie wartości IV (poniżej 0.05), co wskazuje na ich niską przydatność w kontekście modelowania.
#install.packages("scorecard")
library(scorecard)
# proste IV dla każdej zmiennej (poza y)
info_value <- iv(df, y = "akceptacja_klienta")
info_value <- info_value %>%
mutate(
iv_round = round(info_value, 2),
)
print(info_value)
## variable info_value iv_round
## <char> <num> <num>
## 1: kwota_kredytu 1.521268e+00 1.52
## 2: log_kwota 1.521268e+00 1.52
## 3: delta_oproc 7.403244e-01 0.74
## 4: spread_konkur 6.318959e-01 0.63
## 5: oproc_propon 5.616932e-01 0.56
## 6: typ_umowy 4.037341e-01 0.40
## 7: oproc_konkur 3.744221e-01 0.37
## 8: oproc_refin 3.622533e-01 0.36
## 9: kod_partnera 2.204010e-01 0.22
## 10: grupa_ryzyka 1.754094e-01 0.18
## 11: scoring_FICO 1.358963e-01 0.14
## 12: okres_kredytu 7.022094e-02 0.07
## 13: data_akceptacji 3.879611e-02 0.04
## 14: koszt_pieniadza 2.163878e-02 0.02
## 15: LP 7.757625e-05 0.00
Aby ocenić siłę zależności pomiędzy zmienną kategoryczną ‘grupa_ryzyka’ a zmienną celu’akceptacja_klienta’, obliczono współczynnik Cramér’s V. Wartość wyniosła 0.183, co oznacza słabą ale istotną statystycznie zależność pomiędzy tymi zmiennymi. Dodatkowo obliczono statystyki testów chi-kwadrat, których wartości (Pearson = 1335.4, p < 0.001) potwierdzają, że ‘grupa_ryzyka’ jest istotnie powiązana z akceptacją oferty.
# install.packages("vcd")
library(vcd)
## Loading required package: grid
assocstats(table(df$grupa_ryzyka, df$akceptacja_klienta))
## X^2 df P(> X^2)
## Likelihood Ratio 1337.0 3 0
## Pearson 1335.4 3 0
##
## Phi-Coefficient : NA
## Contingency Coeff.: 0.18
## Cramer's V : 0.183
Na wykresie przedstawiono rozkład wartości scoringu FICO wśród klientów. Histogram pokazuje dość symetryczny rozkład, z większością obserwacji skupionych wokół wartości 700–740. Zakres punktów mieści się w przedziale od okoł 600 do 850, co jest zgodne z typowym zakresem dla tego typu ocen kredytowych.
Taki rozkład potwierdza, że dane są realistyczne, a scoring może być potencjalnie użyteczny w modelu, mimo że jego wartość informacyjna IV była umiarkowana.
#install.packages("ggplot2")
library(ggplot2)
ggplot(df, aes(x = scoring_FICO)) +
geom_histogram(bins = 30) +
labs(title = "Rozkład scoringu FICO")
Boxplot przedstawia rozkład kwoty kredytu w podziale na decyzję klienta ‘akceptacja_klienta’. Widać, że mediana przyznanej kwoty jest wyższa w przypadku zaakceptowanych ofert (wartość 1) niż w przypadku odrzuconych (wartość 0). Dodatkowo, w grupie akceptacji obserwujemy większy rozrzut oraz więcej wartości odstających. Potwierdza to wcześniejsze wnioski, że kwota kredytu ma znaczenie w procesie decyzyjnym i może być silnym predyktorem.
ggplot(df, aes(x = factor(akceptacja_klienta), y = kwota_kredytu)) +
geom_boxplot() +
labs(
x = "Akceptacja klienta",
y = "Kwota kredytu"
)
W celu sprawdzenia współzależności między wybranymi zmiennymi liczbowymi wygenerowano macierz korelacji. Zmienne uwzględnione w analizie to: ‘scoring_FICO’, ‘delta_oproc’, ‘kwota_kredytu’ i ‘okres_kredytu’.
Z wykresu wynika, że:
‘scoring_FICO’ i ‘delta_oproc’ są ujemnie skorelowane, co może oznaczać, że klienci z wyższą oceną kredytową otrzymują niższe marże.
‘kwota_kredytu’ i ‘okres_kredytu’ są ze sobą umiarkowanie dodatnio skorelowane, wyższe kwoty kredytu wiążą się zwykle z dłuższym okresem finansowania.
Pozostałe zależności są raczej słabe.
#install.packages("corrplot")
library(corrplot)
## corrplot 0.95 loaded
num_vars <- df %>%
select(scoring_FICO, kwota_kredytu, okres_kredytu, delta_oproc) %>%
na.omit()
M <- cor(num_vars)
corrplot(M, method = "color", order = "hclust")