Raport
2023-11-25
#CZĘŚĆ 1 - CEL PROJEKTU, DANE.
1.1 Opis surowych zmiennych.
tabela_pozyczki <- data.frame(
"Nazwa Zmiennej" = c("Loan_ID", "Gender", "Married", "Dependents", "Education", "Self_Employed", "ApplicantIncome", "CoapplicantIncome", "LoanAmount", "Loan_Amount_Term", "Credit_History", "Property_Area", "Loan_Status"),
"Typ Zmiennej" = c("character", "character", "character", "character", "character", "character", "numeric", "character", "numeric", "numeric", "numeric", "character", "character"),
"Opis" = c("Unikalny numer identyfikacyjny dla każdej aplikacji o pożyczkę",
"Płeć wnioskodawcy (Male - Mężczyzna, Female - Kobieta)",
"Stan cywilny wnioskodawcy (Yes - Tak, No - Nie)",
"Liczba osób na utrzymaniu wnioskodawcy (0, 1, 2, 3+)",
"Poziom edukacji wnioskodawcy (Graduate - Absolwent, Not Graduate - Nie absolwent)",
"Czy wnioskodawca jest samozatrudniony (Yes - Tak, No - Nie)",
"Miesięczny dochód wnioskodawcy",
"Miesięczny dochód współwnioskodawcy",
"Kwota pożyczki wnioskowanej (w tysiącach)",
"Okres spłaty pożyczki, w miesiącach",
"Binarna zmienna reprezentująca historię kredytową wnioskodawcy (1 - pozytywna, 0 - negatywna)",
"Kategoria obszaru nieruchomości, na którym mieszka wnioskodawca (Urban - Miejski, Semiurban - Pół-miejski, Rural - Wiejski)",
"Ostateczna decyzja dotycząca aplikacji o pożyczkę (Y - Zatwierdzona, N - Odrzucona)")
)
print(tabela_pozyczki)## Nazwa.Zmiennej Typ.Zmiennej
## 1 Loan_ID character
## 2 Gender character
## 3 Married character
## 4 Dependents character
## 5 Education character
## 6 Self_Employed character
## 7 ApplicantIncome numeric
## 8 CoapplicantIncome character
## 9 LoanAmount numeric
## 10 Loan_Amount_Term numeric
## 11 Credit_History numeric
## 12 Property_Area character
## 13 Loan_Status character
## Opis
## 1 Unikalny numer identyfikacyjny dla każdej aplikacji o pożyczkę
## 2 Płeć wnioskodawcy (Male - Mężczyzna, Female - Kobieta)
## 3 Stan cywilny wnioskodawcy (Yes - Tak, No - Nie)
## 4 Liczba osób na utrzymaniu wnioskodawcy (0, 1, 2, 3+)
## 5 Poziom edukacji wnioskodawcy (Graduate - Absolwent, Not Graduate - Nie absolwent)
## 6 Czy wnioskodawca jest samozatrudniony (Yes - Tak, No - Nie)
## 7 Miesięczny dochód wnioskodawcy
## 8 Miesięczny dochód współwnioskodawcy
## 9 Kwota pożyczki wnioskowanej (w tysiącach)
## 10 Okres spłaty pożyczki, w miesiącach
## 11 Binarna zmienna reprezentująca historię kredytową wnioskodawcy (1 - pozytywna, 0 - negatywna)
## 12 Kategoria obszaru nieruchomości, na którym mieszka wnioskodawca (Urban - Miejski, Semiurban - Pół-miejski, Rural - Wiejski)
## 13 Ostateczna decyzja dotycząca aplikacji o pożyczkę (Y - Zatwierdzona, N - Odrzucona)1.2 Sprawdzanie struktury i typów danych.
Wniosek: Podczas sprawdzania struktury danych zauważono następujące nieścisłości w danych: 1. Zmienna CoapplicantIncome traktowana jest jako zmienna tekstowa, mimo, że zawiera wartości numeryczne.
- Zmienne Gender, Married, Dependents, Education, Self_Employed, Property_Area Loan_Satus w celu prostszej analizy powiiny zostać przekształcone na faktory.
glimpse(pozyczki_raw)## Rows: 614
## Columns: 13
## $ Loan_ID <chr> "LP001002", "LP001003", "LP001005", "LP001006", "LP0~
## $ Gender <chr> "Male", "Male", "Male", "Male", "Male", "Male", "Mal~
## $ Married <chr> "No", "Yes", "Yes", "Yes", "No", "Yes", "Yes", "Yes"~
## $ Dependents <chr> "0.0", "1.0", "0.0", "0.0", "0.0", "2.0", "0.0", "3+~
## $ Education <chr> "Graduate", "Graduate", "Graduate", "Not Graduate", ~
## $ Self_Employed <chr> "No", "No", "Yes", "No", "No", "Yes", "No", "No", "N~
## $ ApplicantIncome <dbl> 5849, 4583, 3000, 2583, 6000, 5417, 2333, 3036, 4006~
## $ CoapplicantIncome <chr> "0.0", "1508.0", "0.0", "2358.0", "0.0", "4196.0", "~
## $ LoanAmount <dbl> NA, 128, 66, 120, 141, 267, 95, 158, 168, 349, 70, 1~
## $ Loan_Amount_Term <dbl> 360, 360, 360, 360, 360, 360, 360, 360, 360, 360, 36~
## $ Credit_History <dbl> 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, NA, ~
## $ Property_Area <chr> "Urban", "Rural", "Urban", "Urban", "Urban", "Urban"~
## $ Loan_Status <chr> "Y", "N", "Y", "Y", "Y", "Y", "Y", "N", "Y", "N", "Y~1.3. Usunięcie zmiennej Loan_ID.
pozyczki_raw <- dplyr::select(pozyczki_raw, -1)1.4 Zmiana klasyfikacji typów zmiennych.
pozyczki <- pozyczki_raw %>%
mutate(CoapplicantIncome = as.numeric(CoapplicantIncome),
Gender = as.factor(Gender),
Married = as.factor(Married),
Dependents = as.factor(Dependents),
Education = as.factor(Education),
Self_Employed = as.factor(Self_Employed),
Property_Area = as.factor(Property_Area),
Loan_Status = as.factor(Loan_Status),
Credit_History = as.factor(Credit_History)
)1.5 Dodanie nowej zmiennej.
Dodatkowo, zdecydowano się na dodanie zmiennej TotalIncome, która jest sumą przychodów wszystkich osób aplikujących wspólnie o kredyt i usunięcie kolumn Applicant Income i Coapplicant Income.
pozyczki <- pozyczki %>%
mutate(TotalIncome = ApplicantIncome + CoapplicantIncome)
pozyczki <- dplyr::select(pozyczki, -ApplicantIncome, -CoapplicantIncome)
summary(pozyczki)## Gender Married Dependents Education Self_Employed
## Female:112 No :213 0.0 :345 Graduate :480 No :500
## Male :489 Yes :398 1.0 :102 Not Graduate:134 Yes : 82
## NA's : 13 NA's: 3 2.0 :101 NA's: 32
## 3+ : 51
## NA's: 15
##
##
## LoanAmount Loan_Amount_Term Credit_History Property_Area Loan_Status
## Min. : 9.0 Min. : 12 0 : 89 Rural :179 N:192
## 1st Qu.:100.0 1st Qu.:360 1 :475 Semiurban:233 Y:422
## Median :128.0 Median :360 NA's: 50 Urban :202
## Mean :146.4 Mean :342
## 3rd Qu.:168.0 3rd Qu.:360
## Max. :700.0 Max. :480
## NA's :22 NA's :14
## TotalIncome
## Min. : 1442
## 1st Qu.: 4166
## Median : 5416
## Mean : 7025
## 3rd Qu.: 7522
## Max. :81000
## 1.6 Opis zmiennych.
Sprawdzanie klasyfikacji zmiennych po wprowadzonych zmianach.
Zmienna Gender jest zmienną opisującą płeć wnioskodawcy, przyjmuje ona dwie wartośći “Male” i “Female”. 112 obserwacji przyjmuje wartość Female, a 489 Male, brakujących wartości dla zmiennej Gender jest 13.
Zmienna Married opisuje stan cywilny wnioskodawcy i przyjmuje dwie wartości: “Yes” oraz “No” (Nie). Liczba obserwacji, gdzie wnioskodawca jest osobą po ślubie to 398, 213 wnioskodawców nie jest w związku małżeńskim. Brakujących obserwacji dla zmiennej Married jest 3.
Zmienna Dependents opisuje liczbę osób będących na utrzymaniu wnioskodawcy i przyjmuje cztery wartości: “0”, “1”, “2” i “3+” “No”. Liczba obserwacji, gdzie wnioskodawca ma 0 osób na utrzymaniu to 346, przypadków gdzie wnioskodawca utrzymuje jedną osobę jest 102, przypadków gdzie wnioskodawca utrzymuje trzy i więcej osób jest 51. Brakujących obserwacji dla zmiennej Married jest 15.
Zmienna Education opisuje poziom wykształcenia wnioskodawcy i przyjmuje dwie wartości: “Graduate” oraz “Not Graduate”. Liczba obserwacji, gdzie wartość wykształcenia to “Graduate” to 480. a liczba obserwacji, gdzie wartość wykształcenia to “Not Graduate” wynosi 134. Liczba brakujących wartości dla obserwacji dla zmiennej education to 3.
Zmienna Self_Employed opisuje status samozatrudnienia wnioskodawcy i przyjmuje dwie wartości: “Yes” oraz “No”. Liczba obserwacji, gdzie wnioskodawca jest samozatrudniony to 82, a liczba obserwacji, gdzie nie jest samozatrudniony to 500. Brakujących obserwacji dla zmiennej Self_Employed to 32.
Zmienna LoanAmount określa kwotę pożyczki (w tysiącach), którą wnioskodawca ubiega się o uzyskanie. Statystyki dla tej zmiennej są następujące: minimalna wartość to 9.0, pierwszy kwartyl wynosi 100.0, mediana to 128.0, średnia to 146.4, trzeci kwartyl to 168.0, a maksymalna wartość to 700.0. Wartości dla 25, 50, i 75 percentyli wskazują na pewną zmienność w kwocie pożyczki. Istnieje 22 brakujące wartości dla tej zmiennej.
Zmienna Loan_Amount_Term określa okres spłaty pożyczki, wyrażony w miesiącach. Statystyki dla tej zmiennej są następujące: minimalna wartość to 12, pierwszy kwartyl wynosi 360, mediana to 360, średnia to 342, trzeci kwartyl to 360, a maksymalna wartość to 480. Wartości te wskazują na to, że większość wnioskodawców stara się o pożyczkę na okres 360 miesięcy. Istnieje 14 brakujących wartości dla tej zmiennej.
Zmienna Credit_History opisuje historię kredytową wnioskodawcy i przyjmuje dwie wartości: 0 i 1, które oznaczają negatywną historię kredytową i pozytywną historię kredytową, odpowiednio. Liczba obserwacji, gdzie wnioskodawca ma negatywną historię kredytową, wynosi 89, a liczba obserwacji z pozytywną historią kredytową wynosi 475. Istnieje 50 brakujących obserwacji dla tej zmiennej.
Zmienna Property_Area opisuje lokalizację nieruchomości wnioskodawcy i przyjmuje trzy wartości: Rural - Wiejski, Semiurban - Pół-miejski i Urban - Miejski. Liczba obserwacji dla poszczególnych obszarów to: Rural - 179, Semiurban - 233, Urban - 202. Brakujących obserwacji dla tej zmiennej nie ma.
Zmienna Loan_Status określa, czy wnioskodawca otrzymał pożyczkę, i przyjmuje dwie wartości: “Y” (Yes) i “N” (No). Liczba obserwacji, gdzie pożyczka została przyznana, wynosi 422, a liczba obserwacji, gdzie pożyczka nie została przyznana, wynosi 192. Brakujących obserwacji dla tej zmiennej nie ma.
Zmienna TotalIncome określa sumę przychodów wszystkich osób aplikujących wspólnie o kredyt. Statystyki dla tej zmiennej to: minimalna wartość to 1442, pierwszy kwartyl wynosi 4166, mediana to 5416, średnia to 7025, trzeci kwartyl to 7522, a maksymalna wartość to 81000. Wartości te wskazują na zróżnicowanie dochodów wnioskodawców. Brakujących obserwacji dla tej zmiennej nie ma.
1.7 Podsumowanie typów danych.
str(pozyczki)## tibble [614 x 11] (S3: tbl_df/tbl/data.frame)
## $ Gender : Factor w/ 2 levels "Female","Male": 2 2 2 2 2 2 2 2 2 2 ...
## $ Married : Factor w/ 2 levels "No","Yes": 1 2 2 2 1 2 2 2 2 2 ...
## $ Dependents : Factor w/ 4 levels "0.0","1.0","2.0",..: 1 2 1 1 1 3 1 4 3 2 ...
## $ Education : Factor w/ 2 levels "Graduate","Not Graduate": 1 1 1 2 1 1 2 1 1 1 ...
## $ Self_Employed : Factor w/ 2 levels "No","Yes": 1 1 2 1 1 2 1 1 1 1 ...
## $ LoanAmount : num [1:614] NA 128 66 120 141 267 95 158 168 349 ...
## $ Loan_Amount_Term: num [1:614] 360 360 360 360 360 360 360 360 360 360 ...
## $ Credit_History : Factor w/ 2 levels "0","1": 2 2 2 2 2 2 2 1 2 2 ...
## $ Property_Area : Factor w/ 3 levels "Rural","Semiurban",..: 3 1 3 3 3 3 3 2 3 2 ...
## $ Loan_Status : Factor w/ 2 levels "N","Y": 2 1 2 2 2 2 2 1 2 1 ...
## $ TotalIncome : num [1:614] 5849 6091 3000 4941 6000 ...#CZĘŚĆ 2 - CZYSZCZENIE DANYCH
2.1 Sprawdzanie, czy istnieją NA.
#Liczba i udział procentowy NA według zmiennych
miss_var_summary(pozyczki)## # A tibble: 11 x 3
## variable n_miss pct_miss
## <chr> <int> <dbl>
## 1 Credit_History 50 8.14
## 2 Self_Employed 32 5.21
## 3 LoanAmount 22 3.58
## 4 Dependents 15 2.44
## 5 Loan_Amount_Term 14 2.28
## 6 Gender 13 2.12
## 7 Married 3 0.489
## 8 Education 0 0
## 9 Property_Area 0 0
## 10 Loan_Status 0 0
## 11 TotalIncome 0 0#Brakujące obserwacje według zmiennych
vis_miss(pozyczki)
#Zależności pomiędzy brakującymi obserwacjami
gg_miss_upset(pozyczki, nsets=7)
Brakujące obserwację występują w zmiennych: Credit History, Self Employed, Loan Amount, Dependents i Loan Amount Term oraz Gender. Najwięcej brakujących obserwacji występuje w zmiennej Credit History - jest ich 50. Ponadto występuje 5 przypadków, gdzie Credit History i Self Employed są brakujacymi zmiennymi. Dwa przypadki, gdzie Dependents i Loan Amount są brakującymi zmiennami jednocześnie
Brakujące obserwacje występują w następujących zmiennych: Credit History, Loan Amount, Dependents, Loan_Amount_Term, Gender, Married.
2..2 Wizualizacja i uzupełnianie zmiennych, w których występują brakujące dane.
2.2.1 Zmienna Gender.
pozyczki_filtered <- pozyczki %>%
filter(!is.na(Gender) & Gender != "NA")
ggplot(pozyczki_filtered, aes(x = Gender, fill = Gender)) +
geom_bar(na.rm = TRUE) +
labs(title = "Rozkład płci", x = "Płeć", y = "Liczba") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, margin = margin(b = 20)))
2.2.3 Uzupełnianie NA w zmiennej Gender za pomocą mody, czyli zmiennej Male.
pozyczki_complete <- tidyr::replace_na(pozyczki, list(Gender = "Male"))2.2.4. Zmienna Credit History - wizualizacja.
#Rozkład Credit History Ogółem
pozyczki_filtered <- pozyczki %>%
filter(!is.na(Credit_History))
ggplot(pozyczki_filtered, aes(x = factor(Credit_History, labels = c("Nie", "Tak")), fill = factor(Credit_History))) +
geom_bar() +
labs(title = "Wcześniejsza historia kredytowa",
x = NULL,
y = "Liczba odpowiedzi") +
scale_fill_manual(values = c("0" = "#f8766d", "1" = "#00bfc4"),
labels = c("0" = "Nie", "1" = "Tak")) +
guides(fill = guide_legend(title = "Historia kredytowa")) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, margin = margin(b = 20)))
#Rozkład Credit History dla kobiet
pozyczki_filtered <- pozyczki %>%
filter(!is.na(Credit_History), Gender == "Female")
ggplot(pozyczki_filtered, aes(x = factor(Credit_History, labels = c("Nie", "Tak")), fill = factor(Credit_History))) +
geom_bar() +
labs(title = "Wcześniejsza historia kredytowa (Kobiety)",
x = NULL,
y = "Liczba odpowiedzi") +
scale_fill_manual(values = c("0" = "#f8766d", "1" = "#00bfc4"),
labels = c("0" = "Nie", "1" = "Tak")) +
guides(fill = guide_legend(title = "Historia kredytowa")) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, margin = margin(b = 20)))
#Rozkład Credit History dla mężczyzn
pozyczki_filtered <- pozyczki %>%
filter(!is.na(Credit_History), Gender == "Male")
ggplot(pozyczki_filtered, aes(x = factor(Credit_History, labels = c("Nie", "Tak")), fill = factor(Credit_History))) +
geom_bar() +
labs(title = "Wcześniejsza historia kredytowa (Mężczyżni)",
x = NULL,
y = "Liczba odpowiedzi") +
scale_fill_manual(values = c("0" = "#f8766d", "1" = "#00bfc4"),
labels = c("0" = "Nie", "1" = "Tak")) +
guides(fill = guide_legend(title = "Historia kredytowa")) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, margin = margin(b = 20)))
Zarówno wśród kobiet jak i mężczyzn istnieje większy odsetek osób z wcześniejszą historią kredytową. Dlatego zmienne NA zostaną uzupełnione wartością 1.
2.2.4. Zmienna Credit_History - uzupełnienie.
pozyczki_complete <- mutate(replace_na(pozyczki_complete, list(Credit_History = "1")))
miss_var_summary(pozyczki_complete)## # A tibble: 11 x 3
## variable n_miss pct_miss
## <chr> <int> <dbl>
## 1 Self_Employed 32 5.21
## 2 LoanAmount 22 3.58
## 3 Dependents 15 2.44
## 4 Loan_Amount_Term 14 2.28
## 5 Married 3 0.489
## 6 Gender 0 0
## 7 Education 0 0
## 8 Credit_History 0 0
## 9 Property_Area 0 0
## 10 Loan_Status 0 0
## 11 TotalIncome 0 02.2.5. Zmienna Self_Employed - wizualizacja.
#Wykres stopnia samozatrudnienia
pozyczki_filtered <- pozyczki %>%
filter(!is.na(Self_Employed))
ggplot(pozyczki_filtered, aes(x = Self_Employed, fill = Self_Employed)) +
geom_bar(stat = "count", position = "stack") +
theme_minimal() +
labs(title = "Samozatrudnienie",
x = "Samozatrudnienie",
y = NULL) +
scale_fill_manual(values = c("Yes" = "#00bfc4", "No" = "#f8766d"),
labels = c("Yes" = "Tak", "No" = "Nie")) +
guides(fill = guide_legend(title = "Samozatrudnienie")) +
theme(plot.title = element_text(hjust = 0.5, margin = margin(b = 20)))
#Wykres stopnia samozatrudnienia dla kobiet
pozyczki_female <- pozyczki %>%
filter(!is.na(Self_Employed), Gender == "Female")
ggplot(pozyczki_female, aes(x = Self_Employed, fill = Self_Employed)) +
geom_bar(stat = "count", position = "stack") +
theme_minimal() +
labs(title = "Samozatrudnienie (Kobiety)",
x = "Samozatrudnienie",
y = NULL) +
scale_fill_manual(values = c("Yes" = "#00bfc4", "No" = "#f8766d"),
labels = c("Yes" = "Tak", "No" = "Nie")) +
guides(fill = guide_legend(title = "Samozatrudnienie")) +
theme(plot.title = element_text(hjust = 0.5, margin = margin(b = 20)))
#Wykres samozatrudnienia dla mężczyzn
pozyczki_male <- pozyczki %>%
filter(!is.na(Self_Employed), Gender == "Male")
ggplot(pozyczki_male, aes(x = Self_Employed, fill = Self_Employed)) +
geom_bar(stat = "count", position = "stack") +
theme_minimal() +
labs(title = "Samozatrudnienie (Mężczyźni)",
x = "Samozatrudnienie",
y = NULL) +
scale_fill_manual(values = c("Yes" = "#00bfc4", "No" = "#f8766d"),
labels = c("Yes" = "Tak", "No" = "Nie")) +
guides(fill = guide_legend(title = "Samozatrudnienie")) +
theme(plot.title = element_text(hjust = 0.5, margin = margin(b = 20)))
2.2.6. Jak widać, zarówno większość kobiet jak i mężczyzn nie jest samozatrudniona, dlatego obserwacje brakujące zostaną uzupełnione wartością No.
pozyczki_complete <- mutate(replace_na(pozyczki_complete, list(Self_Employed = "No")))
miss_var_summary(pozyczki_complete)## # A tibble: 11 x 3
## variable n_miss pct_miss
## <chr> <int> <dbl>
## 1 LoanAmount 22 3.58
## 2 Dependents 15 2.44
## 3 Loan_Amount_Term 14 2.28
## 4 Married 3 0.489
## 5 Gender 0 0
## 6 Education 0 0
## 7 Self_Employed 0 0
## 8 Credit_History 0 0
## 9 Property_Area 0 0
## 10 Loan_Status 0 0
## 11 TotalIncome 0 02.2.7. Wizualizacja danych dla zmiennej LoanAmount.
mean_value <- mean(pozyczki$LoanAmount, na.rm = TRUE)
median_value <-median(pozyczki$LoanAmount, na.rm = TRUE)
pozyczki %>%
drop_na(LoanAmount) %>%
ggplot(aes(x = LoanAmount)) +
geom_histogram(binwidth = 15, fill = "#00bfc4") +
labs(title = "Kwota kredytu", x = "Kwota kredytu", y = "Liczba") +
geom_vline(aes(xintercept = mean(LoanAmount)),
color = "blue", linetype = "dashed", size = 1) +
geom_vline(xintercept = median_value, color = "red", linetype = "dashed", size = 1) +
annotate("text", x = Inf, y = Inf, label = sprintf("Średnia: %.2f", mean_value),
vjust = 1, hjust = 1, color = "blue", size = 4) +
annotate("text", x = Inf, y = Inf, label = sprintf("Mediana: %.2f", median_value),
vjust = 2, hjust = 1, color = "red", size = 4) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, margin = margin(b = 20)))## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## i Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
2.2.8. Brakujące obserwacje zostaną uzupełnione mediana dla danych.
pozyczki_complete <- mutate(replace_na(pozyczki_complete, list(LoanAmount =128.00)))2.2.9. Wizualizacja zmiennej Dependents.
#Liczba osób na utrzymaniu ogółem
pozyczki_filtered <- pozyczki %>%
filter(!is.na(Dependents))
ggplot(pozyczki_filtered, aes(x = Dependents, fill = Dependents)) +
geom_bar(stat = "count", position = "stack") +
theme_minimal() +
labs(title = "Liczba osób na utrzymaniu",
x = "Liczba osób",
y = NULL) +
scale_fill_manual(values = c("0.0" = "#00bfc4", "1.0" = "#f8766d", "2.0" = "#00bfff", "3+" = "#ff7f00"),
labels = c("0.0" = "0", "1.0" = "1", "2.0" = "2", "3+" = "3+")) +
guides(fill = guide_legend(title = "Liczba osób ma utrzymaniu")) +
theme(plot.title = element_text(hjust = 0.5, margin = margin(b = 20)))
#Liczba osób na utrzymaniu dla kobiet
pozyczki_female <- pozyczki_filtered %>%
filter(Gender == "Female")
ggplot(pozyczki_female, aes(x = Dependents, fill = Dependents)) +
geom_bar(stat = "count", position = "stack") +
theme_minimal() +
labs(title = "Liczba osób na utrzymaniu (Kobiety)",
x = "Liczba osób",
y = NULL) +
scale_fill_manual(values = c("0.0" = "#00bfc4", "1.0" = "#f8766d", "2.0" = "#00bfff", "3+" = "#ff7f00"),
labels = c("0.0" = "0", "1.0" = "1", "2.0" = "2", "3+" = "3+")) +
guides(fill = guide_legend(title = "Liczba osób ma utrzymaniu")) +
theme(plot.title = element_text(hjust = 0.5, margin = margin(b = 20)))
#Liczba osób na utrzymaniu dla mężczyzn
pozyczki_male <- pozyczki_filtered %>%
filter(Gender == "Male")
ggplot(pozyczki_male, aes(x = Dependents, fill = Dependents)) +
geom_bar(stat = "count", position = "stack") +
theme_minimal() +
labs(title = "Liczba osób na utrzymaniu (Mężczyźni)",
x = "Liczba osób",
y = NULL) +
scale_fill_manual(values = c("0.0" = "#00bfc4", "1.0" = "#f8766d", "2.0" = "#00bfff", "3+" = "#ff7f00"),
labels = c("0.0" = "0", "1.0" = "1", "2.0" = "2", "3+" = "3+")) +
guides(fill = guide_legend(title = "Liczba osób ma utrzymaniu")) +
theme(plot.title = element_text(hjust = 0.5, margin = margin(b = 20)))
2.2.10. Jak widać, zarówno kobiety i mężczyźni na swoim utrzymaniu mają najczęściej 0 osób, dlatego brakujące wartości zostaną uzupełnione wartością 0.
pozyczki_complete <- pozyczki_complete %>%
mutate(Dependents = ifelse(is.na(Dependents), "0", as.character(Dependents)))
#Ponowna zmiana zmiennej Dependents na faktor
pozyczki_complete <- pozyczki_complete %>%
mutate(Dependents = factor(Dependents))2.2.11 Wizualizacja zmiennej Married.
# Filtruj wiersze z brakującymi wartościami w Dependents
pozyczki_filtered <- pozyczki %>%
filter(!is.na(Married))
# Wykres słupkowy dla całego zestawu danych
ggplot(pozyczki_filtered, aes(x = Married, fill = Married)) +
geom_bar(stat = "count", position = "stack") +
theme_minimal() +
labs(title = "Liczba osób według Stanu Cywilnego",
x = "Stan Cywilny",
y = NULL,
fill = "Stan Cywilny") +
scale_fill_manual(values = c("No" = "#00bfc4", "Yes" = "#f8766d"),
labels = c("No" = "Niezamężny/Niezamężna", "Yes" = "Zamężny/Zamężna")) +
guides(fill = guide_legend(title = "Stan Cywilny")) +
theme(plot.title = element_text(hjust = 0.5, margin = margin(b = 20)))
# Wykres słupkowy dla kobiet
pozyczki_female <- pozyczki_filtered %>%
filter(Gender == "Female")
ggplot(pozyczki_female, aes(x = Married, fill = Married)) +
geom_bar(stat = "count", position = "stack") +
theme_minimal() +
labs(title = "Liczba osób według Stanu Cywilnego (Kobiety)",
x = "Stan Cywilny",
y = NULL,
fill = "Stan Cywilny") +
scale_fill_manual(values = c("No" = "#00bfc4", "Yes" = "#f8766d"),
labels = c("No" = "Niezamężna", "Yes" = "Zamężna")) +
guides(fill = guide_legend(title = "Stan Cywilny")) +
theme(plot.title = element_text(hjust = 0.5, margin = margin(b = 20)))
# Wykres słupkowy dla mężczyzn
pozyczki_male <- pozyczki_filtered %>%
filter(Gender == "Male")
ggplot(pozyczki_male, aes(x = Married, fill = Married)) +
geom_bar(stat = "count", position = "stack") +
theme_minimal() +
labs(title = "Liczba osób według Stanu Cywilnego (Mężczyźni)",
x = "Stan Cywilny",
y = NULL,
fill = "Stan Cywilny") +
scale_fill_manual(values = c("No" = "#00bfc4", "Yes" = "#f8766d"),
labels = c("No" = "Niezamężny", "Yes" = "Zamężny")) +
guides(fill = guide_legend(title = "Stan Cywilny")) +
theme(plot.title = element_text(hjust = 0.5, margin = margin(b = 20)))
2.2.12. Jak widać większość kobiet wnioskujących o kredyt jest niezamężnych, a większość mężczyzn wnioskujących o kredyt jest zamężnych. Brakujące obserwacje zmiennej Married zostaną zatem uzupełnione według zauważonej zależności.
pozyczki_complete <- pozyczki_complete %>%
mutate(Married = replace(Married, is.na(Married) & Gender == "Female", "No"),
Married = replace(Married, is.na(Married) & Gender == "Male", "Yes"))
summary(pozyczki_complete$Married)## No Yes
## 214 4002.2.13. Okres kredytowania - wizualizacja zmiennej.
#Wykres gęstości
median_value <- median(pozyczki$Loan_Amount_Term, na.rm = TRUE)
pozyczki %>%
drop_na(Loan_Amount_Term) %>%
ggplot(aes(x = Loan_Amount_Term)) +
geom_density(fill = "#00bfc4", alpha = 0.5) +
geom_vline(xintercept = median_value, color = "brown", linetype = "dashed", size = 0.75) +
annotate("text", x = median_value, y = 0.01, label = paste("Mediana:", median_value),
color = "brown", hjust = 0, vjust = 0) +
labs(title = "Okres Kredytowania w miesiącach",
x = "Okres Kredytowania (miesiące)",
y = "Gęstość") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, margin = margin(b = 20)))
2.2.14. Uzupełnianie NA dla zmiennej Loan Amount Term. Brakujące wartości zostaną zastąpione medianą, która wynosi 360 miesięcy.
pozyczki_complete <- mutate(replace_na(pozyczki_complete, list(Loan_Amount_Term =360)))2.3 Sprawdzenie kompletności danych po uzupełnieniu i ich typów.
miss_var_summary(pozyczki_complete)## # A tibble: 11 x 3
## variable n_miss pct_miss
## <chr> <int> <dbl>
## 1 Gender 0 0
## 2 Married 0 0
## 3 Dependents 0 0
## 4 Education 0 0
## 5 Self_Employed 0 0
## 6 LoanAmount 0 0
## 7 Loan_Amount_Term 0 0
## 8 Credit_History 0 0
## 9 Property_Area 0 0
## 10 Loan_Status 0 0
## 11 TotalIncome 0 0unique(pozyczki_complete)## # A tibble: 614 x 11
## Gender Married Dependents Education Self_Employed LoanAmount Loan_Amount_Term
## <fct> <fct> <fct> <fct> <fct> <dbl> <dbl>
## 1 Male No 0.0 Graduate No 128 360
## 2 Male Yes 1.0 Graduate No 128 360
## 3 Male Yes 0.0 Graduate Yes 66 360
## 4 Male Yes 0.0 Not Grad~ No 120 360
## 5 Male No 0.0 Graduate No 141 360
## 6 Male Yes 2.0 Graduate Yes 267 360
## 7 Male Yes 0.0 Not Grad~ No 95 360
## 8 Male Yes 3+ Graduate No 158 360
## 9 Male Yes 2.0 Graduate No 168 360
## 10 Male Yes 1.0 Graduate No 349 360
## # i 604 more rows
## # i 4 more variables: Credit_History <fct>, Property_Area <fct>,
## # Loan_Status <fct>, TotalIncome <dbl>str(pozyczki_complete)## tibble [614 x 11] (S3: tbl_df/tbl/data.frame)
## $ Gender : Factor w/ 2 levels "Female","Male": 2 2 2 2 2 2 2 2 2 2 ...
## $ Married : Factor w/ 2 levels "No","Yes": 1 2 2 2 1 2 2 2 2 2 ...
## $ Dependents : Factor w/ 5 levels "0","0.0","1.0",..: 2 3 2 2 2 4 2 5 4 3 ...
## $ Education : Factor w/ 2 levels "Graduate","Not Graduate": 1 1 1 2 1 1 2 1 1 1 ...
## $ Self_Employed : Factor w/ 2 levels "No","Yes": 1 1 2 1 1 2 1 1 1 1 ...
## $ LoanAmount : num [1:614] 128 128 66 120 141 267 95 158 168 349 ...
## $ Loan_Amount_Term: num [1:614] 360 360 360 360 360 360 360 360 360 360 ...
## $ Credit_History : Factor w/ 2 levels "0","1": 2 2 2 2 2 2 2 1 2 2 ...
## $ Property_Area : Factor w/ 3 levels "Rural","Semiurban",..: 3 1 3 3 3 3 3 2 3 2 ...
## $ Loan_Status : Factor w/ 2 levels "N","Y": 2 1 2 2 2 2 2 1 2 1 ...
## $ TotalIncome : num [1:614] 5849 6091 3000 4941 6000 ...2.4 Sprawdzenie czy występują zmienne odstające outliers. Aby sprawdzić czy występują potencjalne wartości odstające zdecydowano się na wykonanie wykresu pudełkowego.
#Wykres pudełkowy, który pomoże zidentyfikować zmienne odstające
boxplot(pozyczki_complete$TotalIncome) 
#Pokaznie wartości potencjalnych outlierów
boxplot.stats(pozyczki_complete$TotalIncome)$out## [1] 23809 15500 13650 14583 23803 14363 20166 14999 14866 39999 51763 16816
## [13] 13650 33846 43897 16250 16783 14583 20667 20233 15000 13649 63337 12917
## [25] 24996 15759 17196 13746 22500 81000 21600 14880 12876 37719 15666 16692
## [37] 17539 18917 18333 17263 27500 13262 15114 17500 18165 19484 16666 35673
## [49] 16120 42083#Pokazanie przypadków w których występują potencjalne obserwacje odstające
out <- boxplot.stats(pozyczki_complete$TotalIncome)$out
out_ind <- which(pozyczki_complete$TotalIncome %in% c(out))
pozyczki_complete[out_ind, ]## # A tibble: 50 x 11
## Gender Married Dependents Education Self_Employed LoanAmount Loan_Amount_Term
## <fct> <fct> <fct> <fct> <fct> <dbl> <dbl>
## 1 Male Yes 1.0 Graduate No 349 360
## 2 Male No 3+ Graduate No 320 360
## 3 Male Yes 0 Graduate No 128 360
## 4 Male Yes 1.0 Graduate No 185 180
## 5 Male Yes 3+ Graduate No 370 360
## 6 Male Yes 1.0 Graduate Yes 160 180
## 7 Male No 0.0 Graduate Yes 650 480
## 8 Male No 0.0 Graduate No 242 360
## 9 Female Yes 2.0 Graduate No 70 360
## 10 Male Yes 3+ Graduate No 600 180
## # i 40 more rows
## # i 4 more variables: Credit_History <fct>, Property_Area <fct>,
## # Loan_Status <fct>, TotalIncome <dbl>#Histogram zmiennej
hist(pozyczki_complete$TotalIncome, breaks = 50)
2.5 Usuwanie obserwacji, które zostały uznane za outliery.
pozyczki_nooutlier <- pozyczki_complete[pozyczki_complete$TotalIncome < 10000,]
boxplot(pozyczki_nooutlier$TotalIncome)
hist(pozyczki_nooutlier$TotalIncome, breaks = 50)
#CZESC 3 - MODEL LOGITOWY
3.1. Proporcje zmiennej objaśnianej - Loan_Status
summary(pozyczki_nooutlier$Loan_Status)## N Y
## 161 364prop.table(table(pozyczki_nooutlier$Loan_Status)) %>% round(2)##
## N Y
## 0.31 0.693.2.Podział danych do modelu Następnym krokiem jest podzielenie danych na dwie części: jedna będzie wykorzystana do “trenowania modelu”, a druga część będzie wykorzystana do oceny skuteczności modelu. Zazwyczaj model testowy wynosi około 70 - 80% wszystkich obserwacji.W analizowanym przypadku
set.seed(123)
index <- sample(x = nrow(pozyczki_nooutlier),
size = nrow(pozyczki_nooutlier)*0.7)
pozyczki_train <- pozyczki_nooutlier[index,]
pozyczki_test <- pozyczki_nooutlier[-index,]3.3. Sprawdzenie czy zestaw treningowy ma wielkość obserwacji stanowiącą około 70% wszyskich obserwacji. Wyniki są podobne.
nrow(pozyczki_train)## [1] 367nrow(pozyczki_nooutlier)*0.7## [1] 367.53.4. Sprawdzenie czy proporcje LoanStatus w zestawie treningowym zostały zachowane w porównaniu do wyczyszconych danych. Proporcje można uznać za zachowane, co oznacza, że dane są przygotowane do budowy modelu logitowego.
prop.table(table(pozyczki_train$Loan_Status)) %>% round(2)##
## N Y
## 0.28 0.72*3.5. Aby upewnić się, że nasz model jest możliwie jak najlepiej dopasowany przeprowadzona zostanie analiza regresji krokowej.
library(MASS)## Warning: pakiet 'MASS' został zbudowany w wersji R 4.1.3##
## Dołączanie pakietu: 'MASS'## Następujący obiekt został zakryty z 'package:dplyr':
##
## selectmodel_wszystko <- glm(Loan_Status ~ ., data = pozyczki_train, family = binomial)
step_backward_model <- stepAIC(model_wszystko, direction = "backward")## Start: AIC=349.1
## Loan_Status ~ Gender + Married + Dependents + Education + Self_Employed +
## LoanAmount + Loan_Amount_Term + Credit_History + Property_Area +
## TotalIncome
##
## Df Deviance AIC
## - Dependents 4 319.70 341.70
## - Gender 1 319.36 347.36
## - LoanAmount 1 319.39 347.39
## - Loan_Amount_Term 1 319.47 347.47
## - Self_Employed 1 319.63 347.63
## - TotalIncome 1 319.91 347.91
## - Education 1 321.04 349.04
## <none> 319.10 349.10
## - Married 1 321.24 349.24
## - Property_Area 2 327.81 353.81
## - Credit_History 1 410.56 438.56
##
## Step: AIC=341.7
## Loan_Status ~ Gender + Married + Education + Self_Employed +
## LoanAmount + Loan_Amount_Term + Credit_History + Property_Area +
## TotalIncome
##
## Df Deviance AIC
## - LoanAmount 1 319.95 339.95
## - Gender 1 320.03 340.03
## - Loan_Amount_Term 1 320.04 340.04
## - Self_Employed 1 320.30 340.30
## - TotalIncome 1 320.42 340.42
## - Education 1 321.66 341.66
## <none> 319.70 341.70
## - Married 1 321.99 341.99
## - Property_Area 2 328.31 346.31
## - Credit_History 1 411.81 431.81
##
## Step: AIC=339.95
## Loan_Status ~ Gender + Married + Education + Self_Employed +
## Loan_Amount_Term + Credit_History + Property_Area + TotalIncome
##
## Df Deviance AIC
## - Gender 1 320.31 338.31
## - Loan_Amount_Term 1 320.41 338.41
## - TotalIncome 1 320.42 338.42
## - Self_Employed 1 320.57 338.57
## - Education 1 321.82 339.82
## <none> 319.95 339.95
## - Married 1 322.10 340.10
## - Property_Area 2 328.58 344.58
## - Credit_History 1 412.32 430.32
##
## Step: AIC=338.31
## Loan_Status ~ Married + Education + Self_Employed + Loan_Amount_Term +
## Credit_History + Property_Area + TotalIncome
##
## Df Deviance AIC
## - Loan_Amount_Term 1 320.79 336.79
## - TotalIncome 1 320.92 336.92
## - Self_Employed 1 320.95 336.95
## - Education 1 322.06 338.06
## <none> 320.31 338.31
## - Married 1 323.55 339.55
## - Property_Area 2 328.69 342.69
## - Credit_History 1 412.47 428.47
##
## Step: AIC=336.79
## Loan_Status ~ Married + Education + Self_Employed + Credit_History +
## Property_Area + TotalIncome
##
## Df Deviance AIC
## - TotalIncome 1 321.41 335.41
## - Self_Employed 1 321.46 335.46
## - Education 1 322.44 336.44
## <none> 320.79 336.79
## - Married 1 324.27 338.27
## - Property_Area 2 329.04 341.04
## - Credit_History 1 413.87 427.87
##
## Step: AIC=335.41
## Loan_Status ~ Married + Education + Self_Employed + Credit_History +
## Property_Area
##
## Df Deviance AIC
## - Self_Employed 1 321.92 333.92
## <none> 321.41 335.41
## - Education 1 323.53 335.53
## - Married 1 325.94 337.94
## - Property_Area 2 329.70 339.70
## - Credit_History 1 415.54 427.54
##
## Step: AIC=333.92
## Loan_Status ~ Married + Education + Credit_History + Property_Area
##
## Df Deviance AIC
## <none> 321.92 333.92
## - Education 1 323.98 333.98
## - Married 1 326.34 336.34
## - Property_Area 2 329.96 337.96
## - Credit_History 1 415.69 425.693.6 Model wyznaczony przez AIC.
model1 <- glm(Loan_Status ~ Married + Education + Credit_History + Property_Area, data = pozyczki_train, family = binomial)
summary(model1)##
## Call:
## glm(formula = Loan_Status ~ Married + Education + Credit_History +
## Property_Area, family = binomial, data = pozyczki_train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.2201 -0.3346 0.5613 0.6470 2.4042
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.8328 0.6065 -4.671 3.0e-06 ***
## MarriedYes 0.6072 0.2884 2.105 0.0353 *
## EducationNot Graduate -0.4475 0.3084 -1.451 0.1468
## Credit_History1 3.8651 0.5535 6.982 2.9e-12 ***
## Property_AreaSemiurban 0.7361 0.3545 2.077 0.0378 *
## Property_AreaUrban -0.1819 0.3428 -0.531 0.5957
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 433.78 on 366 degrees of freedom
## Residual deviance: 321.92 on 361 degrees of freedom
## AIC: 333.92
##
## Number of Fisher Scoring iterations: 53.7. Wiemy jednak, że przeliczając limity kredytowe kluczowymi kategoriami, które określają czy kredyt zostanie udzielony jest jego wielkość i okres na który zostanie udzielony oraz dochody kredytobiorcy. Zmienne te zostały dodane do modelu.
model2 <- glm(Loan_Status ~ Married + Education + Credit_History + Property_Area + LoanAmount + Loan_Amount_Term + TotalIncome, data = pozyczki_train, family = binomial)
summary(model2)##
## Call:
## glm(formula = Loan_Status ~ Married + Education + Credit_History +
## Property_Area + LoanAmount + Loan_Amount_Term + TotalIncome,
## family = binomial, data = pozyczki_train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.2931 -0.3361 0.5110 0.6807 2.4065
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.493e+00 1.136e+00 -2.195 0.0282 *
## MarriedYes 5.565e-01 3.013e-01 1.847 0.0648 .
## EducationNot Graduate -4.369e-01 3.174e-01 -1.376 0.1688
## Credit_History1 3.833e+00 5.539e-01 6.920 4.53e-12 ***
## Property_AreaSemiurban 7.469e-01 3.569e-01 2.093 0.0364 *
## Property_AreaUrban -1.759e-01 3.502e-01 -0.502 0.6155
## LoanAmount -2.299e-03 4.193e-03 -0.548 0.5836
## Loan_Amount_Term -1.432e-03 2.404e-03 -0.595 0.5516
## TotalIncome 9.534e-05 1.099e-04 0.868 0.3856
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 433.78 on 366 degrees of freedom
## Residual deviance: 320.65 on 358 degrees of freedom
## AIC: 338.65
##
## Number of Fisher Scoring iterations: 53.8. Test modelu logitowego używający danych testowych
#Model testowy
model_test <- predict(model2, newdata = pozyczki_test, type = "response")
model_test## 1 2 3 4 5 6 7
## 0.71334318 0.84118918 0.79233096 0.81868631 0.17646712 0.79346950 0.62156089
## 8 9 10 11 12 13 14
## 0.75100256 0.82082463 0.07083750 0.81169652 0.68570374 0.69582400 0.77922301
## 15 16 17 18 19 20 21
## 0.08915720 0.85831449 0.83053972 0.79196183 0.90670087 0.73681611 0.08067190
## 22 23 24 25 26 27 28
## 0.10608446 0.04174458 0.83018182 0.80337325 0.12927842 0.74155766 0.20586546
## 29 30 31 32 33 34 35
## 0.87170465 0.90928468 0.91122999 0.90855672 0.79641467 0.08171513 0.69898594
## 36 37 38 39 40 41 42
## 0.90967653 0.07544901 0.85585671 0.70142455 0.76566550 0.88983937 0.90873116
## 43 44 45 46 47 48 49
## 0.80506488 0.06406635 0.71125601 0.69921668 0.82989337 0.17263602 0.82529890
## 50 51 52 53 54 55 56
## 0.82636962 0.08586160 0.83680213 0.81724372 0.84268293 0.85373437 0.85558386
## 57 58 59 60 61 62 63
## 0.68431184 0.81462342 0.77837551 0.91734406 0.85685501 0.91902470 0.91700084
## 64 65 66 67 68 69 70
## 0.86944352 0.76249184 0.66774328 0.71710628 0.75622683 0.82457508 0.86438179
## 71 72 73 74 75 76 77
## 0.79386950 0.64590995 0.81595506 0.70356113 0.80854909 0.03334066 0.83152594
## 78 79 80 81 82 83 84
## 0.70174811 0.78596843 0.73579464 0.78766024 0.73717722 0.77720877 0.80017874
## 85 86 87 88 89 90 91
## 0.80637473 0.80251772 0.90876099 0.67537787 0.94879387 0.72013850 0.82659607
## 92 93 94 95 96 97 98
## 0.90311659 0.85777132 0.10253559 0.89166518 0.04644493 0.83871047 0.75959413
## 99 100 101 102 103 104 105
## 0.66244572 0.91119260 0.90598540 0.64699823 0.80531831 0.83431337 0.76844346
## 106 107 108 109 110 111 112
## 0.23547449 0.11527245 0.62910364 0.83467630 0.78789227 0.85403590 0.82165558
## 113 114 115 116 117 118 119
## 0.84848732 0.75184621 0.09506980 0.12678084 0.11007251 0.07386814 0.85365162
## 120 121 122 123 124 125 126
## 0.07618545 0.91252804 0.92346231 0.83785974 0.91069538 0.95533632 0.73364423
## 127 128 129 130 131 132 133
## 0.88546381 0.12342702 0.87236147 0.90331266 0.78544575 0.81488524 0.05119332
## 134 135 136 137 138 139 140
## 0.63075946 0.09231913 0.81368636 0.10772282 0.75279086 0.70357431 0.83971683
## 141 142 143 144 145 146 147
## 0.69107075 0.08559051 0.08459785 0.72400127 0.70258895 0.91266548 0.80528326
## 148 149 150 151 152 153 154
## 0.88842236 0.15587874 0.91683750 0.87177196 0.78825581 0.81064612 0.78958501
## 155 156 157 158
## 0.90824262 0.74979452 0.80465089 0.10614886#Dodanie informacji o prawdopodobieństwie udzielenia kredytu określonego przez model logitowy do zestawu zmiennych testowych
pozyczki_test$prawdopodobienstwo <- predict(model2, newdata = pozyczki_test, type = "response")
pozyczki_test## # A tibble: 158 x 12
## Gender Married Dependents Education Self_Employed LoanAmount Loan_Amount_Term
## <fct> <fct> <fct> <fct> <fct> <dbl> <dbl>
## 1 Male No 0.0 Graduate No 128 360
## 2 Male Yes 1.0 Graduate No 128 360
## 3 Male Yes 0.0 Graduate Yes 66 360
## 4 Male Yes 2.0 Graduate Yes 267 360
## 5 Male Yes 3+ Graduate No 158 360
## 6 Male Yes 2.0 Graduate No 168 360
## 7 Male No 1.0 Not Grad~ No 100 240
## 8 Male Yes 0.0 Not Grad~ No 133 360
## 9 Male Yes 0.0 Graduate No 115 360
## 10 Male Yes 0.0 Not Grad~ No 104 360
## # i 148 more rows
## # i 5 more variables: Credit_History <fct>, Property_Area <fct>,
## # Loan_Status <fct>, TotalIncome <dbl>, prawdopodobienstwo <dbl>3.9. Rozkład zmiennej prawdopodobienstwo. Na podstawie wykresu można stwierdzić, że rozkład predykcja prawdopodobieństwa jest lewostronnie asymetryczny.
plot(density(pozyczki_test$prawdopodobienstwo), main = "Wykres Gęstości Przewidywanych Prawdopodobieństw", xlab = "Przewidywane Prawdopodobieństwo", ylab = "Gęstość", col = "skyblue")
3.10. Przydzielenie statusu kredytu w zależności od wielkości prawdopodobieństwa Jako wielkość “progu” udzelenia kredytu ustalono prawdopodobieństwo predykcji o wielkości 0.65. Oznacza to, że jeżeli prawdopodobieństwo predykcji jest większe od 0.65 kredyt zostanie udzielony. Jeśli wartość ta jest mniejsza nie zostanie on udzielony.
confusion_matrix <- table(Actual = pozyczki_test$Loan_Status, Predicted = ifelse(model_test > 0.65, "Y", "N"))
print(confusion_matrix)## Predicted
## Actual N Y
## N 32 27
## Y 4 95Bazując na wyliczonych wartościach w macierzy błędów: Prawdziwie dodatnia:95. Prawdziwie ujemna:32. Fałszywie dodatnia (błąD pierwszego rodzaju): 27. Fałszywie ujemna: (błąd drugiego rodzaju):4.
3.11. Macierz błędów - obliczenia
accuracy <- (confusion_matrix[1, 1] + confusion_matrix[2, 2]) / sum(confusion_matrix)
sensitivity <- confusion_matrix[2, 2] / (confusion_matrix[2, 1] + confusion_matrix[2, 2])
specificity <- confusion_matrix[1, 1] / (confusion_matrix[1, 1] + confusion_matrix[1, 2])
cat("Dokładność:", accuracy, "\n")## Dokładność: 0.8037975cat("Czułość:", sensitivity, "\n")## Czułość: 0.959596cat("Swoistość testu", specificity, "\n")## Swoistość testu 0.5423729Model osiągnął dokładność na poziomie około 80%. Oznacza to, że 80% wszystkich przypadków zostało poprawnie sklasyfikowanych. Czułość modelu wynosi około 96%. Oznacza to, że model bardzo dobrze radzi sobie z identyfikacją rzeczywistych przypadków pozytywnych, z trafnością na poziomie około 96%. Specyficzność modelu wynosi około 54%. Oznacza to, że model jest umiarkowanie skuteczny w identyfikowaniu przypadków negatywnych, z poprawnością na poziomie 53%. Podsumowując: model posiada wysoką czułość, co oznacza że prawidłowo wykrywa przypadki pozytywne, ale gorzej radzi sobie w identyfikacji przypadków negatywnych. Wskazana jest w przyszłości optymalizacja modelu, aby zminimalizować konsekwencje związane z błędnym sklasyfikowaniem przypadków.
3.12 Przewidywanie dla konkretnego przypadku
#Zastąp dane danymi pozyskanymi od klienta.
nowe.dane <- data.frame(Married = "Yes", #Yes or No
Education = "Graduate", #Graduate albo Not Graduate
Credit_History = "1", #0 - jeśli klient nie posiada wcześniejszej historii kredytowej, 1 - jeśli posiada
Property_Area = "Semiurban", #Urban, Semiurban albo Rural
TotalIncome = 5000, #Uzupełnij sumą dochodów wszystkich wnioskujących
LoanAmount = 200, #Uzupełnij wielkością kredytu o który składany jest wniosek (w tysiacach)
Loan_Amount_Term = 360) #Uzupełnij długością kredytu w miesiącach
wynik <- predict(model2, newdata = nowe.dane, type = "response")
odpowiedz <- ifelse(wynik > 0.65, "Tak", "Nie")
cat("Przewidziane prawdopodobieństwo:", wynik, "\n")## Przewidziane prawdopodobieństwo: 0.8951536cat("Przewidywana odpowiedz:", odpowiedz, "\n")## Przewidywana odpowiedz: TakCZĘŚĆ 4 - TESTOWANIE HIPOTEZ
4.1 Ogólna istoność modelu - test Wald’a
Test Wald’a sprawdza, czy co najmniej jedna zmienna wnosi istotny wkład do modelu. H0: Żadna ze zmiennych nie wnosi istotnego wkładu do modelu. H1: Co najmniej jedna zmienna wnosi istotny wkład do modelu.
wald.test(b = coef(model2), Sigma = vcov(model2), Terms = 2:5)## Wald test:
## ----------
##
## Chi-squared test:
## X2 = 54.2, df = 4, P(> X2) = 4.8e-11Są podstawy do odrzucenia H0, co sugeruje, że przynajmniej jedna zmienna wnosi istotny wkład do modelu.
4.2.1 Test Likelihood-ratio
Test Likelihood-ratio w celu porównania modelu pełnego z modelem zerowym. H0: Model pełny i model zerowy pasują do danych równie dobrze. H1: Model pełny pasuje do danych znacznie lepiej niż model zerowy.
null_model <- glm(Loan_Status ~ 1, data = pozyczki_train, family = binomial)
anova(null_model, model2, test = "LR")## Analysis of Deviance Table
##
## Model 1: Loan_Status ~ 1
## Model 2: Loan_Status ~ Married + Education + Credit_History + Property_Area +
## LoanAmount + Loan_Amount_Term + TotalIncome
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 366 433.78
## 2 358 320.65 8 113.13 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Wyniki sugerują odrzucenie H0 na rzecz H1, co oznacza, że model pełny lepiej dopasowuje się do danych niż model zerowy.
4.2.2 Testowanie istotności poszczególnych zmiennych
Analiza statystyczna istotności poszczególnych zmiennych w modelu.
summary(model2)##
## Call:
## glm(formula = Loan_Status ~ Married + Education + Credit_History +
## Property_Area + LoanAmount + Loan_Amount_Term + TotalIncome,
## family = binomial, data = pozyczki_train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.2931 -0.3361 0.5110 0.6807 2.4065
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.493e+00 1.136e+00 -2.195 0.0282 *
## MarriedYes 5.565e-01 3.013e-01 1.847 0.0648 .
## EducationNot Graduate -4.369e-01 3.174e-01 -1.376 0.1688
## Credit_History1 3.833e+00 5.539e-01 6.920 4.53e-12 ***
## Property_AreaSemiurban 7.469e-01 3.569e-01 2.093 0.0364 *
## Property_AreaUrban -1.759e-01 3.502e-01 -0.502 0.6155
## LoanAmount -2.299e-03 4.193e-03 -0.548 0.5836
## Loan_Amount_Term -1.432e-03 2.404e-03 -0.595 0.5516
## TotalIncome 9.534e-05 1.099e-04 0.868 0.3856
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 433.78 on 366 degrees of freedom
## Residual deviance: 320.65 on 358 degrees of freedom
## AIC: 338.65
##
## Number of Fisher Scoring iterations: 5Wyniki wskazują, że historia kredytowa, stan cywilny i obszar nieruchomości (semiurban) są istotnymi czynnikami wpływającymi na decyzję o przyznaniu pożyczki, podczas gdy pozostałe zmienne nie wydają się mieć istotnego wpływu.
4.3 Jakość dopasowania modelu - test Hosmera-Lemeshowa
Test Hosmera-Lemeshowa ocenia istotną różnicę między obserwowanymi a przewidywanymi prawdopodobieństwami. H0: Nie ma istotnej różnicy pomiędzy obserwowanymi a przewidywanymi wartościami modelu (dobrze dopasowany model). H1: Istnieje istotna różnica pomiędzy obserwowanymi a przewidywanymi wartościami modelu (słabo dopasowany model).
hoslem.test(pozyczki_train$Loan_Status, fitted(model2), g = 10)## Warning in Ops.factor(1, y): '-' nie ma sensu dla czynników##
## Hosmer and Lemeshow goodness of fit (GOF) test
##
## data: pozyczki_train$Loan_Status, fitted(model2)
## X-squared = 367, df = 8, p-value < 2.2e-16Są podstawy do odrzucenia H0 na rzecz H1, co sugeruje, że istnieje istotna różnica między obserwowanymi a przewidywanymi wartościami modelu.