Wczytanie danych

dane <- read.csv("Hipoteczny.csv", header = TRUE)
dane[dane == ""] <- NA
dane <- as.data.frame(dane)
kable(head(dane, 10), caption = "Dane") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed")) %>%
  scroll_box(width = "100%", height = "auto")
Dane
Loan_ID Gender Married Dependents Education Self_Employed ApplicantIncome CoapplicantIncome LoanAmount Loan_Amount_Term Credit_History Property_Area Loan_Status
LP001002 Male No 0 Graduate No 5849 0 NA 360 1 Urban Y
LP001003 Male Yes 1 Graduate No 4583 1508 128 360 1 Rural N
LP001005 Male Yes 0 Graduate Yes 3000 0 66 360 1 Urban Y
LP001006 Male Yes 0 Not Graduate No 2583 2358 120 360 1 Urban Y
LP001008 Male No 0 Graduate No 6000 0 141 360 1 Urban Y
LP001011 Male Yes 2 Graduate Yes 5417 4196 267 360 1 Urban Y
LP001013 Male Yes 0 Not Graduate No 2333 1516 95 360 1 Urban Y
LP001014 Male Yes 3+ Graduate No 3036 2504 158 360 0 Semiurban N
LP001018 Male Yes 2 Graduate No 4006 1526 168 360 1 Urban Y
LP001020 Male Yes 1 Graduate No 12841 10968 349 360 1 Semiurban N

Legenda

Zmienna w tabeli Opis zmiennej
Loan_ID ID aplikanta
Gender Płeć
Married Stan cywilny
Dependents Liczba osób zależnych finansowo
Education Poziom edukacji
Self_Employed Samozatrudnienie
ApplicantIncome Dochody aplikanta
CoapplicantIncome Dochody współaplikanta
LoanAmount Kwota kredytu
Loan_Amount_Term Okres kredytowania
Credit_History Historia kredytowa
Property_Area Położenie obiektu hipoteki
LoanStatus Status kredytu
TotalIncome Dochód całkowity
DebtToIncomeRatio Wskaźnik zadłużenia w stosunku do dochodów

WSTĘP

Autor: Dominika Szymczak

Niniejszy raport jest projektem zaliczeniowym przedmiotu Analiza Danych dla kierunku Analityka Gospodarcza II na Politechnice Gdańskiej. Autorami są: Julia Sowińska, Dominika Szymczak oraz Mikołaj Zalewski.

Celem projektu jest identyfikacja kluczowych czynników wpływających na zatwierdzenie kredytu mieszkaniowego, analiza procesu jego zatwierdzania oraz opracowanie modelu predykcyjnego wspierającego automatyczne podejmowanie decyzji w oparciu o dane klienta.

Otrzymane dane obejmują cechy wnioskodawców, takie jak płeć, poziom edukacji, dochody, historia kredytowa, parametry kredytu oraz inne. Analiza obejmuje eksplorację danych oraz ich wyczyszczenie i przygotowanie do analizy, identyfikację kluczowych zależności i segmentację klientów. Na tej podstawie zostanie zbudowany model predykcyjny usprawniający proces przyznawania kredytów, który minimalizuje ryzyko ich udzielania klientom o niskiej zdolności kredytowej.

PRZYGOTOWANIE DANYCH

1. Identyfikacja brakujących danych

Autor: Dominika Szymczak

Sprawdzenie, które kolumny zawierają brakujące wartości

miss_summary <- tibble(
  Metryka = c("Liczba braków", "Liczba pełnych wartości", "Procent braków"),
  Wartość = c(n_miss(dane), n_complete(dane), pct_miss(dane))
)
kable(miss_summary, col.names = c("Metryka", "Wartość"), caption = "Podsumowanie brakujących wratości") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Podsumowanie brakujących wratości
Metryka Wartość
Liczba braków 149.0000
Liczba pełnych wartości 7833.0000
Procent braków 1.8667
Podsumowanie brakujących wratości
variable n_miss pct_miss
Credit_History 50 8.14
Self_Employed 32 5.21
LoanAmount 22 3.58
Dependents 15 2.44
Loan_Amount_Term 14 2.28
Gender 13 2.12
Married 3 0.489
Loan_ID 0 0
Education 0 0
ApplicantIncome 0 0
CoapplicantIncome 0 0
Property_Area 0 0
Loan_Status 0 0

W tabeli jest 149 pustych rekordów, co stanowi 1,87% wszytskich rekordów. Występują one w kolumnach Historia kredytowa (50), Samozatrudnienie (32), Kwota kredytu (22), Liczba osób zależnych finansowo 15), Czas trwania kredytu (14), Płeć (13) i Stan cywilny (3).

Wyliczenie procentu brakujących danych w każdej kolumnie

kable(miss_case_table(dane), caption = "Podsumowanie liczby brakujących wratości w rekordach") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Podsumowanie liczby brakujących wratości w rekordach
n_miss_in_case n_cases pct_cases
0 480 78.1758958
1 121 19.7068404
2 11 1.7915309
3 2 0.3257329

480 obserwacji (z 614) jest w pełni wypełnionych (brak pustych rekordów). Stanowi to 78,18% wszystkich obserwacji.

Wykonanie wizualizacji braków danych

vis_miss(dane, cluster = TRUE, sort_miss = TRUE) +
  labs(title = "Analiza brakujących danych")

wykres_gr <- scale_fill_gradientn(colors = c("#42cec2", "#306591", "#002185", "#0f225f", "#142c45"))

gg_miss_fct(dane, fct = Self_Employed) +
  labs(title = "Braki danych względem samozatrudnienia",
       x = "Samozatrudnienie", 
       y = "zmienne") +
  wykres_gr +
  theme_minimal()

Braki w Samozatrudnieniu mogą być efektem niepodania informacji przez aplikantów lub nieposiadania formalnego zatrudnienia.

W kwocie kredytu może brakować danych z powodu problemów z wyceną wnioskowanej kwoty w momencie wypełniania wniosku internetowego.

Kolumna Historia kredytowa ma największy odsetek braków w kategorii NA w Samozatrudnieniu. To znaczy, że ten brak danych jest często powiązany z brakiem historii kredytowej.

2. Analiza przyczyn braków

Autor: Julia Sowińska

Analiza przecięć brakujących wartości

gg_miss_upset(dane, nsets = 7,
              sets.bar.color = "#42cec2",
              main.bar.color = "#0f225f")

Wykres potwierdza poprzednie wyniki o dominacji pojedynczych zbiorach braków.

Najwięcej braków danych jest w kolumnie Historia kredytowa i są to braki pojedyncze, to znaczy, że z pośród wszystkich kolumn w 43 wierszach tylko kolumna Historia kredytowa ma NA.

kable(data.frame(
  zmienna = c("Credit_History", "Self_Employment"),
  No = c(89, 500),
  Yes = c(475, 82)),
  caption = "Tabela Historia kredytowa i Samozatrudnienie") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela Historia kredytowa i Samozatrudnienie
zmienna No Yes
Credit_History 89 475
Self_Employment 500 82

Patrząc na rozkład wartości w kolumnie Historia kredytowa oraz na liczbę brakujących wartości, nasuwa się założenie, że wartości brakujące mogą reprezentować kredytobiorców, którzy nie chcieli przyznawać się do braku historii kredytowej lub dla których bank napotkał problemy z pozyskaiem danych.

Podobnie w przypadku braków w kolumnie Samozatrudnienie - mogą one reprezentować kredytobiorców, którzy nie chcieli przyznawać się do samozatrudnienia lub uznali, że nie muszą oni wypełniać tej kolumny.

Tym samym, braki w tych dwóch zmiennych uznane zostają za MNAR (Missing Not at Random).

Braki w kolumnie Kwota kredytu mogą reprezentować klientów, który złożyli wniosek kredytowy bez konkretnej kwoty, zakładając, że kwota zostanie ustalona podczas analizy. Co ciekawe, spośród wierszy charakteryzujących się wartością NA w kolumnie Kwota kredytów równo połowa ma Status kredytu równy Y i połowa równy N.

Braki w kolumnie Czas trwania kredytu sytuacja może wyglądać podobnie - mogą to być klienci, którzy nie wypełnili wartości w kolumnie, zakładając domyślne ustawienia banku. Dlatego braki w kolumnach Kwota kredytu i Czas trwania kredytu również zostają uznane za potencjalne MNAR.

Braki w kolumnie Płeć mogą reprezentować osoby, które nie chciały podawać tej informacji, uznając, że płeć nie powinna mieć wpływu na decyzje kredytową. Braki w kolumnie Liczba osób zależnych finansowo mogą oznaczać świadome pominięcie pytania w obawie przed negatywnym wpływem odpowiedzi na zdolność kredytową lub po prostu z braku obowiązku. Dlatego braki zmiennej Stan cywilny oraz braki zmiennej Płeć zostają uznane za MNAR.

Wracając do wykresu przecięć wartości - kombinacje z małą liczbą braków mogą być przypadkowe i niekoniecznie oznaczają zależności.

Kombinacja między Samozatrudnienie i Historia kredytowa również występuje niewiele razy - 5. Jednak, jako że jest to najczęściej występująca kombinacja, zostanie ona rozważona jako potencjalny związek. Może on być związany z obawą o negatywną ocenę zdolności kredytowej (jako że samozatrudnienie jest bardziej ryzykowne) i tym samym obawą o niższej kwocie kredytu lub wyższym oprocentowaniu. A także z trudnościami w uzyskaniu kredytów w przeszłości, co prowadzi do niekorzystnych danych w historii kredytowej. W takim wypadku, kredytobiorcy celowo nie podawaliby statusu samozatrudnienia i składaliby prośbę o wyższe kwoty kredytu, w nadziei, że bank uzna ich za zatrudnionych na pełen etat bez historii kredytowej.

Analiza relacji brakujących wartości

ggplot(data = dane, aes(x = Credit_History, y = LoanAmount)) +
  geom_point() +
  geom_miss_point() +
  scale_color_manual(values = c("#42cec2","#002185")) +
  theme_minimal() +
  labs(x = "Historia kredytowa", y = "Kwota kredytu") +
  facet_wrap(~Self_Employed, scales = "free")

Można zauważyć, że z pośród kredytobiorców z wartością NA w kolumnie Samozatrudnienie oraz w kolumnie Historia kredytowa, niemalże wszyscy (poza jednym przypadkiem z brakiem danych również w kolumnie Kwota kredytu) mają wartości w kolumnie Kwota kredytu powyżej 150, czyli większe niż w innych grupach.

To może być argumentem za przyjęciem tezy, że osoby, które nie odpowiedziały na pytanie o samozatrudnienie, są samozatrudnione.

3. Uzupełnianie braków danych

Autor: Mikołaj Zalewski

Decyzja o strategii postępowania z brakującymi danymi

Obseracje z brakiem danych w kolumnie Historia kredytowa zastąpimy wartością 0 zgodnie z naszymi wcześniejszymi wnioskami. Obserwacje z brakiem danych w kolumnach Płeć i Stan cywilny zostaną zastąpione wartością “undefined”, czyli po polsku “nieokreślone”. Każdy wniosek o kredyt jest ważny, więc usuwanie obserwacji nie jest dobrym rozwiązaniem. Obserwacje z brakiem danych w kolumnie Liczba osób zależnych finansowo zostaną zastąpione wartością 0. Dla obserwacji z brakiem danych w kolumnie Czas trwania kredytu można przyjąć strategię inputacji wartością, która występuje w znaczącej większości obserwacji, czyli najpopularniejszym czasem, na jaki bierze się kredyt (czyli 360 dni). Obserwacje z brakiem danych w kolumnie Samozatrudnienie zgodnie z naszą wcześniej opisaną tezą zamieniamy na wartość “Yes”, czyli potwierdzającą samozatrudnienie.

Obserwacje z brakiem danych w kolumnie Kwota kredytu uzupełnione będą za pomocą techniki Hot Deck, w której brakująca wartość zastępowana będzie wartością od klienta o najbardziej podobnych cechach.

Przeprowadzenie powyższej strategii

dane$Credit_History[is.na(dane$Credit_History)] <- 0
dane$Gender[is.na(dane$Gender)] <- "Undefined"
dane$Married[is.na(dane$Married)] <- "Undefined"
dane$Dependents[is.na(dane$Dependents)] <- 0
dane$Loan_Amount_Term[is.na(dane$Loan_Amount_Term)] <- 360
dane$Self_Employed[is.na(dane$Self_Employed)] <- "Yes"
dane <- hotdeck(dane, variable = "LoanAmount")
dane <- dane %>% select(-LoanAmount_imp)

Weryfikacja poprawności

n_miss(dane) 
## [1] 0

W zbiorze danych nie występują już żadne puste wartości.

4. Identyfikacja i usunięcie nieprawidłowych wartości

Autor: Dominika Szymczak i Julia Sowińska

Na tym etapie sprawdzić należy, czy nasz zbiór danych zawiera wartości logiczne. Wprowadzone zostają ograniczenia dla zmiennych:

- Dochód aplikanta powinna być większa lub równa 0

- Dochód współaplikanta powinna być większa lub równa 0

- Kwota kredytu powinna być większa od 0

- Okres kredytowania powinna być większa od 0

- Historia kredytowa powinna być 0 lub 1.

Wykrycie i usunięcie/przekształcenie wartości logicznie niepoprawnych (niemożliwych) dla wartości numerycznych

ograniczenia <- editset(c("0 <= ApplicantIncome",
                          "0 <= CoapplicantIncome",
                          "0 < LoanAmount",
                          "0 < Loan_Amount_Term"))

dane$Credit_History <- factor(dane$Credit_History, 
                               levels = c(0, 1), 
                               labels = c("Not existing", "Existing"))

summary(violatedEdits(ograniczenia, dane))
## No violations detected, 0 checks evaluated to NA
## NULL

Dla danych numerycznych wprowadzone zostały ograniczenia:

- dla zmiennej Dochód aplikanta wartości nie mogą być mniejsze niż 0

- dla zmiennej Dochód współaplikanta wartości nie mogą być mniejsze niż 0

- dla zmiennej Wartość kredytu wartości nie mogą być mniejsze lub równe 0

- dla zmiennej Okres kredytowania wartości nie mogą być mniejsze niż 0

Dla rekordów, których wartości nie spełniały ograniczeń przypisane powinny zostać wartości NA. Jednak w tym przypadku, wszystkie wartości zmiennych spełniały założone ograniczenia i nie ma potrzeby przeprowadzenia dalszego przekształacania tych danych.

Wykrycie i usunięcie/przekształcenie wartości logicznie niepoprawnych (niemożliwych) dla wartości tekstowych

dane <- dane %>% mutate(
  Gender = factor(dane$Gender,
                      levels = c("Male", "Female", "Undefined"),
                      labels = c("Male", "Female", "Undefined")),
  Married = factor(dane$Married,
                       levels = c("No", "Yes", "Undefined"),
                       labels = c("No", "Yes", "Undefined")),
  Dependents = factor(dane$Dependents,
                          levels = c("0", "1", "2", "3+"),
                          labels = c("0", "1", "2", "3+")),
  Education = factor(dane$Education,
                         levels = c("Not Graduate", "Graduate"),
                         labels = c("Not Graduate", "Graduate")),
  Self_Employed = factor(dane$Self_Employed,
                             levels = c("No", "Yes"),
                             labels = c("No", "Yes")),
  Loan_Amount_Term = factor(dane$Loan_Amount_Term,
                           levels = c("12", "36", "60", "84", "120", "180", "240", "300", "360", "480"),
                           labels = c("1", "3", "5", "7", "10", "15", "20", "25", "30", "40")),
  Property_Area = factor(dane$Property_Area,
                             levels = c("Rural", "Semiurban", "Urban"),
                             labels = c("Rural", "Semiurban", "Urban")),
  Loan_Status = factor(dane$Loan_Status,
                           levels = c("N", "Y"),
                           labels = c("No", "Yes")))

kable(table(dane$Gender), caption = "Tabela częstości płci", col.names = c("Kategoria", "Częstość")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela częstości płci
Kategoria Częstość
Male 489
Female 112
Undefined 13 
kable(table(dane$Married), caption = "Tabela częstości stanu cywilnego", col.names = c("Kategoria", "Częstość")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela częstości stanu cywilnego
Kategoria Częstość
No 213
Yes 398
Undefined 3 
kable(table(dane$Dependents), caption = "Tabela częstości liczby osób zależnych finansowo", col.names = c("Kategoria", "Częstość")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela częstości liczby osób zależnych finansowo
Kategoria Częstość
0 360
1 102
2 101
3+ 51 
kable(table(dane$Education), caption = "Tabela częstości poziomu edukacji", col.names = c("Kategoria", "Częstość")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela częstości poziomu edukacji
Kategoria Częstość
Not Graduate 134
Graduate 480 
kable(table(dane$Self_Employed), caption = "Tabela częstości samozatrudnienia", col.names = c("Kategoria", "Częstość")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela częstości samozatrudnienia
Kategoria Częstość
No 500
Yes 114 
kable(table(dane$Loan_Amount_Term), caption = "Tabela częstości okresu kredytowania", col.names = c("Kategoria", "Częstość")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela częstości okresu kredytowania
Kategoria Częstość
1 1
3 2
5 2
7 4
10 3
15 44
20 4
25 13
30 526
40 15 
kable(table(dane$Property_Area), caption = "Tabela częstości położenia obiektu hipoteki", col.names = c("Kategoria", "Częstość")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela częstości położenia obiektu hipoteki
Kategoria Częstość
Rural 179
Semiurban 233
Urban 202 
kable(table(dane$Loan_Status), caption = "Tabela częstości statusu kredytu", col.names = c("Kategoria", "Częstość")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela częstości statusu kredytu
Kategoria Częstość
No 192
Yes 422

Dla danych tekstowych, tak jak dla danych numerycznych nie znaleziono żadnych odstających od założeń wartości i nie ma potrzeby przeprowadzenia dalszego przekształacania tych danych.

Sprawdzenie rozkładów zmiennych i ich statystyki opisowe

plot_variables <- list(
  "Gender" = "Rozkład Gender",
  "Married" = "Rozkład Married",
  "Dependents" = "Rozkład Dependents",
  "Education" = "Rozkład Education",
  "Self_Employed" = "Rozkład Self_Employed",
  "Loan_Amount_Term" = "Rozkład Loan_Amount_Term",
  "Credit_History" = "Rozkład Credit_History",
  "Property_Area" = "Rozkład Property_Area",
  "Loan_Status" = "Rozkład Loan_Status"
)

plot_list <- lapply(names(plot_variables), function(var) {
  ggplot(dane, aes_string(x = var)) +
    geom_bar(fill = "#306591") +
    labs(title = plot_variables[[var]], x = var, y = "Liczność")
})

num_plot_vars <- c("ApplicantIncome", "CoapplicantIncome", "LoanAmount")
num_plot_list <- lapply(num_plot_vars, function(var) {
  ggplot(dane, aes_string(x = var)) +
    geom_histogram(fill = "#306591", color = "#0f225f", bins = 30) +
    labs(title = paste("Rozkład", var), x = var, y = "Częstotliwość")
})

combined_plots <- c(plot_list, num_plot_list) %>%
  do.call(cowplot::plot_grid, .)

plot_grid(
  ggdraw() + draw_label("Rozkłady zmiennych", fontface = "bold", size = 14, hjust = 0.5),
  combined_plots,
  ncol = 1,
  rel_heights = c(0.1, 1))

W zmiennej Płeć dominującą kategorią są mężczyźni (489 przypadków), natomiast kobiet jest 112, a w 13 przypadkach płeć nie została określona. W odniesieniu do zmiennej Stan cywilny, większość osób to osoby w związku małżeńskim (398), podczas gdy niezamężnych jest 213, a 3 przypadki pozostają niezdefiniowane.

Zmienna Liczba osób zależnych finansowo wskazuje, że najwięcej respondentów (360) nie posiada osób na utrzymaniu, 102 osoby deklarują jedną osobę na utrzymaniu, 101 osób dwie, a 51 osób trzy lub więcej. W odniesieniu do zmiennej Poziom edukacji, większość osób posiada wykształcenie wyższe (480), a 134 osoby mają niższy poziom wykształcenia.

W przypadku zmiennej Samozatrudneinie, 500 osób zadeklarowało, że nie prowadzi działalności gospodarczej, a 114 osób to osoby samozatrudnione. Zmienna Dochód aplikanta, opisująca dochód głównego wnioskodawcy, wskazuje na wartości od 150 do 81 000, przy czym mediana wynosi 3812, a średnia 5403, co wskazuje na obecność wartości odstających. Dochód współaplikanta jest w wielu przypadkach równy 0 (25. percentyl to 0), co oznacza, że wiele osób nie posiada współwnioskodawcy. Mediana wynosi 1188, średnia to 1621, a maksymalna wartość wynosi 41 667.

Zmienna Kwota kredytu, określająca kwotę pożyczki, ma wartości od 9 do 700, przy medianie 128 i średniej 145,8, co również sugeruje obecność wartości odstających. Okres kredytowania, opisujący czas spłaty pożyczki w miesiącach, waha się od 12 do 480 miesięcy, z medianą 360 miesięcy (30 lat).

Historia kredytowa wskazuje, że większość wnioskodawców (około 77,4%) posiada pozytywną historię kredytową (wartość 1). Rozkład zmiennej Położenie obiektu hipoteki pokazuje, że 179 obiektów znajduje się na terenach wiejskich, 233 w obszarach półmiejskich, a 202 w miastach. Zmienna Status kredytu, opisująca status wniosku o pożyczkę, wskazuje, że większość wniosków (422) została zatwierdzona, a 192 odrzucono.

Wykrycie i usunięcie/przekształcenie wartości odstających

z_score <- function(x) {
  (x - mean(x, na.rm = TRUE)) / sd(x, na.rm = TRUE)
}

dane_outliers <- dane %>%
  mutate(
    z_score_ApplicantIncome = z_score(ApplicantIncome),
    z_score_CoapplicantIncome = z_score(CoapplicantIncome),
    z_score_LoanAmount = z_score(LoanAmount),
  )

z_outliers_ApplicantIncome <- dane_outliers[dane_outliers$z_score_ApplicantIncome > 3 | dane_outliers$z_score_ApplicantIncome < -3, ]
z_outliers_CoapplicantIncome <- dane_outliers[dane_outliers$z_score_CoapplicantIncome > 3 | dane_outliers$z_score_CoapplicantIncome < -3, ]
z_outliers_LoanAmount <- dane_outliers[dane_outliers$z_score_LoanAmount > 3 | dane_outliers$z_score_LoanAmount < -3, ]

outliers <- function(df, col) {
  Q1 <- quantile(df[[col]], 0.25, na.rm = TRUE)
  Q3 <- quantile(df[[col]], 0.75, na.rm = TRUE)
  IQR <- Q3 - Q1
  bottom <- Q1 - 1.5 * IQR
  top <- Q3 + 1.5 * IQR
  df2 <- df %>%
    filter(df[[col]] < bottom | df[[col]] > top)
  return(df2)
}

iqr_outliers_ApplicantIncome <- outliers(dane_outliers, "ApplicantIncome")
iqr_outliers_CoapplicantIncome <- outliers(dane_outliers, "CoapplicantIncome")
iqr_outliers_LoanAmount <- outliers(dane_outliers, "LoanAmount")

common_outliers_ApplicantIncome <- inner_join(
  z_outliers_ApplicantIncome, iqr_outliers_ApplicantIncome)
common_outliers_CoapplicantIncome <- inner_join(
  z_outliers_CoapplicantIncome, iqr_outliers_CoapplicantIncome)
common_outliers_LoanAmount <- inner_join(
  z_outliers_LoanAmount, iqr_outliers_LoanAmount)

kable(common_outliers_ApplicantIncome, caption = "Wartości odstające dochodów aplikantów") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed")) %>%
  scroll_box(width = "100%", height = "auto")
Wartości odstające dochodów aplikantów
Loan_ID Gender Married Dependents Education Self_Employed ApplicantIncome CoapplicantIncome LoanAmount Loan_Amount_Term Credit_History Property_Area Loan_Status z_score_ApplicantIncome z_score_CoapplicantIncome z_score_LoanAmount
LP001448 Undefined Yes 3+ Graduate No 23803 0 370 30 Existing Rural Yes 3.011854 -0.5540356 2.5972058
LP001536 Male Yes 3+ Graduate No 39999 0 600 15 Not existing Semiurban Yes 5.663006 -0.5540356 5.2690109
LP001585 Undefined Yes 3+ Graduate No 51763 0 700 25 Existing Urban Yes 7.588677 -0.5540356 6.4306654
LP001637 Male Yes 1 Graduate No 33846 0 260 30 Existing Semiurban No 4.655811 -0.5540356 1.3193859
LP001640 Male Yes 0 Graduate Yes 39147 4750 120 30 Existing Semiurban Yes 5.523541 1.0692032 -0.3069303
LP002101 Male Yes 0 Graduate Yes 63337 0 490 15 Existing Urban Yes 9.483245 -0.5540356 3.9911911
LP002317 Male Yes 3+ Graduate No 81000 0 360 30 Not existing Rural No 12.374534 -0.5540356 2.4810403
LP002422 Male No 1 Graduate No 37719 0 152 30 Existing Semiurban Yes 5.289789 -0.5540356 0.0647991 
kable(common_outliers_CoapplicantIncome, caption = "Wartości odstające dochodów współaplikantów") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed")) %>%
  scroll_box(width = "100%", height = "auto")
Wartości odstające dochodów współaplikantów
Loan_ID Gender Married Dependents Education Self_Employed ApplicantIncome CoapplicantIncome LoanAmount Loan_Amount_Term Credit_History Property_Area Loan_Status z_score_ApplicantIncome z_score_CoapplicantIncome z_score_LoanAmount
LP001020 Male Yes 1 Graduate No 12841 10968 349 30 Existing Semiurban No 1.2174644 3.194108 2.3532583
LP001610 Male Yes 3+ Graduate No 5516 11300 495 30 Not existing Semiurban No 0.0184220 3.307564 4.0492738
LP002297 Male No 0 Graduate No 2500 20000 103 30 Existing Semiurban Yes -0.4752725 6.280654 -0.5044115
LP002342 Male Yes 2 Graduate Yes 1600 20000 239 30 Existing Urban No -0.6225951 6.280654 1.0754385
LP002893 Male No 0 Graduate No 1836 33837 90 30 Existing Urban No -0.5839638 11.009234 -0.6554266
LP002949 Female No 3+ Graduate Yes 416 41667 350 15 Not existing Urban No -0.8164062 13.685016 2.3648749 
kable(common_outliers_LoanAmount, caption = "Wartości odstające kwot kredytów") %>%

kable_styling(bootstrap_options = c("striped", "hover", "condensed")) %>%
  scroll_box(width = "100%", height = "auto")
Wartości odstające kwot kredytów
Loan_ID Gender Married Dependents Education Self_Employed ApplicantIncome CoapplicantIncome LoanAmount Loan_Amount_Term Credit_History Property_Area Loan_Status z_score_ApplicantIncome z_score_CoapplicantIncome z_score_LoanAmount
LP001449 Male No 0 Graduate No 3865 1640 490 30 Existing Rural Yes -0.2518332 0.0064090 3.991191
LP001469 Male No 0 Graduate Yes 20166 0 650 40 Not existing Urban Yes 2.4165068 -0.5540356 5.849838
LP001536 Male Yes 3+ Graduate No 39999 0 600 15 Not existing Semiurban Yes 5.6630062 -0.5540356 5.269011
LP001585 Undefined Yes 3+ Graduate No 51763 0 700 25 Existing Urban Yes 7.5886765 -0.5540356 6.430665
LP001610 Male Yes 3+ Graduate No 5516 11300 495 30 Not existing Semiurban No 0.0184220 3.3075642 4.049274
LP001907 Male Yes 0 Graduate No 14583 0 436 30 Existing Semiurban Yes 1.5026155 -0.5540356 3.363898
LP001996 Male No 0 Graduate No 20233 0 480 30 Existing Rural No 2.4274741 -0.5540356 3.875026
LP002101 Male Yes 0 Graduate Yes 63337 0 490 15 Existing Urban Yes 9.4832453 -0.5540356 3.991191
LP002191 Male Yes 0 Graduate No 19730 5266 570 30 Existing Rural No 2.3451372 1.2455382 4.920515
LP002386 Male No 0 Graduate Yes 12876 0 405 30 Existing Semiurban Yes 1.2231936 -0.5540356 3.003785
LP002547 Male Yes 1 Graduate No 18333 0 500 30 Existing Urban No 2.1164597 -0.5540356 4.107356
LP002624 Male Yes 0 Graduate No 20833 6667 480 30 Not existing Urban Yes 2.5256892 1.7243082 3.875026
LP002693 Male Yes 2 Graduate Yes 7948 7166 480 30 Existing Rural Yes 0.4165204 1.8948338 3.875026
LP002813 Female Yes 1 Graduate Yes 19484 0 600 30 Existing Semiurban Yes 2.3048690 -0.5540356 5.269011
LP002959 Female Yes 1 Graduate No 12000 0 496 30 Existing Semiurban Yes 1.0797996 -0.5540356 4.060890

W celu wykrycia wartości odstających posłużono się kombinacją dwóch metod - metody Z-score (gdzie wartość jest odstająca, jeśli jej odległość od średniej w jednostkach odchylenia standardowego jest większa niż 3 lub mniejsza niż -3) oraz metoda IQR (gdzie wartość jest odstająca, jeśli znajduje się poniżej dolnej granicY Q1−1.5×IQR lub powyżej górnej granicy Q3+1.5×IQR). Aby porównać wyniki obu metod, wybraliśmy te wiersze, które zostały uznane za wartości odstające zarówno przez metodę Z-score, jak i przez metodę IQR.

W ten sposób doszliśmy do wniosków:

- zmienna Dochód aplikanta ma 8 wartości odstających, które jednak reprezentują sobą osoby o bardzo wysokich dochodach (które mogłyby być wartościowymi kredytobiorcami) - dlatego postanowiliśmy pozostawić te wartości bez zmian;

- zmienna Dochód współaplikanta ma 6 wartości odstających, które reprezentują sobą osoby, których współkredytobiorca ma wysokie dochody (dochody te jednak mieszczą się w większości w średniej wartości zmiennej Dochód aplikanta) - dlatego te wartości też postanowiliśmy pozostawić bez zmian;

- zmienna Kwota kredytu ma 15 wartości odstających, które jednak reprezentują sobą osoby składające wnioski o najwyższe kwoty kredytu (które różnież mogłyby być wartościowymi klientami firmy) - dlatego te wartości także postanowiliśmy pozostawić bez zmian.

Niezbędne przekształcenia log-transform

dane <- dane %>%
  mutate(
    log_ApplicantIncome = log1p(ApplicantIncome),
    log_CoapplicantIncome = log1p(CoapplicantIncome),
    log_LoanAmount = log1p(LoanAmount),
  )
log_plot_vars <- c("log_ApplicantIncome", "log_CoapplicantIncome", "log_LoanAmount")
log_plot_list <- lapply(log_plot_vars, function(var) {
  ggplot(dane, aes_string(x = var)) +
    geom_histogram(fill = "#306591", color = "#0f225f", bins = 30) +
    labs(title = paste("Rozkład", var), x = var, y = "Częstotliwość")
})

combined_plots <- log_plot_list %>%
  do.call(cowplot::plot_grid, .)
combined_plots

Ze względu na dużą skośność w rozkładach zmiennych Dochód aplikanta, Dochód współaplikanta i Kwota kredytu postanowiono wprowadzić także zmienne reprezentujące ich log-transformację. Ze względu na możliwe zera w tych kolumnach, zdecydowaliśmy się na funkcję log1p() zamiast log() (log(0) jest niezdefiniowane). Na wykresach przedstawiających rozkłady tych zlogarytmowanych zmiennych, można zauważyć, że po transformacji rozkłady te zbliżyły się zdecydowanie do rozkładu normalnego. Jedynie w przypadku zmiennej log_CoapplicantIncome (zlogarytmowany Dochód współaplikanta) można nadal zauważyć dość dużą skośność, spowodowaną dużą liczbą ludzi składających wniosek o kredyt samodzielnie, lub wraz z współkredytobiorcą bez dochodów.

5. Wzbogacenie danych i finalna weryfikacja

Autor: Mikołaj Zalewski

Dodanie nowych zmiennych i sprawdzenie ich rozkładów oraz statystyk opisowych

Stworzenie zmiennej łączny przychód gospodarstwa domowego ubiegającego się o kredyt

dane$TotalIncome <- dane$ApplicantIncome + dane$CoapplicantIncome
kable(head(dane), caption = "Nowostworzona zmienna dochodu całkowitego") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed")) %>%
  scroll_box(width = "100%", height = "auto")
Nowostworzona zmienna dochodu całkowitego
Loan_ID Gender Married Dependents Education Self_Employed ApplicantIncome CoapplicantIncome LoanAmount Loan_Amount_Term Credit_History Property_Area Loan_Status log_ApplicantIncome log_CoapplicantIncome log_LoanAmount TotalIncome
LP001002 Male No 0 Graduate No 5849 0 108 30 Existing Urban Yes 8.674197 0.000000 4.691348 5849
LP001003 Male Yes 1 Graduate No 4583 1508 128 30 Existing Rural No 8.430327 7.319203 4.859812 6091
LP001005 Male Yes 0 Graduate Yes 3000 0 66 30 Existing Urban Yes 8.006701 0.000000 4.204693 3000
LP001006 Male Yes 0 Not Graduate No 2583 2358 120 30 Existing Urban Yes 7.857094 7.765993 4.795790 4941
LP001008 Male No 0 Graduate No 6000 0 141 30 Existing Urban Yes 8.699681 0.000000 4.955827 6000
LP001011 Male Yes 2 Graduate Yes 5417 4196 267 30 Existing Urban Yes 8.597482 8.342125 5.590987 9613

Stworzenie zmiennej stosunek długu do łącznych przychdów gospodarstwa domowego

dane$DebtToIncomeRatio <-dane$LoanAmount / dane$TotalIncome
kable(head(dane), caption = "Nowostworzona zmienna wskaźnika zadłużenia w stosunku do dochodu całkowitego") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed")) %>%
  scroll_box(width = "100%", height = "auto")
Nowostworzona zmienna wskaźnika zadłużenia w stosunku do dochodu całkowitego
Loan_ID Gender Married Dependents Education Self_Employed ApplicantIncome CoapplicantIncome LoanAmount Loan_Amount_Term Credit_History Property_Area Loan_Status log_ApplicantIncome log_CoapplicantIncome log_LoanAmount TotalIncome DebtToIncomeRatio
LP001002 Male No 0 Graduate No 5849 0 108 30 Existing Urban Yes 8.674197 0.000000 4.691348 5849 0.0184647
LP001003 Male Yes 1 Graduate No 4583 1508 128 30 Existing Rural No 8.430327 7.319203 4.859812 6091 0.0210146
LP001005 Male Yes 0 Graduate Yes 3000 0 66 30 Existing Urban Yes 8.006701 0.000000 4.204693 3000 0.0220000
LP001006 Male Yes 0 Not Graduate No 2583 2358 120 30 Existing Urban Yes 7.857094 7.765993 4.795790 4941 0.0242866
LP001008 Male No 0 Graduate No 6000 0 141 30 Existing Urban Yes 8.699681 0.000000 4.955827 6000 0.0235000
LP001011 Male Yes 2 Graduate Yes 5417 4196 267 30 Existing Urban Yes 8.597482 8.342125 5.590987 9613 0.0277749

Analiza warości odstających oraz potencjalnej konieczności log-transform nowych zmiennych

z_score <- function(x) {
  (x - mean(x, na.rm = TRUE)) / sd(x, na.rm = TRUE)
}
dane_outliers <- dane %>%
  mutate(
    z_score_TotalIncome = z_score(TotalIncome),
    z_score_DebtToIncomeRatio = z_score(DebtToIncomeRatio),
  )
z_outliers_TotalIncome <- dane_outliers[dane_outliers$z_score_TotalIncome > 3 | dane_outliers$z_score_TotalIncome < -3, ]
z_outliers_DebtToIncomeRatio <- dane_outliers[dane_outliers$z_score_DebtToIncomeRatio > 3 | dane_outliers$z_score_DebtToIncomeRatio < -3, ]

outliers <- function(df, col) {
  Q1 <- quantile(df[[col]], 0.25, na.rm = TRUE)
  Q3 <- quantile(df[[col]], 0.75, na.rm = TRUE)
  IQR <- Q3 - Q1
  bottom <- Q1 - 1.5 * IQR
  top <- Q3 + 1.5 * IQR
  df2 <- df %>%
    filter(df[[col]] < bottom | df[[col]] > top)
  return(df2)
}
iqr_outliers_TotalIncome <- outliers(dane_outliers, "TotalIncome")
iqr_outliers_DebtToIncomeRatio <- outliers(dane_outliers, "DebtToIncomeRatio")

common_outliers_TotalIncome <- intersect(
  z_outliers_TotalIncome, iqr_outliers_TotalIncome)
common_outliers_DebtToIncomeRatio <- intersect(
  z_outliers_DebtToIncomeRatio, iqr_outliers_DebtToIncomeRatio)

kable(common_outliers_TotalIncome, caption = "Wartości odstające dochodu całkowitego") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed")) %>%
  scroll_box(width = "100%", height = "auto")
Wartości odstające dochodu całkowitego
Loan_ID Gender Married Dependents Education Self_Employed ApplicantIncome CoapplicantIncome LoanAmount Loan_Amount_Term Credit_History Property_Area Loan_Status log_ApplicantIncome log_CoapplicantIncome log_LoanAmount TotalIncome DebtToIncomeRatio z_score_TotalIncome z_score_DebtToIncomeRatio
LP001536 Male Yes 3+ Graduate No 39999 0 600 15 Not existing Semiurban Yes 10.596635 0.000000 6.398595 39999 0.0150004 5.105436 -0.9899162
LP001585 Undefined Yes 3+ Graduate No 51763 0 700 25 Existing Urban Yes 10.854450 0.000000 6.552508 51763 0.0135232 6.926865 -1.1536874
LP001637 Male Yes 1 Graduate No 33846 0 260 30 Existing Semiurban No 10.429606 0.000000 5.564520 33846 0.0076819 4.152762 -1.8012896
LP001640 Male Yes 0 Graduate Yes 39147 4750 120 30 Existing Semiurban Yes 10.575105 8.466110 4.795790 43897 0.0027337 5.708966 -2.3498734
LP002101 Male Yes 0 Graduate Yes 63337 0 490 15 Existing Urban Yes 11.056241 0.000000 6.196444 63337 0.0077364 8.718877 -1.7952429
LP002317 Male Yes 3+ Graduate No 81000 0 360 30 Not existing Rural No 11.302217 0.000000 5.888878 81000 0.0044444 11.453653 -2.1602073
LP002422 Male No 1 Graduate No 37719 0 152 30 Existing Semiurban Yes 10.537946 0.000000 5.030438 37719 0.0040298 4.752422 -2.2061773
LP002624 Male Yes 0 Graduate No 20833 6667 480 30 Not existing Urban Yes 9.944342 8.805075 6.175867 27500 0.0174545 3.170206 -0.7178328
LP002893 Male No 0 Graduate No 1836 33837 90 30 Existing Urban No 7.515889 10.429340 4.510859 35673 0.0025229 4.435638 -2.3732390
LP002949 Female No 3+ Graduate Yes 416 41667 350 15 Not existing Urban No 6.033086 10.637489 5.860786 42083 0.0083169 5.428103 -1.7308850 
kable(common_outliers_DebtToIncomeRatio, caption = "Wartości odstające wskaźnika zadłużenia w stosunku do dochodu") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed")) %>%
  scroll_box(width = "100%", height = "auto")
Wartości odstające wskaźnika zadłużenia w stosunku do dochodu
Loan_ID Gender Married Dependents Education Self_Employed ApplicantIncome CoapplicantIncome LoanAmount Loan_Amount_Term Credit_History Property_Area Loan_Status log_ApplicantIncome log_CoapplicantIncome log_LoanAmount TotalIncome DebtToIncomeRatio z_score_TotalIncome z_score_DebtToIncomeRatio
LP001267 Female Yes 2 Graduate No 1378 1881 167 30 Existing Urban No 7.229114 7.540090 5.123964 3259 0.0512427 -0.5830471 3.028118
LP001449 Male No 0 Graduate No 3865 1640 490 30 Existing Rural Yes 8.259976 7.403061 6.196444 5505 0.0890100 -0.2352971 7.215215
LP001722 Male Yes 0 Graduate No 150 1800 135 30 Existing Rural No 5.017280 7.496097 4.912655 1950 0.0692308 -0.7857206 5.022377
LP001751 Male Yes 0 Graduate No 3250 0 170 30 Existing Rural No 8.086718 0.000000 5.141664 3250 0.0523077 -0.5844406 3.146187
LP001846 Female No 3+ Graduate No 3083 0 255 30 Existing Rural Yes 8.033983 0.000000 5.545177 3083 0.0827116 -0.6102973 6.516944
LP001990 Male No 0 Not Graduate No 2000 0 128 30 Existing Urban No 7.601402 0.000000 4.859812 2000 0.0640000 -0.7779790 4.442464
LP002341 Female No 1 Graduate No 2600 0 160 30 Existing Urban No 7.863651 0.000000 5.081404 2600 0.0615385 -0.6850806 4.169563
LP002778 Male Yes 2 Graduate Yes 6633 0 350 30 Not existing Rural No 8.799963 0.000000 5.860786 6633 0.0527665 -0.0606480 3.197050

Zmienna Dochód całkowity ma 10 wartości odstających, jednakże tak samo jak w przypadku zmiennych Dochód aplikanta oraz Dochód współaplikanta, są to osoby z wysokimi zarobkami więc postanwoiliśmy zostawić je bez zmian.

Zmienna Wskaźnik zadłużenia w stosunku do dochodu ma 8 wartości odstających, które jednak także zdecydowano pozostawić bez zmian ze względu na obawę utraty cennych informacji dotyczących podejmowania decyzji o przyznaniu kredytu.

Przekształcenie danych log transform

dane <- dane %>%
  mutate(
    log_TotalIncome = log1p(TotalIncome),
    log_DebtToIncomeRatio = log1p(DebtToIncomeRatio),
  )

log_plot_vars <- c("TotalIncome", "DebtToIncomeRatio")
log_plot_list <- lapply(log_plot_vars, function(var) {
  ggplot(dane, aes_string(x = var)) +
    geom_histogram(fill = "#306591", color = "#0f225f", bins = 30) +
    labs(title = paste("Rozkład", var), x = var, y = "Częstotliwość")
})

combined_plots <- log_plot_list %>%
  do.call(cowplot::plot_grid, .)
combined_plots

Zapisanie przygotowanych danych do nowego pliku csv

write.csv(dane, "DanePoprawione.csv", row.names = FALSE)
kable(head(dane, 10), caption = "Dane") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed")) %>%
  scroll_box(width = "100%", height = "auto")
Dane
Loan_ID Gender Married Dependents Education Self_Employed ApplicantIncome CoapplicantIncome LoanAmount Loan_Amount_Term Credit_History Property_Area Loan_Status log_ApplicantIncome log_CoapplicantIncome log_LoanAmount TotalIncome DebtToIncomeRatio log_TotalIncome log_DebtToIncomeRatio
LP001002 Male No 0 Graduate No 5849 0 108 30 Existing Urban Yes 8.674197 0.000000 4.691348 5849 0.0184647 8.674197 0.0182963
LP001003 Male Yes 1 Graduate No 4583 1508 128 30 Existing Rural No 8.430327 7.319203 4.859812 6091 0.0210146 8.714732 0.0207969
LP001005 Male Yes 0 Graduate Yes 3000 0 66 30 Existing Urban Yes 8.006701 0.000000 4.204693 3000 0.0220000 8.006701 0.0217615
LP001006 Male Yes 0 Not Graduate No 2583 2358 120 30 Existing Urban Yes 7.857094 7.765993 4.795790 4941 0.0242866 8.505525 0.0239964
LP001008 Male No 0 Graduate No 6000 0 141 30 Existing Urban Yes 8.699681 0.000000 4.955827 6000 0.0235000 8.699681 0.0232281
LP001011 Male Yes 2 Graduate Yes 5417 4196 267 30 Existing Urban Yes 8.597482 8.342125 5.590987 9613 0.0277749 9.170976 0.0273962
LP001013 Male Yes 0 Not Graduate No 2333 1516 95 30 Existing Urban Yes 7.755339 7.324490 4.564348 3849 0.0246817 8.255828 0.0243821
LP001014 Male Yes 3+ Graduate No 3036 2504 158 30 Not existing Semiurban No 8.018626 7.826044 5.068904 5540 0.0285199 8.619930 0.0281207
LP001018 Male Yes 2 Graduate No 4006 1526 168 30 Existing Urban Yes 8.295798 7.331060 5.129899 5532 0.0303688 8.618485 0.0299168
LP001020 Male Yes 1 Graduate No 12841 10968 349 30 Existing Semiurban No 9.460476 9.302828 5.857933 23809 0.0146583 10.077861 0.0145519

ANALIZA DANYCH

1. Jednowymiarowa analiza danych

Autor: Mikołaj Zalewski

num_vars <- c("ApplicantIncome", "CoapplicantIncome", "LoanAmount", "TotalIncome", "DebtToIncomeRatio")
num_dane_long <- dane %>%
  select(all_of(num_vars)) %>%
  pivot_longer(cols = everything(), names_to = "Zmienne", values_to = "Wartość")

cat_vars <- c("Gender", "Married", "Dependents", "Education", "Self_Employed", "Loan_Amount_Term", "Credit_History", "Property_Area", "Loan_Status")
dane_cat_long <- dane %>%
  select(all_of(cat_vars)) %>%
  pivot_longer(cols = everything(), names_to = "Zmienna", values_to = "Kategoria")

colors <- c("#42cec2", "#306591", "#002185", "#0f225f", "#142c45")
colors2 <- rep(colors, times = 5)

ggplot(num_dane_long, aes(x = Wartość, fill = Zmienne)) +
  geom_histogram(bins = 30, alpha = 0.7, color = "black") +
  facet_wrap(~Zmienne, scales = "free") +
  scale_fill_manual(values = colors) +
  theme_minimal() +
  theme(legend.position = "none") +
  labs(title = "Histogramy zmiennych numerycznych", y = "Liczność")

ggplot(num_dane_long, aes(x = Zmienne, y = Wartość, fill = Zmienne)) +
  geom_boxplot() +
  facet_wrap(~Zmienne, scales = "free", ncol = 1) +
  coord_flip() +
  scale_fill_manual(values = colors) +
  theme_minimal() +
  theme(legend.position = "none") +
  labs(title = "Boxploty zmiennych numerycznych")

summary_table <- sapply(dane[num_vars], summary)
summary_table <- as.data.frame(t(summary_table))
kable(summary_table, caption = "Statystyki opisowe zmiennych numerycznych") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Statystyki opisowe zmiennych numerycznych
Min. 1st Qu. Median Mean 3rd Qu. Max.
ApplicantIncome 1.5000e+02 2.87750e+03 3.81250e+03 5403.4592834 5.79500e+03 8.1000e+04
CoapplicantIncome 0.0000e+00 0.00000e+00 1.18850e+03 1621.2457980 2.29725e+03 4.1667e+04
LoanAmount 9.0000e+00 1.00000e+02 1.27500e+02 146.4218241 1.68000e+02 7.0000e+02
TotalIncome 1.4420e+03 4.16600e+03 5.41650e+03 7024.7050814 7.52175e+03 8.1000e+04
DebtToIncomeRatio 2.5229e-03 1.90966e-02 2.41743e-02 0.0239293 2.84717e-02 8.9010e-02

Dochód wnioskodawcy pokazuje silną asymetrię prawostronną – większość dochodów jest stosunkowo niska, ale istnieje kilka bardzo wysokich wartości. Potwierdza to także średnia, która jest znacznie większa niż mediana. Znaczna część wartości dochodów współwnioskodawcy to zero (co oznacza, że wiele osób składało wniosek o kredyt samodzielnie lub współwnioskodawca nie ma żadnego dochodu). Kwota kredytu oraz całkowity dochód mają rozkłady podobne do dochodu wnioskodawcy – większość wartości jest stosunkowo niska, ale występują duże różnice. Wskaźnik zadłużenia do dochodu wskazuje na mocno skupione wartości, sugerując, że większość osób ma podobny stosunek zadłużenia do dochodu.

ggplot(dane_cat_long, aes(x = Kategoria, fill = Kategoria)) +
  geom_bar() +
  facet_wrap(~Zmienna, scales = "free") +
  scale_fill_manual(values = colors2) +
  theme_minimal() +
  theme(legend.position = "none") +
  labs(title = "Wykresy częstości dla zmiennych kategorycznych", 
       x = "Kategoria", 
       y = "Liczność")

Większość wnioskodawców to mężczyźni z wykształceniem wyższym w związku małżeńskim bez osób na utrzymaniu. Wnioskodawcy są dość równomiernie podzieleni między obszary: wiejski (Rural), pół-miejski (Semiurban) i miejski (Urban). Zdecydowana większość osób to pracownicy etatowi, a osoby samozatrudnione stanowią niewielki procent. Większość osób ma istniejącą historię kredytową i wybiera okres spłaty równy 360 miesięcy (30 lat). Większości osób kredyt został przyznany.

2. Dwuwymiarowa analiza danych

Autor: Dominika Szymczak

Dwuwymiarowa analiza zmiennych jakościowych:

  • Status kredytu vs płeć
tabela <- table(dane$Loan_Status, dane$Gender)
df_table <- as.data.frame.matrix(tabela)
kable(df_table, caption = "Tabela krzyżowa: Status kredytu vs Płeć") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela krzyżowa: Status kredytu vs Płeć
Male Female Undefined
No 150 37 5
Yes 339 75 8 
mosaicplot(tabela, shade = TRUE, main = "Wykres Mozaikowy: Status kredytu vs Płeć")

ggplot(as.data.frame(tabela), aes(Var1, Var2, fill = Freq)) +
  geom_tile() +
  theme_minimal() +
  labs(title = "Wykres Ilościowy: Status kredytu vs Płeć",
       x = "Status kredytu", y = "Płeć", fill = "Liczność") +
  wykres_gr

Wykres ilościowy przedstawia liczbę osób w poszczególnych kategoriach płci w podziale na status kredytu (No, Yes). Kolorystyka wskazuje liczność poszczególnych grup – im ciemniejszy kolor, tym większa liczba obserwacji. Najwięcej aplikacji kredytowych pochodzi od mężczyzn, co sugeruje, że są oni dominującą grupą w badanej próbie. Nie ma widocznych znaczących różnic między kategoriami Male i Female pod względem proporcji decyzji kredytowych – obie płcie wydają się być traktowane podobnie przez instytucję kredytową.

Wykres mozaikowy przedstawia proporcje między płcią a statusem kredytu. Każdy prostokąt odpowiada konkretnej kombinacji wartości (Male-Yes, Female-No itd.), a jego wielkość odzwierciedla liczność danej grupy. Wartości standaryzowanych reszt nie wskazują na istotne odchylenia od wartości oczekiwanych, co oznacza, że płeć prawdopodobnie nie ma istotnego wpływu na decyzję kredytową.

  • Status kredytu vs stan cywilny
tabela <- table(dane$Loan_Status, dane$Married)
df_table <- as.data.frame.matrix(tabela)
kable(df_table, caption = "Tabela krzyżowa: Status kredytu vs Stan cywilny") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela krzyżowa: Status kredytu vs Stan cywilny
No Yes Undefined
No 79 113 0
Yes 134 285 3 
mosaicplot(tabela, shade = TRUE, main = "Wykres Mozaikowy: Status kredytu vs Stan cywilny")

ggplot(as.data.frame(tabela), aes(Var1, Var2, fill = Freq)) +
  geom_tile() +
  theme_minimal() +
  labs(title = "Wykres Ilościowy: Status kredytu vs Stan cywilny",
       x = "Status kredytu", y = "Stan cywilny", fill = "Liczność") +
  wykres_gr

Wykres ilościowy przedstawia liczbę osób w poszczególnych kategoriach stanu cywilnego w podziale na status kredytu (No, Yes). Najwięcej aplikacji kredytowych pochodzi od ludzi w związach małżeńskim, co sugeruje, że są oni dominującą grupą w badanej próbie. Nie ma widocznych znaczących różnic między kategoriami stanu cywilnego pod względem proporcji decyzji kredytowych.

Wykres mozaikowy przedstawia proporcje między stanem cywilnym a statusem kredytu. Wartości standaryzowanych reszt nie wskazują na istotne odchylenia od wartości oczekiwanych, co oznacza, że stan cywilny prawdopodobnie nie ma istotnego wpływu na decyzję kredytową.

  • Status kredytu vs liczba osób zależnych finansowo
tabela <- table(dane$Loan_Status, dane$Dependents)
df_table <- as.data.frame.matrix(tabela)
kable(df_table, caption = "Tabela krzyżowa: Status kredytu vs Liczba osób zależnych finansowo") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela krzyżowa: Status kredytu vs Liczba osób zależnych finansowo
0 1 2 3+
No 113 36 25 18
Yes 247 66 76 33 
mosaicplot(tabela, shade = TRUE, main = "Wykres Mozaikowy: Status kredytu vs Liczba osób zależnych finansowo")

ggplot(as.data.frame(tabela), aes(Var1, Var2, fill = Freq)) +
  geom_tile() +
  theme_minimal() +
  labs(title = "Wykres Ilościowy: Status kredytu vs Liczba osób zależnych finansowo",
       x = "Status kredytu", y = "Liczba osób zależnych finansowo", fill = "Liczność") +
  wykres_gr

Wykres ilościowy przedstawia liczbę osób z określoną liczbą osób zależnych finansowo w podziale na status kredytu (No, Yes). Najwięcej aplikacji kredytowych pochodzi od osób bez osób zależnych finansowo, co sugeruje, że są oni dominującą grupą w badanej próbie.

Wykres mozaikowy przedstawia proporcje między liczbą osób zależnych finansowo a statusem kredytu. Wartości standaryzowanych reszt nie wskazują na istotne odchylenia od wartości oczekiwanych, co oznacza, że liczba osób zależnych finansowo prawdopodobnie nie ma istotnego wpływu na decyzję kredytową.

  • Status kredytu vs poziom edukacji
tabela <- table(dane$Loan_Status, dane$Education)
df_table <- as.data.frame.matrix(tabela)
kable(df_table, caption = "Tabela krzyżowa: Status kredytu vs Poziom edukacji") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela krzyżowa: Status kredytu vs Poziom edukacji
Not Graduate Graduate
No 52 140
Yes 82 340 
mosaicplot(tabela, shade = TRUE, main = "Wykres Mozaikowy: Status kredytu vs Poziom edukacji")

ggplot(as.data.frame(tabela), aes(Var1, Var2, fill = Freq)) +
  geom_tile() +
  theme_minimal() +
  labs(title = "Wykres Ilościowy: Status kredytu vs Poziom edukacji",
       x = "Status kredytu", y = "Poziom edukacji", fill = "Liczność") +
  wykres_gr

Wykres ilościowy przedstawia liczbę osób w poszczególnych kategoriach poziomu edukacji w podziale na status kredytu. Najwięcej aplikacji kredytowych pochodzi od osób z wykształceniem wyższym, co sugeruje, że są oni dominującą grupą w badanej próbie. Nie ma widocznych znaczących różnic między kategoriami pod względem proporcji decyzji kredytowych.

Wykres mozaikowy przedstawia proporcje między poziomem edukacji a statusem kredytu. Wartości standaryzowanych reszt nie wskazują na istotne odchylenia od wartości oczekiwanych, co oznacza, że poziom edukacji prawdopodobnie nie ma istotnego wpływu na decyzję kredytową.

  • Status kredytu vs samozatrudnienie
tabela <- table(dane$Loan_Status, dane$Self_Employed)
df_table <- as.data.frame.matrix(tabela)
kable(df_table, caption = "Tabela krzyżowa: Status kredytu vs Samozatrudnienie") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela krzyżowa: Status kredytu vs Samozatrudnienie
No Yes
No 157 35
Yes 343 79 
mosaicplot(tabela, shade = TRUE, main = "Wykres Mozaikowy: Status kredytu vs Samozatrudnienie")

ggplot(as.data.frame(tabela), aes(Var1, Var2, fill = Freq)) +
  geom_tile() +
  theme_minimal() +
  labs(title = "Wykres Ilościowy: Status kredytu vs Samozatrudnienie",
       x = "Status kredytu", y = "Samozatrudnienie", fill = "Liczność") +
  wykres_gr

Wykres ilościowy przedstawia liczbę osób samozatrudnionych i nie w podziale na status kredytu. Najwięcej aplikacji kredytowych pochodzi od osób nie będących samozatrudnionymi, co sugeruje, że są oni dominującą grupą w badanej próbie. Nie ma widocznych znaczących różnic między kategoriami pod względem proporcji decyzji kredytowych.

Wykres mozaikowy przedstawia proporcje między byciem samozatrudnionym a statusem kredytu. Wartości standaryzowanych reszt nie wskazują na istotne odchylenia od wartości oczekiwanych, co oznacza, że samozatrudnienie prawdopodobnie nie ma istotnego wpływu na decyzję kredytową.

  • Status kredytu vs okres kredytowania
tabela <- table(dane$Loan_Status, dane$Loan_Amount_Term)
df_table <- as.data.frame.matrix(tabela)
kable(df_table, caption = "Tabela krzyżowa: Status kredytu vs Okres kredytowania") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela krzyżowa: Status kredytu vs Okres kredytowania
1 3 5 7 10 15 20 25 30 40
No 0 2 0 1 0 15 1 5 159 9
Yes 1 0 2 3 3 29 3 8 367 6 
mosaicplot(tabela, shade = TRUE, main = "Wykres Mozaikowy: Status kredytu vs Okres kredytowania")

ggplot(as.data.frame(tabela), aes(Var1, Var2, fill = Freq)) +
  geom_tile() +
  theme_minimal() +
  labs(title = "Wykres Ilościowy: Status kredytu vs Okres kredytowania",
       x = "Status kredytu", y = "Okres kredytowania", fill = "Liczność") +
  wykres_gr

Wykres ilościowy przedstawia liczbę osób w poszczególnych kategoriach okresu kredytowania w podziale na status kredytu. Najwięcej aplikacji kredytowych dotyczy okresu 30 lat, co sugeruje, że jest to dominujący okres kredytowania w badanej próbie.

Wykres mozaikowy przedstawia proporcje między okresem kredytowania a statusem kredytu. Wartości standaryzowanych reszt nie wskazują na istotne odchylenia od wartości oczekiwanych, co oznacza, że okres kredytowania prawdopodobnie nie ma istotnego wpływu na decyzję kredytową, jednak ze względu na dużą liczbę kategorii oraz małe częstości poszczególnych kategorii, wykres może wprowadzać w błąd.

  • Status kredytu vs historia kredytowa
tabela <- table(dane$Loan_Status, dane$Credit_History)
df_table <- as.data.frame.matrix(tabela)
kable(df_table, caption = "Tabela krzyżowa: Status kredytu vs Historia kredytowa") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela krzyżowa: Status kredytu vs Historia kredytowa
Not existing Existing
No 95 97
Yes 44 378 
mosaicplot(tabela, shade = TRUE, main = "Wykres Mozaikowy: Status kredytu vs historia kredytowa")

ggplot(as.data.frame(tabela), aes(Var1, Var2, fill = Freq)) +
  geom_tile() +
  theme_minimal() +
  labs(title = "Wykres Ilościowy: Status kredytu vs Historia kredytowa",
       x = "Status kredytu", y = "Historia kredytowa", fill = "Liczność") +
  wykres_gr

Wykres ilościowy przedstawia liczebność przypadków dla osób posiadających historię kredytową i nie oraz pokazuje, że są znaczące różnice między tymi kategoriami pod względem proporcji decyzji kredytowych.

Wykres mozaikowy przedstawia reszty standaryzowane (standardized residuals), które pokazują różnice między obserwowaną a oczekiwaną liczebnością w poszczególnych kategoriach. Kolor niebieski wskazuje, że w tych kategoriach liczba obserwacji jest większa, a kolor czerwony, że liczba obserwacji jest mniejsza niż oczekiwana. Wykres ten sugeruje więc, że historia kredytowa może mieć istotny wpływ na decyzję kredytową.

  • Status kredytu vs położenie obiektu hipoteki
tabela <- table(dane$Loan_Status, dane$Property_Area)
df_table <- as.data.frame.matrix(tabela)
kable(df_table, caption = "Tabela krzyżowa: Status kredytu vs Położenie obiektu hipoteki") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela krzyżowa: Status kredytu vs Położenie obiektu hipoteki
Rural Semiurban Urban
No 69 54 69
Yes 110 179 133 
mosaicplot(tabela, shade = TRUE, main = "Wykres Mozaikowy: Status kredytu vs Położenie obiektu hipoteki")

ggplot(as.data.frame(tabela), aes(Var1, Var2, fill = Freq)) +
  geom_tile() +
  theme_minimal() +
  labs(title = "Wykres Ilościowy: Status kredytu vs Położenie obiektu hipoteki",
       x = "Status kredytu", y = "Położenie obiektu hipoteki", fill = "Liczność") +
  wykres_gr

Wykres ilościowy przedstawia liczebność przypadków dla różnych kategorii położenia obiektu hipoteki i pokazuje, że występują różnice między tymi kategoriami pod względem proporcji decyzji kredytowych.

Wykres mozaikowy przedstawia reszty standaryzowane (standardized residuals), które pokazują różnice między obserwowaną a oczekiwaną liczebnością w poszczególnych kategoriach. Kolor czerwony wskazuje, że liczba obserwacji jest mniejsza niż oczekiwana. Wykres ten sugeruje więc, że położenie obiektu hipoteki kredytowa może mieć statystycznie istotny wpływ na decyzję kredytową.

Dwuwymiarowa analiza zmiennych mieszanych (jakościowej z ilościową)

  • Status kredytu vs dochody aplikanta
wykres1 <- ggplot(dane, aes(x = Loan_Status, y = log_ApplicantIncome, fill = Loan_Status)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_manual(values = c("No" = "#42cec2", "Yes" = "#002185")) + 
  labs(title = "Klasyczny wykres pudełkowy", x = "Status kredytu", y = "Dochody aplikanta") +
  theme_minimal()

wykres2 <- ggplot(dane, aes(x = Loan_Status, y = log_ApplicantIncome, fill = Loan_Status)) +
  geom_jitter(aes(color = Loan_Status), width = 0.2, height = 0, alpha = 0.6) +
  geom_boxplot(alpha = 0.5, outlier.shape = NA) +
  scale_fill_manual(values = c("No" = "#42cec2", "Yes" = "#002185")) + 
  scale_color_manual(values = c("No" = "#002246", "Yes" = "#002246")) +
  labs(title = "Boxplot z rzeczywistymi danymi",
       x = "Status kredytu",
       y = "Dochody aplikanta") +
  theme_minimal()

wykres1 + wykres2 + plot_layout(ncol = 2)

Na klasycznym wykresie pudełkowym można zauważyć, że dochody osób, którym przyznano kredyt, są podobne do dochodów osób, którym go odmówiono – nie ma wyraźnej różnicy w medianie i rozstępie kwartylowym.

Boxplot z rzeczywistymi danymi jest klasycznym wykresem pudełkowym wzbogaconym o rzeczywiste dane w postaci kropek, dzięki czemu można zobaczyć rzeczywisty rozkład dochodów, a nie tylko statystyki opisowe. Widać, że rozkład dochodów jest zbliżony dla obu grup, co potwierdza brak wyraźnego związku między wysokością dochodów a przyznaniem kredytu. W obu grupach występują wartości odstające, ale ich liczba i zakres są podobne.

  • Status kredytu vs kwota kredytu
wykres1 <- ggplot(dane, aes(x = Loan_Status, y = log_LoanAmount, fill = Loan_Status)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_manual(values = c("No" = "#42cec2", "Yes" = "#002185")) + 
  labs(title = "Klasyczny wykres pudełkowy", x = "Status kredytu", y = "Kwota kredytu") +
  theme_minimal()

wykres2 <- ggplot(dane, aes(x = Loan_Status, y = log_LoanAmount, fill = Loan_Status)) +
  geom_jitter(aes(color = Loan_Status), width = 0.2, height = 0, alpha = 0.6) +
  geom_boxplot(alpha = 0.5, outlier.shape = NA) +
  scale_fill_manual(values = c("No" = "#42cec2", "Yes" = "#002185")) + 
  scale_color_manual(values = c("No" = "#002246", "Yes" = "#002246")) +
  labs(title = "Boxplot z rzeczywistymi danymi",
       x = "Status kredytu",
       y = "Kwota kredytu") +
  theme_minimal()

wykres1 + wykres2 + plot_layout(ncol = 2)

Na klasycznym wykresie pudełkowym można zauważyć, że kwoty kredytów, które zostały przyznane, są podobne do kwot kredytów, które nie zostały przyznane – nie ma wyraźnej różnicy w medianie i rozstępie kwartylowym.

Boxplot z rzeczywistymi danymi pokazuje, że rozkład kwot kredytów jest zbliżony dla obu grup, co potwierdza brak wyraźnego związku między kwotą kredytu a przyznaniem kredytu.

  • Status kredytu vs dochód całkowity
wykres1 <- ggplot(dane, aes(x = Loan_Status, y = log_TotalIncome, fill = Loan_Status)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_manual(values = c("No" = "#42cec2", "Yes" = "#002185")) + 
  labs(title = "Klasyczny wykres pudełkowy", x = "Status kredytu", y = "Dochód całkowity") +
  theme_minimal()

wykres2 <- ggplot(dane, aes(x = Loan_Status, y = log_TotalIncome, fill = Loan_Status)) +
  geom_jitter(aes(color = Loan_Status), width = 0.2, height = 0, alpha = 0.6) +
  geom_boxplot(alpha = 0.5, outlier.shape = NA) +
  scale_fill_manual(values = c("No" = "#42cec2", "Yes" = "#002185")) + 
  scale_color_manual(values = c("No" = "#002246", "Yes" = "#002246")) +
  labs(title = "Boxplot z rzeczywistymi danymi",
       x = "Status kredytu",
       y = "Dochód całkowity") +
  theme_minimal()

wykres1 + wykres2 + plot_layout(ncol = 2)

Na klasycznym wykresie pudełkowym można zauważyć, że dochody całkowite osób, którym przyznano kredyt, są podobne do dochodów całkowitych osób, którym zostały on odmówiony – nie ma wyraźnej różnicy w medianie i rozstępie kwartylowym.

Boxplot z rzeczywistymi danymi pokazuje, że rozkład dochodów całkowitych jest zbliżony dla obu grup, co potwierdza brak wyraźnego związku między wysokością dochodów a przyznaniem kredytu. Logika jednak podpowiada, że zależność taka powinna występować.

  • Status kredytu vs wskaźnik zadłużenia w stosunku do dochodu
wykres1 <- ggplot(dane, aes(x = Loan_Status, y = log_DebtToIncomeRatio, fill = Loan_Status)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_manual(values = c("No" = "#42cec2", "Yes" = "#002185")) + 
  labs(title = "Klasyczny wykres pudełkowy", x = "Status kredytu", y = "Wskaźnik zadłużenia w stosunku do dochodu") +
  theme_minimal()

wykres2 <- ggplot(dane, aes(x = Loan_Status, y = log_DebtToIncomeRatio, fill = Loan_Status)) +
  geom_jitter(aes(color = Loan_Status), width = 0.2, height = 0, alpha = 0.6) +
  geom_boxplot(alpha = 0.5, outlier.shape = NA) +
  scale_fill_manual(values = c("No" = "#42cec2", "Yes" = "#002185")) + 
  scale_color_manual(values = c("No" = "#002246", "Yes" = "#002246")) +
  labs(title = "Boxplot z rzeczywistymi danymi",
       x = "Status kredytu",
       y = "Wskaźnik zadłużenia w stosunku do dochodu") +
  theme_minimal()

wykres1 + wykres2 + plot_layout(ncol = 2)

Na klasycznym wykresie pudełkowym można zauważyć, że wskaźnik zadłużenia w stosunku do dochodów osób, którym przyznano kredyt, są podobne do takiego wskaźnika osób, którym zostały on odmówiony – nie ma wyraźnej różnicy w medianie i rozstępie kwartylowym.

Boxplot z rzeczywistymi danymi pokazuje, że rozkład wskaźników zadłużenia w stosunku do dochodów jest zbliżony dla obu grup, co potwierdza brak wyraźnego związku między tą zmienną a przyznaniem kredytu. Logika jednak podpowiada, że zależność taka powinna występować.

3. Budowanie i testowanie hipotez

Autor: Julia Sowińska

Dla wszystkich postawionych hipotez, przyjmuje się poziom istotności alpha w wysokości 0,05 (5%).

Hipotezy:

A. Status kredytu i historia kredytowa

H₀: Prawdopodobieństwo przyznania kredytu (Loan_Status) jest niezależne od posiadania historii kredytowej (Credit_History).

H₁: Prawdopodobieństwo przyznania kredytu różni się w zależności od posiadania historii kredytowej.

h <- table(dane$Loan_Status, dane$Credit_History)
kable(as.data.frame.matrix(h), caption = "Tabela krzyżowa: Status kredytu vs Historia kredytowa") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela krzyżowa: Status kredytu vs Historia kredytowa
Not existing Existing
No 95 97
Yes 44 378

Założenie o minimalnej liczbie 5 obserwacji w każdej komórce tabeli kontyngencji (założenie testu chi-kwadrat), jest spełnione, dlatego zostanie wykorzystany test Chi-kwadrat.

chi_kwadrat <- chisq.test(h)
print(chi_kwadrat)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  h
## X-squared = 112.7, df = 1, p-value < 2.2e-16

P-value jest mniejsze niż przyjęty poziom istotności, co pozwala odrzucić hipotezę zerową i przyjąć hipotezę alternatywną o istnieniu zależności między statusem kredytu a historią kredytowania.

n <- sum(h)
phi_cramer <- sqrt(chi_kwadrat$statistic / (n * (min(dim(h)) - 1)))
names(phi_cramer) <- "Cramer's V"
print(phi_cramer)
## Cramer's V 
##  0.4284189

Współczynnik Cramera przyjmuje wartość w przybliżeniu 0,428, co świadczy o umiarkowanym związku między zmiennymi Loan_Status i Credit_History.

ggbarstats(data = dane, x = Credit_History, y = Loan_Status, xlab = "Status kredytu", legend.title = "Historia kredytowa", package = "Redmonder", palette = "qMSOBu")

Wykres przedstawia zależność między posiadaniem historii kredytowej a przyznaniem kredytu. Posiadanie historii kredytowej znacznie zwiększa szanse na uzyskanie kredytu, co sugeruje, że instytucje finansowe silnie uwzględniają ten czynnik w ocenie ryzyka kredytowego.

B. Status kredytu i okres kredytowania

H₀: Okres kredytowania (Loan_Amount_Term) nie wpływa na decyzję o przyznaniu kredytu.

H₁: Okres kredytowania wpływa na decyzję o przyznaniu kredytu.

h <- table(dane$Loan_Status, dane$Loan_Amount_Term)
kable(as.data.frame.matrix(h), caption = "Tabela krzyżowa: Status kredytu vs Okres kredytowania") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela krzyżowa: Status kredytu vs Okres kredytowania
1 3 5 7 10 15 20 25 30 40
No 0 2 0 1 0 15 1 5 159 9
Yes 1 0 2 3 3 29 3 8 367 6

Założenie o minimalnej liczbie 5 oczekiwanych obserwacji w każdej komórce tabeli kontyngencji (założenie testu chi-kwadrat), nie jest spełnione, więc wykorzystany zostanie test Fishera.

fisher_test <- fisher.test(h)
print(fisher_test)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  h
## p-value = 0.1446
## alternative hypothesis: two.sided

P-value jest większe niż przyjęty poziom istotności, co oznacza brak podstaw do odrzucenia hipotezy zerowej o braku zależności między statusem a czasem trwania kredytu.

ggbarstats(data = dane, x = Loan_Amount_Term, y = Loan_Status, test = "fisher", xlab = "Status kredytu", legend.title = "Okres kredytowania", package = "Redmonder", palette = "qMSOBu")
## Number of labels is greater than default palette color count.
## • Select another color `palette` (and/or `package`).

Wykres przedstawia brak zależności między wybranym okresem kredytowania a przyznaniem kredytu.

C. Status kredytu i położenie obiektu hipoteki

H₀: Położenie obiektu hipoteki (Property_Area) nie wpływa na decyzję o przyznaniu kredytu.

H₁: Położenie obiektu hipoteki wpływa na decyzję o przyznaniu kredytu.

h <- table(dane$Loan_Status, dane$Property_Area)
kable(as.data.frame.matrix(h), caption = "Tabela krzyżowa: Status kredytu vs Położenie obiektu hipoteki") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tabela krzyżowa: Status kredytu vs Położenie obiektu hipoteki
Rural Semiurban Urban
No 69 54 69
Yes 110 179 133

Założenie o minimalnej liczbie 5 oczekiwanych obserwacji w każdej komórce tabeli kontyngencji (założenie testu chi-kwadrat), jest spełnione, dlatego zostanie wykorzystany test Chi-kwadrat.

chi_kwadrat <- chisq.test(h)
print(chi_kwadrat)
## 
##  Pearson's Chi-squared test
## 
## data:  h
## X-squared = 12.298, df = 2, p-value = 0.002136

P-value jest mniejsze niż przyjęty poziom istotności, co pozwala odrzucić hipotezę zerową i przyjąć hipotezę alternatywną o istnieniu zależności między statusem kredytu a położeniem obiektu hipoteki.

n <- sum(h)
phi_cramer <- sqrt(chi_kwadrat$statistic / (n * (min(dim(h)) - 1)))
names(phi_cramer) <- "Cramer's V"
print(phi_cramer)
## Cramer's V 
##  0.1415228

Współczynnik Cramera przyjmuje wartość w przybliżeniu 0,142, co świadczy o słabym związku między statusem kredytu a położeniem obiektu hipoteki.

ggbarstats(data = dane, x = Property_Area, y = Loan_Status, xlab = "Status kredytu", legend.title = "Położenie obiektu hipoteki", package = "Redmonder", palette = "qMSOBu")

Wykres przedstawia zależność między położeniem obiektu hipoteki a przyznaniem kredytu. Położenie obiektu hipoteki w obszarze pół-miejskim znacznie zwiększa szanse na uzyskanie kredytu.

D. Status kredytu i wskaźnik zadłużenia w stosunku do dochodu

H₀: Średni wskaźnik zadłużenia w stosunku do dochodu (DebtToIncomeRatio) nie różni się między grupami, którym przyznano i nie przyznano kredytu.

H₁: Średni wskaźnik zadłużenia w stosunku do dochodu różni się między grupami, którym przyznano i nie przyznano kredytu.

group_yes <- dane$log_DebtToIncomeRatio[dane$Loan_Status == "Yes"]
group_no <- dane$log_DebtToIncomeRatio[dane$Loan_Status == "No"]

shapiro_yes <- shapiro.test(group_yes)
shapiro_no <- shapiro.test(group_no)

cat("Grupa, której przyznano kredyt: W =", shapiro_yes$statistic, ", p =", shapiro_yes$p.value, "\n")
## Grupa, której przyznano kredyt: W = 0.8784788 , p = 1.056006e-17
cat("Grupa, której nie przyznano kredytu: W =", shapiro_no$statistic, ", p =", shapiro_no$p.value, "\n")
## Grupa, której nie przyznano kredytu: W = 0.931256 , p = 7.070887e-08
bartlett_test <- bartlett.test(DebtToIncomeRatio ~ Loan_Status, data = dane)
print(bartlett_test)
## 
##  Bartlett test of homogeneity of variances
## 
## data:  DebtToIncomeRatio by Loan_Status
## Bartlett's K-squared = 11.996, df = 1, p-value = 0.0005331

Zarówno założenie o normalności rozkładu zmiennej reprezentującej wskaźnik zadłużenia w stosunku do dochodu w każdej z grup statusu kredytu (Yes/No), jak i założenie o jednorodności wariancji nie zostały spełnione, dlatego zamiast testu t-Studenta, stosowany będzie test U Manna-Whitneya.

mannwhitney <- wilcox.test(log_DebtToIncomeRatio ~ Loan_Status, data = dane)
  print(mannwhitney)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  log_DebtToIncomeRatio by Loan_Status
## W = 42182, p-value = 0.4126
## alternative hypothesis: true location shift is not equal to 0

P-value jest większe niż przyjęty poziom istotności, co oznacza brak podstaw do odrzucenia hipotezy zerowej o braku zależności między statusem kredytu a Wskaźnikiem zadłużenia w stosunku do dochodu.

E. Status kredytu i dochód całkowity

H₀: Średni całkowity dochód (TotalIncome) nie różni się między grupami, którym przyznano i nie przyznano kredytu.

H₁: Średni całkowity dochód różni się między grupami, którym przyznano i nie przyznano kredytu.

group_yes <- dane$log_TotalIncome[dane$Loan_Status == "Yes"]
group_no <- dane$log_TotalIncome[dane$Loan_Status == "No"]

shapiro_yes <- shapiro.test(group_yes)
shapiro_no <- shapiro.test(group_no)

cat("Grupa, której przyznano kredyt: W =", shapiro_yes$statistic, ", p =", shapiro_yes$p.value, "\n")
## Grupa, której przyznano kredyt: W = 0.9379443 , p = 2.902198e-12
cat("Grupa, której nie przyznano kredytu: W =", shapiro_no$statistic, ", p =", shapiro_no$p.value, "\n")
## Grupa, której nie przyznano kredytu: W = 0.9505776 , p = 3.307429e-06
bartlett_test <- bartlett.test(log_TotalIncome ~ Loan_Status, data = dane)
print(bartlett_test)
## 
##  Bartlett test of homogeneity of variances
## 
## data:  log_TotalIncome by Loan_Status
## Bartlett's K-squared = 8.2715, df = 1, p-value = 0.004027

Zarówno założenie o normalności rozkładu całkowitego dochodu w każdej z grup Loan_Status (Yes/No), jak i założenie o jednorodności wariancji nie zostały spełnione, dlatego zamiast testu t-Studenta, stosowany będzie test U Manna-Whitneya.

mannwhitney <- wilcox.test(log_TotalIncome ~ Loan_Status, data = dane)
  print(mannwhitney)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  log_TotalIncome by Loan_Status
## W = 39762, p-value = 0.7128
## alternative hypothesis: true location shift is not equal to 0

P-value jest większe niż przyjęty poziom istotności, co oznacza brak podstaw do odrzucenia hipotezy zerowej o braku zależności między statusem kredytu a Dochodem całkowitym.

Zależność zmiennych dotyczących posiadania Historii kredytowej oraz Położenia obiektu hipoteki ze zmienną dotyczącą Przyznania kredytu zostały uznane za istotne.

4. Grupy klientów według kombinacji Historii kredytowej i Położenie obiektu hipoteki

Autor: Mikołaj Zalewski

Dodanie nowej zmiennej grupującej klientów według zmiennych Historia kredytowa i Położenie obiektu hipoteki na 6 grup

dane$Group <- paste(dane$Property_Area, dane$Credit_History, sep = "_")
dane$Group <- factor(dane$Group,
                          levels = c("Urban_Existing", "Semiurban_Existing", "Rural_Existing", "Urban_Not existing", "Semiurban_Not existing", "Rural_Not existing"),
                          labels = c("Urban_Existing", "Semiurban_Existing", "Rural_Existing", "Urban_Not existing", "Semiurban_Not existing", "Rural_Not existing"))

Skrócone statystyki opisowe dla każdej grupy

statystyki <- dane %>%
  group_by(Group) %>%
  summarise(
    Liczba_osob = n(),
    Procent_mezczyzn = (sum(Gender == "Male", na.rm = TRUE) / Liczba_osob) * 100,
    Procent_married = (sum(Married == "Yes", na.rm = TRUE) / Liczba_osob) * 100,
    Procent_Graduate = (sum(Education == "Graduate", na.rm = TRUE) / Liczba_osob) * 100,
    Srednia_TotalIncome = mean(TotalIncome, na.rm = TRUE)
  )

kable(statystyki, caption = "Porównanie grup aplikantów") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Porównanie grup aplikantów
Group Liczba_osob Procent_mezczyzn Procent_married Procent_Graduate Srednia_TotalIncome
Urban_Existing 151 84.10596 65.56291 83.44371 7024.568
Semiurban_Existing 187 75.40107 64.70588 81.81818 6874.668
Rural_Existing 137 83.21168 62.04380 73.72263 6987.198
Urban_Not existing 51 76.47059 62.74510 70.58824 7381.157
Semiurban_Not existing 46 67.39130 65.21739 73.91304 6559.239
Rural_Not existing 42 88.09524 73.80952 71.42857 7892.524

Tabela pokazuje, jak podobne pod względem innych zmiennych są poszczególne grupy.

Proporcje przyznanych kredytów w każdej grupie

proporcje_loan_status <- dane %>%
  group_by(Group, Loan_Status) %>%
  summarise(Liczba = n(), .groups = "drop") %>%
  group_by(Group) %>%
  mutate(Proporcja = Liczba / sum(Liczba) * 100)

ggplot(proporcje_loan_status, aes(x = "", y = Proporcja, fill = Loan_Status)) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar(theta = "y") + 
  facet_wrap(~ Group) +  
  theme_void() +  
  labs(title = "Proporcja osób, które otrzymały kredyt w każdej grupie") +
  scale_fill_manual(values = c("#42cec2", "#306591")) + 
  geom_text(aes(label = paste0(round(Proporcja, 1), "%")), position = position_stack(vjust = 0.5), color = "#142c45")

5. Model predykcyjny

Autor: Julia Sowińska

Podział danych na zbiór treningowy i testowy

dane$Loan_Status_Binary <- ifelse(dane$Loan_Status == "Yes", 1, 0)
set.seed(123)
train_idx <- sample(1:nrow(dane), 0.7 * nrow(dane))
train <- dane[train_idx, ]
test <- dane[-train_idx, ]

Dane zostały podzielona na dwa zbiory - treningowy i testowy, by uniknąć przeuczenia (overfittingu) oraz zapewnić rzetelną ocenę modelu poprzez testowanie modelu na danych, których nie widział podczas treningu. Zdecydowano się na podział: 70% danych do treningu i 30% danych do testu.

Budowa modelu

model <- glm(Loan_Status_Binary ~ Credit_History + Property_Area, data = train, family = "binomial")
summary(model)
## 
## Call:
## glm(formula = Loan_Status_Binary ~ Credit_History + Property_Area, 
##     family = "binomial", data = train)
## 
## Coefficients:
##                        Estimate Std. Error z value Pr(>|z|)    
## (Intercept)             -1.2094     0.2883  -4.194 2.74e-05 ***
## Credit_HistoryExisting   2.2742     0.2628   8.654  < 2e-16 ***
## Property_AreaSemiurban   0.6164     0.2873   2.146   0.0319 *  
## Property_AreaUrban       0.2834     0.2873   0.986   0.3241    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 537.43  on 428  degrees of freedom
## Residual deviance: 448.08  on 425  degrees of freedom
## AIC: 456.08
## 
## Number of Fisher Scoring iterations: 4

Zbudowany został model regresji logistycznej (logit), który był naturalnym wyborem dla problemu klasyfikacji binarnej, jakim było przyznanie bądź nieprzyznanie kredytu. Model ten został wybrany ze względu na jego prostotę, szybkość i efektywność, a także ze względu na łatwiejszą interpretację. Jest to model predykcyjny, zatem zdecydowano się na pozostawienie w nim wszystkich zmiennych bez względu na istotność statystyczną.

Ocena modelu

predictions <- predict(model, newdata = test, type = "response")
predicted_classes <- ifelse(predictions > 0.5, "Yes", "No")
confusion_matrix <- table(Predicted = predicted_classes, Actual = test$Loan_Status)

confusion_matrix_df <- as.data.frame(confusion_matrix)
ggplot(confusion_matrix_df, aes(Actual, Predicted, fill = Freq)) +
  geom_tile() +
  theme_minimal() +
  labs(x = "Rzeczywista klasa", y = "Przewidywana klasa", fill = "Liczba") +
  wykres_gr

Wykres przedstawia tablicę kontyngencji i pokazuję, że prognozy dotyczące przyznania kredytu (rzeczywisty Credit_Status == “Yes) były dużo bardziej trafne, niż te dotyczące nie przyznania kredytu, co może sugerować, że model powinien obejmować jeszcze inne zmienne.

accuracy <- sum(diag(confusion_matrix)) / sum(confusion_matrix)
cat("Dokładność:", accuracy, "\n")
## Dokładność: 0.7567568
precision <- confusion_matrix["Yes", "Yes"] / (confusion_matrix["Yes", "Yes"] + confusion_matrix["No", "Yes"])
cat("Precyzja:", precision, "\n")
## Precyzja: 0.8846154
recall <- confusion_matrix["Yes", "Yes"] / (confusion_matrix["Yes", "Yes"] + confusion_matrix["Yes", "No"])
cat("Czułość:", recall, "\n")
## Czułość: 0.7931034
f1_score <- 2 * (precision * recall) / (precision + recall)
cat("F1-score:", f1_score, "\n")
## F1-score: 0.8363636

Model prawidłowo klasyfikuje około 75,68% przypadków. Około 88,46% przewidywań przyznania kredytu jest prawidłowe i około 79,31% rzeczywistych przyznań kredytu zostało poprawnie wykrytych. F1-score wynosi około 0,84, co oznacza, że model jest dobrze wyważony między precyzją a czułością.

roc_curve <- roc(test$Loan_Status, predictions)
## Setting levels: control = No, case = Yes
## Setting direction: controls < cases
plot(roc_curve, col = "#002185")

auc(roc_curve)
## Area under the curve: 0.7614

AUC przyjmuje wartość 0,7614, co oznacza, że model jest przyzwoity.

Podsumowanie

Autor: Julia Sowińska

Analiza danych kredytowych ujawniła kilka istotnych wzorców dotyczących decyzji kredytowych oraz czynników mogących wpływać na ich przyznawanie. Najważniejszym czynnikiem wpływającym na decyzję kredytową jest posiadanie historii kredytowej, co sugeruje, że instytucje finansowe w dużym stopniu opierają się na wcześniejszych zobowiązaniach klienta przy ocenie jego wiarygodności. Położenie obiektu hipoteki może również wpływać na decyzję, ale w mniejszym stopniu. Pozostałe zmienne, takie jak dochody, wskaźnik zadłużenia czy poziom edukacji, nie wykazują istotnych zależności. Wyniki analizy dostarczają istotnych informacji dla instytucji kredytowych, które mogą pozwolić na automatyzację procesu podejmowania decyzji o przyznaniu lub nieprzyznaniu kredytu hipotecznego.